[18163] in Perl-Users-Digest
Perl-Users Digest, Issue: 331 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Feb 21 21:05:40 2001
Date: Wed, 21 Feb 2001 18:05:07 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <982807507-v10-i331@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Wed, 21 Feb 2001 Volume: 10 Number: 331
Today's topics:
½Ð°Ý°µªk <jck1@seed.net.tw>
Re: chop and chomp <bart.lateur@skynet.be>
Re: chop and chomp <flavell@mail.cern.ch>
Re: Difficult Split Question <johnlin@chttl.com.tw>
Re: File extraction problem <mischief@velma.motion.net>
How to match nth occurance? <anon6111@hotmail.com>
Re: How to match nth occurance? <maheshasolkar@yahoo.com>
Re: Module access to private vars in caller <bdesany@houston.rr.com>
Re: Module access to private vars in caller <c_clarkson@hotmail.com>
PERL And ASP ("Peter Loraditch")
Perl ICQ Daemon... <hugonz@hugonz.net>
Re: Perl ICQ Daemon... (Logan Shaw)
Persistent pages? <rwm@techie.com>
Re: Sendmail <c_clarkson@hotmail.com>
Re: why do i get an unitialized value warning when read (Tim Hammerquist)
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 22 Feb 2001 09:57:36 +0800
From: "jck1" <jck1@seed.net.tw>
Subject: ½Ð°Ý°µªk
Message-Id: <971s40$5g8@netnews.hinet.net>
¦³ÓÀɫܤj¡A§Ú±N¥Lopen°_¨Ó¡A¨Ã°µ³B²z«á©ñ¨ì¤@Ó°}¦C
open(IN, "AA.dat") or die;
while(<IN>){
..............##do something about $_
push(@array, $_);
}
..............##do something about @array
close(IN);
¦ý·íAA.dat«Ü¤j®É¡A@array¤]·|«Ü¤j¡An¬Omenory¤£°÷¥i¯à·|¦³¦MÀI¡C
Y¬O±N@arrayªº¸ê®Æ§ï¼g¨ìÀɮסA¥i¯à¤S¥²¶·Åª¥X¨Ó¤@¦¸¡A¦]¬°ÁÙn
°µ¨ä¥Lªº³B²z¡A¤£ª¾¤j®a¦³¦ó«Øij thanks
------------------------------
Date: Wed, 21 Feb 2001 23:18:40 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: chop and chomp
Message-Id: <m3j89tk7o8566lsd4h0njlotab8a888nin@4ax.com>
Alan J. Flavell wrote:
>> Couldn't we add $^A (<-Euro symbol) to Perl
>
>No, if only because what you typed was a control-function in
>iso-8859-1 , not a displayable character at all.
Perl, as a language, is an ASCII compatible language, not a ISO-Latin-1
compatible one. Check it out, ALL symbols used in the definitions of the
syntax of Perl fall in the ASCII range.
But there probably might be a few control characters left unused, that
can be used in the format that Alan's "quote" showed.
--
Bart.
------------------------------
Date: Thu, 22 Feb 2001 01:47:56 +0100
From: "Alan J. Flavell" <flavell@mail.cern.ch>
Subject: Re: chop and chomp
Message-Id: <Pine.LNX.4.30.0102220134350.30514-100000@lxplus003.cern.ch>
On Wed, 21 Feb 2001, Bart Lateur wrote:
> >> Couldn't we add $^A (<-Euro symbol) to Perl
> >
> >No, if only because what you typed was a control-function in
> >iso-8859-1 , not a displayable character at all.
>
> Perl, as a language, is an ASCII compatible language, not a ISO-Latin-1
> compatible one.
As a language, yes. I never got as far as dealing with that point -
thanks for picking it up.
> Check it out, ALL symbols used in the definitions of the
> syntax of Perl fall in the ASCII range.
Just in case some of the readers are confused (I know from experience
that many are), "ASCII" is a 7-bit coding. But you know this.
> But there probably might be a few control characters left unused, that
> can be used in the format that Alan's "quote" showed.
My "quote" was showing what my newsreader displayed to me as a
substitution, since the control character itself is non-displayable,
and the newsreader was honouring the hon. Usenaut's header
literally.[1]
Perl can of course handle 8-bit text data; but an 8-bit character is
only meaningful when taken in conjunction with the specification of an
encoding (that now-misleading MIME term "charset").
But I think you had in mind the use of control characters in the range
0-31 decimal (i.e ASCII control characters) as part of the language,
rather than use of characters from that fraught area (128-159 decimal)
of the iso-8859-* codings...
all the best
[1]Presumably the hon. Usenaut really had one of the
Windows-proprietary codings in mind, probably -1252.
------------------------------
Date: Thu, 22 Feb 2001 09:11:38 +0800
From: "John Lin" <johnlin@chttl.com.tw>
Subject: Re: Difficult Split Question
Message-Id: <971p45$lu@netnews.hinet.net>
"Anno Siegel" wrote
> According to Christopher Burke:
> > >> I have input lines of the form :
> > >> a,def(x,y,z),b,pqr(m,n)
> > >> I wish to split the line based on all ',' characters that are not
> > >> between '(' and ')'.
>
> push @new, $+ while $text =~ m/
> ([^(,]*\([^\)\\]*(?:\\.[^\)\\]*)*\)),? # changes in this line only
> | ([^,]+),?
> | ,
> /gx;
Seeing you use $+, I think the last alternative should be | (),
push @new, $+ while $text =~ m/
([^(,]*\([^\)\\]*(?:\\.[^\)\\]*)*\)),? # changes in this line only
| ([^,]+),?
| (), # <-------------- here
/gx;
Otherwise, if $text eq 'a,,b,c' , when the last alternative matches
$+ becomes undef.
Hmm... Since this thread is Difficult "split" Question, what about using
"split" to solve it? I mean, to find out the RegEx used with split.
my $text = 'a,def(x,y,z),,b,pqr(m,n)';
my $RE = ?????
print map {"[$_]\n"} split $RE => $text;
Don't panic, just Golf.
John Lin
------------------------------
Date: Thu, 22 Feb 2001 01:53:39 -0000
From: Chris Stith <mischief@velma.motion.net>
Subject: Re: File extraction problem
Message-Id: <t98s932f4inv0f@corp.supernews.com>
Falc2199 <falc2199@aol.comnojunk> wrote:
> What I want to do is create a script that randomly selects a line from a list
> of numbered lines.
> For example if the file looked like the following
> 1. Be all you can be
> 2. Helping others makes you feel good
> the script would choose either sentence 1 or 2 and print it.
> But I am having trouble with extraction part of this. Here is what I have so
> far....
> my $random = rand();
> while(<FILE>)
> {
> if ($_ = $random)
> {
> print $_;
> }
> }
Joe Schaefer already responded with an excellent suggestion. However, to
debug the program you have already written, I'll take a stab at this line:
if ($_ = $random)
I'd say that should probably be
if ($_ == $random)
instead. Otherwise, all you do is assign the value of $random to $_.
Also, were you aware that rand() doesn't return an integer? It returns
a floating point number between 0 and the number fed to it as an argument
(or the default value 1 if no argument is supplied). A fractional line
of a file doesn't make much sense. You could use
my $random = int( rand($value) + 1 );
if you want to run from line 1 through the last line of the file. To do
that properly, though, you'd have to already have $value set to the number
of lines in the file referenced by FILE.
> This does not produce the output desired. Can anyone give me a few
> pointers on how this could be modified to extract the sentence properly.
Joe gave you a great pointer on how to make a workable solution, but I thought
it would be nice to show you the problems with your current solution so you
can learn from the mistakes.
In case you're interested in seeing a similar but different code snippet,
I'll give you my little program called 'tags' that randomly picks the
taglines (the (hopefully) funny or thought-provoking sayings in my .sig)
that appear in my NG posts.
The code below reads a file which has taglines separated the same way
some "fortune" programs require. The fortunes/taglines are allowed to
span multiple lines, and are separated by lines containing only '%%'.
In addition to this simple format, any line starting with ';' is a
comment (for things like notes to check attributions or data file
version numbers in case your data file needs to be maintained). I
don't add 1 to my randomization value, because I generally end the
taglines file with a '%%' line. Besides, a completely accurate
randomization isn't quite as important for a signature block as
for cryptography ;-)
###--------------------------------------
#!/usr/bin/perl
open(TL, "./.taglines") || die "./.taglines could not be read: $!\n";
$tags = 0;
while(<TL>) {
if(/^%%$/) {
$tags++;
}
}
$which_tag = int(rand($tags));
$tags = 0;
seek(TL, 0,0);
while(<TL>) {
if(/^%%$/) {
$tags++;
if($tags > $which_tag) {
exit(0);
}
} elsif(/^;/) {
} else {
if($which_tag == $tags) {
print("$_");
}
}
}
exit(0);
###-------------------------------------
I hope this helps.
Chris
--
Christopher E. Stith
Get real! This is a discussion group, not a helpdesk. You post
something, we discuss its implications. If the discussion happens to
answer a question you've asked, that's incidental. -- nobull, clp.misc
------------------------------
Date: Thu, 22 Feb 2001 10:42:40 +1100
From: "Ash Kent" <anon6111@hotmail.com>
Subject: How to match nth occurance?
Message-Id: <DoYk6.3154$v4.134443@ozemail.com.au>
I am looking for the regex equivalent of sed's "replace nth instance of
pattern with replacement" (eg. s/pattern/replacement/2 would replace the
second occurance of pattern with replacement). After much experimentation I
still cannot work out how to do this in perl. Any help would be much
appreciated.
Thanks,
Ash.
------------------------------
Date: Wed, 21 Feb 2001 16:07:50 -0800
From: "Mahesh A" <maheshasolkar@yahoo.com>
Subject: Re: How to match nth occurance?
Message-Id: <t98m2ng8m10de1@corp.supernews.com>
This should help...
"PerlFAQ Server" <faq@denver.pm.org> wrote in message
news:h0li6.98$zN2.188636160@news.frii.net...
> This message is one of several periodic postings to comp.lang.perl.misc
> intended to make it easier for perl programmers to find answers to
> common questions. The core of this message represents an excerpt
> from the documentation provided with every Standard Distribution of
> Perl.
>
> +
> How do I change the Nth occurrence of something?
>
> You have to keep track of N yourself. For example, let's say you want
to
> change the fifth occurrence of `"whoever"' or `"whomever"' into
> `"whosoever"' or `"whomsoever"', case insensitively. These all assume
> that $_ contains the string to be altered.
>
> $count = 0;
> s{((whom?)ever)}{
> ++$count == 5 # is it the 5th?
> ? "${2}soever" # yes, swap
> : $1 # renege and leave it there
> }ige;
>
> In the more general case, you can use the `/g' modifier in a `while'
> loop, keeping count of matches.
>
> $WANT = 3;
> $count = 0;
> $_ = "One fish two fish red fish blue fish";
> while (/(\w+)\s+fish\b/gi) {
> if (++$count == $WANT) {
> print "The third fish is a $1 one.\n";
> }
> }
>
> That prints out: `"The third fish is a red one."' You can also use a
> repetition count and repeated pattern like this:
>
> /(?:\w+\s+fish\s+){2}(\w+)\s+fish/i;
>
> -
>
> Documents such as this have been called "Answers to Frequently
> Asked Questions" or FAQ for short. They represent an important
> part of the Usenet tradition. They serve to reduce the volume of
> redundant traffic on a news group by providing quality answers to
> questions that keep comming up. If you are some how irritated by
> seeing these postings you are free to ignore them or add the sender
> to your killfile. If you find errors or other problems with these
> postings please send corrections or comments to the posting email
> address.
>
> If you are not able to find this or other Perl documentation from
> your installation you may access it via the web by following the
> appropriate links from one of the addresses listed below.
>
> http://theoryx5.uwinnipeg.ca/mod_perl/cpan-search
> http://www.perldoc.com
> http://www.cpan.org
> http://www.perl.com
>
> Answers to questions about LOTS of other stuff, mostly not related to
> Perl, can be found at
>
> news:news.answers
>
> and in the many thousands of other useful Usenet news groups.
>
> Please note that the FAQ text posted by this server has been modified
> from that distributed in the stable Perl release. It has been
> edited to reflect the additions, changes and corrections provided
> by respondents, reviewers, and critics to previous postings of
> these FAQ. Complete text of these FAQ is available on request.
>
> The perlfaq manual pages contain the following copyright notice.
>
> AUTHOR AND COPYRIGHT
>
> Copyright (c) 1997-1999 Tom Christiansen and Nathan
> Torkington. All rights reserved.
>
> When included as an integrated part of the Standard
> Distribution of Perl or of its documentation (printed or
> otherwise), this work is covered under Perl's Artistic
> License. For separate distributions of all or part of
> this FAQ outside of that, see the perlfaq manpage.
>
> Irrespective of its distribution, all code examples here
> are public domain. You are permitted and encouraged to
> use this code and any derivatives thereof in your own
> programs for fun or for profit as you see fit. A simple
> comment in the code giving credit to the FAQ would be
> courteous but is not required.
>
> This work is provided in the hope that it will be useful but does
> not represent a commitment of any kind on the part of the contributers,
> authors or their agents.
> --
> This space intentionally left blank
"Ash Kent" <anon6111@hotmail.com> wrote in message
news:DoYk6.3154$v4.134443@ozemail.com.au...
> I am looking for the regex equivalent of sed's "replace nth instance of
> pattern with replacement" (eg. s/pattern/replacement/2 would replace the
> second occurance of pattern with replacement). After much experimentation
I
> still cannot work out how to do this in perl. Any help would be much
> appreciated.
>
>
>
> Thanks,
>
>
> Ash.
>
>
------------------------------
Date: Wed, 21 Feb 2001 17:44:45 -0600
From: "bdesany" <bdesany@houston.rr.com>
Subject: Re: Module access to private vars in caller
Message-Id: <971js7$5t6@gazette.bcm.tmc.edu>
"Brad Baxter" <bmb@ginger.libs.uga.edu> wrote in message
news:Pine.A41.4.21.0102211729180.11852-100000@ginger.libs.uga.edu...
> On Wed, 21 Feb 2001, bdesany wrote:
>
> > My understanding is that in order for private variables (my $variable)
to be
> > accessible from a subroutine, the variable and the subroutine have to be
> > declared within the same enclosing scope. So you put braces around them.
But
> > what if the subroutine is in an external module?
> > I've seen suggestions that you can access global variables by fully
> > qualifying the names, but I don't want to use global variables, and in
any
> > case I don't want the module to have to know what variables it's
supposed to
> > access (the variables are passed in as part of a single string, and
there
> > could be any number of different ones). Can it be done?
>
> If I understand you, the answer is probably in perlmod - Perl modules
> (packages and symbol tables)
>
> e.g., perldoc perlmod
>
> Brad
Brad, the variables I want to access are not in any symbol table, as they
were declared as "my" (which is Good Practice, or so I read everywhere).
Also, the caller could be anyone (not just main), and although I could code
for that, I was kind of hoping there was a construct/idiom I could use in
the caller (other than using global variables) that would make it irrelevant
to the module.
-Brian.
------------------------------
Date: Wed, 21 Feb 2001 19:18:51 -0600
From: "Charles K. Clarkson" <c_clarkson@hotmail.com>
Subject: Re: Module access to private vars in caller
Message-Id: <5B360D7A85B66378.D7C7D0B2BC3E1032.ECAF9F862A99028C@lp.airnews.net>
"bdesany" <bdesany@houston.rr.com> wrote in message
news:971bev$4d4@gazette.bcm.tmc.edu...
: My understanding is that in order for private variables
: (my $variable) to be accessible from a subroutine, the
: variable and the subroutine have to be declared within
: the same enclosing scope. So you put braces around
: them. But what if the subroutine is in an external
: module?
: I've seen suggestions that you can access global
: variables by fully qualifying the names, but I don't
: want to use global variables, and in any case I don't
: want the module to have to know what variables it's
: supposed to access (the variables are passed in as part
: of a single string, and there could be any number of
: different ones). Can it be done?
:
Are you trying to do something like this:
sample.pm:
package Sample;
require Exporter;
@ISA = qw/Exporter/;
@EXPORT_OK = qw/$main_dir $url_location
$script_name $mailprog test_change/;
$main_dir = '/web/cgi-bin/click-scripts';
$url_location = 'http://www.danet.net/cgi-bin/click-scripts';
$script_name = 'clickresponder.pl';
$mailprog = '/usr/sbin/sendmail';
sub test_change {
print "from module: $script_name\n"
}
1;
My_script.pl:
#!/usr/bin/perl -w
use strict;
use diagnostics;
use sample qw/$script_name test_change/;
test_change;
$script_name = "time";
test_change;
__END__
If this is what you mean you should read up on Exporter.
What it says about subs generally applies to variables also.
You can also use ':tags' to export groups of variables.
If you declare variables in the module with 'my', the module
won't see any changes you've made outside the module.
Effectively giving you a read-only variable.
HTH,
Charles K. Clarkson
------------------------------
Date: 22 Feb 2001 00:31:39 +0100
From: execworks@hotmail.com ("Peter Loraditch")
Subject: PERL And ASP
Message-Id: <F2093saXz5jy8SpzzzU0001405f@hotmail.com>
Hello Perl Guru’s
I am new to PERL, however, I have searched endlessly for two days to be in
the know. My search began when my boss handed me a perl file and asked me
to impliment a procedure to unleash its magic on our intranet users. The
procedure requires a data file to be uploaded to the webserver and read by
the perl file to write an fpga (field programmable gate array)graphical
layout onto an html page. The perl file runs appropriately from the command
line. My question is, how can I programmatically launch the perl file from
an active server page after the asp uploads the data file to the webserver.
It seems to me that there ought to be a way to achieve the command line
result with two or three lines of script. I have searched to no avail.
Your assistance would be greatly appreciated in this regard.
I have successfully installed ActivePerl and ActiveScript and am running in
the ISAPI environment.
Platform Config: Win 2000 Server IIS5.0
Working Step 1. User Uploads Data File to Webserver via HTML interface
page,
which runs vbscript on an ASP.
Not Working Step 2. PerlScript on ASP which runs perl file using data file
as if it were
done at the command line.
Working Step 3. Display new HTML page on users browser.
Files in this directory:
\ICONS\*.gif .... symbol files for the pins in HTML results
\templates\*.tpt .... template files for each fpga part that is
supported
adc_v300e.pad .... example pad file to be converted
adc_v300e.html .... result file from running script
pad2html_a.pl .... perl script that converts the padfile to html
command line usage C:\> perl pad2html_a.pl adc_v300e
script looks for adc_v300e.pad and generates adc_v300e.html
THE .pl file pad2html_a.pl
#!C:\perl\bin\perl -w
# CREATES: an image of the pinout with the pad file appended on the bottom
in html format
# REQUIRES: pad file
# NOTE: works in the current directory, location of legend file may need to
be altered
%directionof = (
'pc84', 'top', 'vq100', 'ccw', 'tq144', 'ccw', 'tq176', 'ccw',
'ht144', 'ccw', 'ht176', 'ccw', 'pq100', 'rec', 'pq160', 'ccw',
'pq208', 'ccw', 'pq240', 'ccw', 'hq160', 'ccw', 'hq208', 'ccw',
'hq240', 'ccw', 'hq304', 'ccw', 'bg225', 'ary', 'bg256', 'ary',
'bg352', 'ary', 'bg432', 'ary', 'bg560', 'ary', 'pg120', 'ary',
'pg156', 'ary', 'pg191', 'ary', 'pg223', 'ary', 'pg299', 'ary',
'pg411', 'ary', 'pg475', 'ary', 'pg559', 'ary', 'cb164', 'ccw',
'cb196', 'ccw', 'cb228', 'ccw', 'cs144', 'ary', 'cs280', 'ary',
'fg256', 'ary', 'fg456', 'ary', 'fg676', 'ary', 'fg680', 'ary',
'fg900', 'ary', 'fg860', 'ary', 'fg1156', 'ary',
);
%image = (
'DIN_D0', 'NC_DIN_D0', 'D1', 'NC_D1', 'D2', 'NC_D2', 'D3', 'NC_D3',
'D4', 'NC_D4', 'D5', 'NC_D5', 'D6', 'NC_D6', 'D7', 'NC_D7',
'DOUT_BUSY', 'NC_DOUT_BUSY', 'default', 'NC_IO', 'Unused', 'NC_IO',
'Vref', 'NC_Vref(r)', 'Vref(r)', 'NC_Vref(r)', 'INIT',
'NC_INIT',
'WRITE', 'NC_WRITE', 'CS', 'NC_CS',
'CCLK', 'CCLK', 'DONE', 'DONE', 'DXN','TEMP_Cathode',
'DXP', 'TEMP_Anode', 'GCLKPAD0', 'NC_GC0', 'GCLKPAD1', 'NC_GC1',
'GCLKPAD2', 'NC_GC2', 'GCLKPAD3', 'NC_GC3',
'NC', 'NC', 'N.C.', 'NC',
'M0', 'M0', 'M1', 'M1', 'M2', 'M2',
'MD0', 'M0', 'MD1', 'M1', 'MD2', 'M2',
'GND', 'GND', 'VCC', 'VCCINT', 'VCCINT', 'VCCINT', 'VCCO', 'VCCO',
'VCCO_0', 'VCCO', 'VCCO_1', 'VCCO', 'VCCO_2', 'VCCO', 'VCCO_3', 'VCCO',
'VCCO_4', 'VCCO', 'VCCO_5', 'VCCO', 'VCCO_6', 'VCCO', 'VCCO_7', 'VCCO',
'TDO', 'BScan', 'TDI', 'BScan', 'TCK', 'BScan', 'TMS',
'BScan',
'PROGRAM', 'PROGRAM', '/PROG', 'PROGRAM', '/PROGRAM', 'PROGRAM',
'IRDY', 'NC_IO', 'TRDY', 'NC_IO',
);
%changeto = (
'NC_DIN_D0', 'U_DIN_D0', 'NC_D1', 'U_D1', 'NC_D2', 'U_D2', 'NC_D3',
'U_D3',
'NC_D4', 'U_D4', 'NC_D5', 'U_D5', 'NC_D6', 'U_D6', 'NC_D7',
'U_D7',
'NC_GC0', 'U_GC0', 'NC_GC1','U_GC1', 'NC_GC2','U_GC2',
'NC_GC3','U_GC3',
'NC_INIT', 'U_INIT', 'NC_CS', 'U_CS', 'NC_WRITE', 'U_WRITE',
'NC_VREF', 'U_VREF', 'NC_IO', 'U_IO', 'NC_Vref(r)', 'U_Vref(r)',
'NC_DOUT_BUSY', 'U_DOUT_BUSY',
);
%gif = (
'NC_DIN_D0', 'clr', 'NC_D1', 'clr', 'NC_D2', 'clr', 'NC_D3',
'clr',
'NC_D4', 'clr', 'NC_D5', 'clr', 'NC_D6', 'clr', 'NC_IO',
'clr',
'NC_DOUT_BUSY','clr', 'NC_IO', 'clr', 'NC_IO', 'clr', 'PROGRAM',
'yel',
'NC_Vref(r)', 'clr', 'NC_VREF','clr', 'NC_D7', 'clr', 'TEMP_Cathode',
'yel',
'NC_INIT', 'clr', 'NC_WRITE', 'clr', 'NC_CS', 'clr', 'TEMP_Anode',
'yel',
'CCLK', 'yel', 'DONE', 'yel', 'NC', 'nc', 'M0', 'clr',
'GND', 'blk', 'VCCINT','red', 'VCCO', 'red', 'BScan', 'yel',
'NC_GC0', 'clr', 'NC_GC1','clr', 'NC_GC2', 'clr', 'NC_GC3','clr',
'U_DIN_D0','yel', 'U_D1', 'yel', 'U_D2', 'yel', 'U_D3', 'yel',
'U_D4', 'yel', 'U_D5', 'yel', 'U_D6', 'yel', 'U_D7', 'yel',
'U_GC0', 'yel', 'U_GC1', 'yel', 'U_GC2', 'yel', 'U_GC3', 'yel',
'U_INIT', 'yel', 'U_CS', 'yel', 'U_WRITE', 'yel', 'M1', 'clr',
'U_VREF', 'grn', 'U_IO', 'grn', 'U_Vref(r)','grn', 'M2', 'clr',
'U_DOUT_BUSY','yel',
);
@letter =
('A','B','C','D','E','F','G','H','J','K','L','M','N','P','R','T','U','V','W','Y');
sub letters {
local ($i) = @_;
local ($div) = int(($i) / ($#letter+1));
if($div!=0) { return &letters($div-1).$letter[$i % ($#letter+1)] }
else { return $letter[$i % ($#letter+1)] }
}
sub atoi {
local ($a, $r) = @_;
local ($i) = 0;
while ($letter[$i] lt $a && $i <= $#letter+1) { $i++ }
if ($letter[$i] ne $a) { $i-- }
$a =~ s/^.//;
if ($a ne "") { return &atoi($a, ($#letter+1)*($r+$i+1)) }
else { return $i+$r+1 }
}
my ($file) = $ARGV[0]; # $ARGV[0]
name of the pad file
my ($part); # part
my ($package); # package
my ($height) = 0; #
my ($width) = 0; #
my ($icon) = "./icons"; #
my ($tpt) = "./templates"; # directory of
template files.
my (@pin_name); #
my (@pin_type); #
my (@pin_order); #
my (@pin_image); #
my (%pin_class); #
my ($key) = 1; #
# my ($path) = "../PCI/work/32/";
do {
local ($pin);
local ($sig);
local ($pad);
local ($image);
local (%signal);
local ($i) = 0;
local ($row) = 0;
local ($col) = 0;
local ($nothing) = 0;
# if($file =~ /^2s/) { $path .= "Spartan2_results/$file/$file" }
# elsif($file =~ /^v\d+e/) { $path .= "virtexE_results/$file/$file" }
# else{ $path .= "Virtex_results/$file/$file" }
# $file=$path;
print $file."pad" ;
open(PAD, <$file."pad") or do { print "Couldn't read $file : $!\n"; die;
};
while(<PAD>) {
if (/^\| (\w+\s+)\| .(\w*_*L\d+[NP]_*Y*)./) {
s/^\| (\w+\s+)\| .(L\d+[NP]_*Y*)./\| $1\| --- /;
s/^\| (\w+\s+)\| .((\w+)_L\d+[NP]_*Y*)./\| $1\| ($3) /;
}
if (/Part type:\s+(\w+)/) { $part = $1 }
elsif (/Package:\s+(\w+)/) { $package = $1 }
elsif (/^\|\s(([A-Za-z]+)(\d+))\s+\|\s([^\|]+)(\|[^\|]+){3,3}$/) {
($pin, $row, $col, $sig) = ($1, $2, $3, $4);
for ($sig) {
s/^\s+|\s+$//g;
s/^\((.*)\)$/$1/;
s/^\s*$|---/Unused/;
}
if (length($row) > length($height) ||
length($row) == length($height) &&
$row gt $height) { $height = $row }
if ($col > $width) { $width = $col }
$signal{$pin} = $sig;
if(/^\|.*\|.*\|\s(\S*)\s/) {$pin_class{$pin}=$1}
}
else { }
}
close (PAD);
for ($part) {
/xc(\w+)/ && do { $tpt .= "/$1$package.tpt"; last; };
$nothing = 1;
}
($nothing == 1) && do { print "Part $part not identified.\n"; die; };
open (TPT, "<$tpt") or do {print "Couldn't read $tpt: $!\n"; die; };
$i = 0;
while (<TPT>) {
s/ \(L\d+[NP]_*Y*\)\|/\|/;
s/\((\w+)_L\d+[NP]_*Y*\)/($1)/;
if (/(\S+)\s([^|]+)|/) {
($pin, $pad, $sig) = ($1, $2, $signal{$1});
if (!($sig)) { $sig = 'Unused' }
if ($pad =~ /\((.*)\)/) { $pad = $1 };
if ($pad =~ /^PAD\d+$/i) { $image = $image{default} }
else { $image = ($image{$pad}||$image{default}) }
if ($sig =~ /VREF/) {
if ($pin_class{$pin} eq "") {$image = 'NC_VREF'||$image{default}}
else {$image = 'U_VREF'||$image{default}}
}
if ($sig ne 'Unused' && $sig ne $pad && $sig !~ /VREF/) {
if ($changeto{$image}) {$image = $changeto{$image} }
}
($pin_type[$i], $pin_order[$i], $pin_image[$i], $pin_name[$i])
= ($pad, $pin, $image, $sig);
}
$i++;
}
close (TPT);
};
do {
my (@top);
my (@left);
my (@right);
my (@bottom);
my (@array);
local ($nothing) = 0;
local ($numpins) = $#pin_order+1;
for ($directionof{$package}) {
/^ary/ && do {
local ($cols) = $width;
local ($rows) = &atoi($height,0);
local ($x) = $cols + 1;
local ($y) = $rows + 3;
local ($spaces) = 0;
local ($index);
($height, $width) = ($y, $x);
foreach $j (0..$rows-1) {
foreach $i (0..$cols-1) {
($row, $col, $index) = (&letters($j), $i+1, $i+$j*$cols-$spaces);
if ($pin_order[$index] eq $row.$col) { $array[$j+2][$i+1] =
$index }
else {
$array[$j+2][$i+1] = ":";
$spaces++;
}
}
$array[$j+2][0] = $array[$j+2][$x] = ":".&letters($j);
}
foreach $i (0..$rows-1) {
if ($i/2!=int($i/2)) {
$array[0][$i+1] = $array[$y][$i+1] = ":".($i+1);
$array[1][$i+1] = $array[$y-1][$i+1] = ":";
}
else {
$array[0][$i+1] = $array[$y][$i+1] = ":";
$array[1][$i+1] = $array[$y-1][$i+1] = ":".($i+1);
}
}
$array[0][0] = $array[1][0] = $array[$y-1][0] = $array[$y][0] =
$array[0][$x] = $array[1][$x] = $array[$y-1][$x] = $array[$y][$x] =
":";
last;
};
/^top/ && do {
local($a) = $numpins/4;
for $i (0..$a-1) {
$left[$i] = int(($a+1)/2)+$i;
$right[$i] = 4*$a-int(($a+1)/2)-$i;
$bottom[$i] = $a+int(($a+1)/2)+$i;
if ($i <= int(($a+1)/2)) { $top[$i] = int(($a+1)/2)-$i-1 }
else { $top[$i] = 4*$a+int(($a+1)/2)-$i-1 }
}
last;
};
/^rec/ && do {
local($a1) = 2*$numpins/10;
local($a2) = 3*$numpins/10;
for $i (0..$a1-1) {
$bottom[$i] = $a2+$i;
$top[$i] = $numpins- $i-1;
}
for $i (0..$a2-1) {
$left[$i] = $i;
$right[$i] = $numpins-$a1-$i-1;
}
last;
};
/^ccw/ && do {
local($a) = $numpins/4;
foreach $i (0..$a-1) {
$top[$i] = 4*$a-$i-1;
$left[$i] = $i;
$right[$i] = 3*$a-$i-1;
$bottom[$i] = $a+$i;
}
last;
};
$nothing = 1;
}
($nothing == 1) && do { print "Don't know what $package looks like...
aborting"; die; };
WRITE_DATA:
open (HTML, ">$file.html");
print HTML "<html>\n";
print HTML "<pre>Part:$part\nPackage:$package</pre><table>\n";
if (@array) {
local ($i);
for $y (0..$height) {
print HTML "<tr>\n";
for $x (0..$width) {
$i = $array[$y][$x];
if ($i =~ s/://) { print HTML "<td>$i</td>\n"; }
else { print HTML "<td><img
src=\"$icon/$pin_image[$i].gif\" alt=\"$pin_order[$i]
$pin_name[$i]\"></td>\n" }
}
print HTML "</tr>\n";
}
}
else {
print HTML "<tr>\n<td> </td>\n<td>";
foreach $i (@top) { print HTML "<img
src=\"$icon/TB_$gif{$pin_image[$i]}.gif\" alt=\"$pin_order[$i]
$pin_name[$i]\">" }
print HTML "</td>\n<td> </td>\n</tr>\n<tr>\n<td>\n";
foreach $i (@left) { print HTML "<img
src=\"$icon/LR_$gif{$pin_image[$i]}.gif\" alt=\"$pin_order[$i]
$pin_name[$i]\"><br>\n" }
print HTML "</td>\n<td> </td>\n<td>\n";
foreach $i (@right) { print HTML "<img
src=\"$icon/LR_$gif{$pin_image[$i]}.gif\" alt=\"$pin_order[$i]
$pin_name[$i]\"><br>\n" }
print HTML "</td>\n</tr>\n<tr>\n<td> </td>\n<td>";
foreach $i (@bottom) { print HTML "<img
src=\"$icon/TB_$gif{$pin_image[$i]}.gif\" alt=\"$pin_order[$i]
$pin_name[$i]\">" }
print HTML "</td>\n<td> </td>\n</tr>\n";
$key *= 0;
}
print HTML "</table>\n";
if($key) {
print HTML "\n<a onClick=\"window.open('../pci/legend.html', '',
'height=570, width=300, status=0, scrollbars=no, resizable=yes,
alwaysRaised=yes, toolbar=no, menubar=no, statusbar=no');\"> <font
color=\"#0000FF\"><u>Pin Legend</u></font> </a>\n\n";
}
if(!$key) {
print HTML "\n<a onClick=\"window.open('../pci/legend2.html', '',
'height=500, width=200, status=0, scrollbars=no, resizable=yes,
alwaysRaised=yes, toolbar=no, menubar=no, statusbar=no');\"> <font
color=\"#0000FF\"><u>Pin Legend</u></font> </a>\n\n";
}
print HTML "<pre>\n";
open(PAD, "<$file.pad") or do { print HTML "Couldn't read $file : $!\n";
die; };
while(<PAD>) { print HTML "$_" }
close PAD;
print HTML "</pre>\n</html>"
};
exit;
_________________________________________________________________
Get your FREE download of MSN Explorer at http://explorer.msn.com
--
Posted from [63.204.98.120] by way of f209.law9.hotmail.com [64.4.9.209]
via Mailgate.ORG Server - http://www.Mailgate.ORG
------------------------------
Date: Wed, 21 Feb 2001 18:35:00 -0600
From: Hugo =?iso-8859-1?Q?Gonz=E1lez?= Monteverde <hugonz@hugonz.net>
Subject: Perl ICQ Daemon...
Message-Id: <3A945EB3.47C014B2@hugonz.net>
I want to write a pure web based ICQ clone, that must work through a
proxy, a booth, an appliance or whatever reads HTML.
I've seen that I need two things:
A process that is always running, this will keep sending keepalives to
the ICQ server and handle the contact lists.
A CGI that communicates with this program and gives ir what messages to
send, handles the disply of incoming messages to the browser, etc.
I think perl is a very nice choice for the CGI, but I wonder how could I
implement the "backend" using perl as well. Should I go with C, for
exaple?? I'd rather write it in Perl.
I'm looking for advice, opinions, and also suggestions on the language
of choice. Also, I'd like to know what are the ways that a CGI could
communicate with a running process and feed it data.
Thanks a lot
Hugo
------------------------------
Date: 21 Feb 2001 20:00:34 -0600
From: logan@cs.utexas.edu (Logan Shaw)
Subject: Re: Perl ICQ Daemon...
Message-Id: <971rs2$k8j$1@boomer.cs.utexas.edu>
In article <3A945EB3.47C014B2@hugonz.net>,
Hugo =?iso-8859-1?Q?Gonz=E1lez?= Monteverde <hugonz@hugonz.net> wrote:
>I want to write a pure web based ICQ clone, that must work through a
>proxy, a booth, an appliance or whatever reads HTML.
>
>I've seen that I need two things:
>
>A process that is always running, this will keep sending keepalives to
>the ICQ server and handle the contact lists.
>
>A CGI that communicates with this program and gives ir what messages to
>send, handles the disply of incoming messages to the browser, etc.
>
>I think perl is a very nice choice for the CGI, but I wonder how could I
>implement the "backend" using perl as well. Should I go with C, for
>exaple?? I'd rather write it in Perl.
Do you need it to be scalable? How many ICQ sessions should a machine
be able to handle at once? If your answer is something like 10
connections, then you'll probably be fine by having a separate process
for each ICQ session[1].
If, however, you answer something like 100 or more, then you'll
probably want to use threads. Not only are threads more efficient, but
they also make it easier to share the data you'll need to share.
Anyway, if you want to use threads, Java might be a good choice because
it has lots of built-in support for threads and doing network things
with threads. It's not the fastest thing in the world, but it should't
be bad for something like this, which is I/O intensive rather than CPU
anyway. Of course, you could do it in C++, but it would probably be a
lot more work.
- Logan
[1] However, you'll still have a problem: how will the CGI know which
process to talk to in order to interact with a given ICQ session?
One way to solve this is with an on-disk directory that a master
process updates whenever it forks or harvests a child to deal with
the session.
--
my your his her our their *its*
I'm you're he's she's we're they're *it's*
------------------------------
Date: Wed, 21 Feb 2001 16:18:22 -0800
From: "Robert Murray" <rwm@techie.com>
Subject: Persistent pages?
Message-Id: <971m1i$27c$1@news.service.uci.edu>
I'm interested in creating a dynamic page that can be appended to,
preserving the previous content, with subsequent actions, say like another
search. I just want to take a page I already created from a previous
search, and append the results of my second (and subsequent) searches to
it - basically, persistent pages. Anyone shed some light on how to do
this? Do I have to build a page and remember it? I'm using a frame-based
setup where the search box is in the navigation frame and the page to update
in in the main frame.
------------------------------
Date: Wed, 21 Feb 2001 19:44:34 -0600
From: "Charles K. Clarkson" <c_clarkson@hotmail.com>
Subject: Re: Sendmail
Message-Id: <F89068E7DFDC6FFA.879AB99C2E9A3140.A5FE8528ABCD8CF5@lp.airnews.net>
<NO_SPAM@mail.ru> wrote in message
news:ved79tstkqm6na5jnirosgle29qv1tj5r2@4ax.com...
: Stupid question maybe:
:
: Where can I find sendmail, on the Internet ?
http://www.sendmail.org/
:
: I don't use perl but would like to see how it's done :-)
:
: Thanks,
:
: Igor
------------------------------
Date: Thu, 22 Feb 2001 01:16:06 GMT
From: tim@vegeta.ath.cx (Tim Hammerquist)
Subject: Re: why do i get an unitialized value warning when reading from a file?
Message-Id: <slrn998qg8.llf.tim@vegeta.ath.cx>
Igor Aptekar <igor_aptekar@programmer.net> wrote:
> I get this error in quite a few chunks eventhough i use chomp. Can someone
> explain what it mean and how to prevent it.
It would help a lot to post your code so we can get a better idea of
what's happening.
--
-Tim Hammerquist <timmy@cpan.org>
Emacs is a nice OS - but it lacks a good text editor.
That's why I am using Vim.
-- Anonymous
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 331
**************************************
