[11252] in Perl-Users-Digest
Perl-Users Digest, Issue: 4853 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Feb 9 11:07:22 1999
Date: Tue, 9 Feb 99 08:01:39 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 9 Feb 1999 Volume: 8 Number: 4853
Today's topics:
HELP on assoc. array g200@my-dejanews.com
Re: HELP on assoc. array <jdf@pobox.com>
Re: HELP on assoc. array <jglascoe@giss.nasa.gov>
Re: HELP on assoc. array <bmb@ginger.libs.uga.edu>
Re: Help with @array <gibsonc@aztec.asu.edu>
Re: how do I get a date in perl? <rra@stanford.edu>
Re: How do I get local IP Address ? (Peter van der Landen)
How to get the size of a directory in Active Perl <xevi@itfintersoft.com>
Re: locking files (Randal L. Schwartz)
Newbie: Help to convert korn script (Jim Hutchison)
Re: pattern matching trouble. please help <rkingsto@jwgrnci6.jaguar.ford.com>
Re: performance penalty: bareword, single quoting, doub <rra@stanford.edu>
Re: performance penalty: bareword, single quoting, doub <bmb@ginger.libs.uga.edu>
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 09 Feb 1999 14:32:43 GMT
From: g200@my-dejanews.com
Subject: HELP on assoc. array
Message-Id: <79pgub$6sd$1@nnrp1.dejanews.com>
Hi, All:
I've got a problem in using the asso. array, I have a data file, looks like:
------------------------------------------------
date: n1 n2
19980101 10 20
19980101 04 06
19980102 11 22
19980103 10 20
19980103 05 05
--------------------------------------------------------
and I want to use asso. array to sort and add the data.
the finalk output i want is like:
19980101 14 26 (add the n1, n2 seperately, for the same day)
19980102 11 22
19980103 15 25
..
-------------------------------------------------------
The little program i used somehow is not quite right...
( I am a newbie in perl...)
I try to see the %DArray, but i am not sure i got it right
in the %DArray because i can't see the elements in the %DArray
...
please give me some hints....
Thanks.
--------------------------------------------------------
#!/usr/local/bin/perl -w
while ( $line = <> ) {
$dateA = substr($line,0,8);
$number1 = substr($line,9,2);
$number2 = substr($line,12,2);
print ("Oh... $dateA, $number1, $number2 . \n");
@DateNumber = ($number1, $number2);
AddData($dateA, $number1, $number2);
}
while (($dateA, @DateNumber) = each %DArray) {
print ("Hay: $dateA, $DateNumber[0], $DateNumber[1] . \n" );
}
sub AddData{
($dateA, $number1, $number2) = @_ ;
$DateNumber[0] += $number1;
$DateNumber[1] += $number2;
$DArray{$dateA} = @DateNumber;
}
-------------------------------------------------------------------------
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: 09 Feb 1999 16:22:02 +0100
From: Jonathan Feinberg <jdf@pobox.com>
Subject: Re: HELP on assoc. array
Message-Id: <m3zp6nli05.fsf@joshua.panix.com>
g200@my-dejanews.com writes:
> $dateA = substr($line,0,8);
> $number1 = substr($line,9,2);
> $number2 = substr($line,12,2);
Most folks would instead do something like
chomp line;
($dateA, $number1, $number2) = split ' ', $line;
> $DArray{$dateA} = @DateNumber;
The value of a hash must be a scalar. You must put an array
*reference* in %DArray (which is a bad name for the variable--it
should be more like %DHash, or just %Dates).
$dates{$date} = [ @numbers ];
You'll have to read perllol, perlref, and perldsc.
--
Jonathan Feinberg jdf@pobox.com Sunny Brooklyn, NY
http://pobox.com/~jdf
------------------------------
Date: Tue, 09 Feb 1999 10:36:26 -0500
From: Jay Glascoe <jglascoe@giss.nasa.gov>
To: g200@my-dejanews.com
Subject: Re: HELP on assoc. array
Message-Id: <36C055FA.C77480E1@giss.nasa.gov>
This is a multi-part message in MIME format.
--------------4D2173BFEF919AB7E8DAB120
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
g200@my-dejanews.com wrote:
>
> Hi, All:
>
> I've got a problem in using the asso. array, I have a data file, looks like:
> ------------------------------------------------
> date: n1 n2
> 19980101 10 20
> 19980101 04 06
> 19980102 11 22
> 19980103 10 20
> 19980103 05 05
> --------------------------------------------------------
> and I want to use asso. array to sort and add the data.
> the finalk output i want is like:
>
> 19980101 14 26 (add the n1, n2 seperately, for the same day)
> 19980102 11 22
> 19980103 15 25
> ..
>
hi. Attached, please find a cleaned up version of your code.
Jay
--------------4D2173BFEF919AB7E8DAB120
Content-Type: application/x-perl;
name="foo2.pl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="foo2.pl"
#! /usr/bin/env perl
use strict;
sub main
{
my %hash = ();
while (my $line = <>)
{
my $dateA = substr($line,0,8);
my $num1 = substr($line,9,2);
my $num2 = substr($line,12,2);
if (exists $hash{$dateA})
{
$hash{$dateA}[0] += $num1;
$hash{$dateA}[1] += $num2;
}
else
{
$hash{$dateA} = [$num1, $num2];
}
}
my @sorted_keys = sort { $a <=> $b } keys %hash;
foreach my $key (@sorted_keys)
{
my $val = $hash{$key};
my ($num1, $num2) = @$val;
print "Hay: $key, $num1, $num2 . \n";
}
}
main();
--------------4D2173BFEF919AB7E8DAB120
Content-Type: application/postscript;
name="foo2.pl.ps"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="foo2.pl.ps"
%!PS-Adobe-3.0
%%Title: foo2.pl
%%Creator: Jay Glascoe (using ps-print v3.06.3)
%%CreationDate: 10:34:10 Feb 09 1999
%%Orientation: Portrait
%% DocumentFonts: Times-Roman Times-Italic Courier Courier-Bold Courier-Oblique Courier-BoldOblique Helvetica Helvetica-Bold
%%Pages: (atend)
%%EndComments
/LandscapeMode false def
/NumberOfColumns 1 def
/LandscapePageHeight 792.0 def
/PrintPageWidth 498.6141732283465 def
/PrintWidth 498.6141732283465 def
/PrintHeight 643.7029732283465 def
/LeftMargin 56.69291338582677 def
/RightMargin 56.69291338582677 def
/InterColumn 56.69291338582677 def
/BottomMargin 42.51968503937008 def
/TopMargin 42.51968503937008 def
/HeaderOffset 28.346456692913385 def
/HeaderPad 2.4276 def
/PrintHeader true def
/PrintOnlyOneHeader false def
/PrintHeaderFrame true def
/ShowNofN true def
/Duplex false def
/LineHeight 8.967500000000001 def
/LinesPerColumn 72 def
/Zebra false def
/PrintLineNumber false def
/ZebraHeight 3 def
% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
/ISOLatin1Encoding where { pop } {
% -- The ISO Latin-1 encoding vector isn't known, so define it.
% -- The first half is the same as the standard encoding,
% -- except for minus instead of hyphen at code 055.
/ISOLatin1Encoding
StandardEncoding 0 45 getinterval aload pop
/minus
StandardEncoding 46 82 getinterval aload pop
%*** NOTE: the following are missing in the Adobe documentation,
%*** but appear in the displayed table:
%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
% 0200 (128)
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
% 0240 (160)
/space /exclamdown /cent /sterling
/currency /yen /brokenbar /section
/dieresis /copyright /ordfeminine /guillemotleft
/logicalnot /hyphen /registered /macron
/degree /plusminus /twosuperior /threesuperior
/acute /mu /paragraph /periodcentered
/cedilla /onesuperior /ordmasculine /guillemotright
/onequarter /onehalf /threequarters /questiondown
% 0300 (192)
/Agrave /Aacute /Acircumflex /Atilde
/Adieresis /Aring /AE /Ccedilla
/Egrave /Eacute /Ecircumflex /Edieresis
/Igrave /Iacute /Icircumflex /Idieresis
/Eth /Ntilde /Ograve /Oacute
/Ocircumflex /Otilde /Odieresis /multiply
/Oslash /Ugrave /Uacute /Ucircumflex
/Udieresis /Yacute /Thorn /germandbls
% 0340 (224)
/agrave /aacute /acircumflex /atilde
/adieresis /aring /ae /ccedilla
/egrave /eacute /ecircumflex /edieresis
/igrave /iacute /icircumflex /idieresis
/eth /ntilde /ograve /oacute
/ocircumflex /otilde /odieresis /divide
/oslash /ugrave /uacute /ucircumflex
/udieresis /yacute /thorn /ydieresis
256 packedarray def
} ifelse
/reencodeFontISO { %def
dup
length 12 add dict % Make a new font (a new dict the same size
% as the old one) with room for our new symbols.
begin % Make the new font the current dictionary.
{ 1 index /FID ne
{ def } { pop pop } ifelse
} forall % Copy each of the symbols from the old dictionary
% to the new one except for the font ID.
currentdict /FontType get 0 ne {
/Encoding ISOLatin1Encoding def % Override the encoding with
% the ISOLatin1 encoding.
} if
% Use the font's bounding box to determine the ascent, descent,
% and overall height; don't forget that these values have to be
% transformed using the font's matrix.
% ^ (x2 y2)
% | |
% | v
% | +----+ - -
% | | | ^
% | | | | Ascent (usually > 0)
% | | | |
% (0 0) -> +--+----+-------->
% | | |
% | | v Descent (usually < 0)
% (x1 y1) --> +----+ - -
currentdict /FontType get 0 ne {
FontBBox % -- x1 y1 x2 y2
FontMatrix transform /Ascent exch def pop
FontMatrix transform /Descent exch def pop
} {
/PrimaryFont FDepVector 0 get def
PrimaryFont /FontBBox get aload pop
PrimaryFont /FontMatrix get transform /Ascent exch def pop
PrimaryFont /FontMatrix get transform /Descent exch def pop
} ifelse
/FontHeight Ascent Descent sub def % use `sub' because descent < 0
% Define these in case they're not in the FontInfo
% (also, here they're easier to get to).
/UnderlinePosition Descent 0.70 mul def
/OverlinePosition Descent UnderlinePosition sub Ascent add def
/StrikeoutPosition Ascent 0.30 mul def
/LineThickness 0 50 FontMatrix transform exch pop def
/Xshadow 0 80 FontMatrix transform exch pop def
/Yshadow 0 -90 FontMatrix transform exch pop def
/SpaceBackground Descent neg UnderlinePosition add def
/XBox Descent neg def
/YBox LineThickness 0.7 mul def
currentdict % Leave the new font on the stack
end % Stop using the font as the current dictionary.
definefont % Put the font into the font dictionary
pop % Discard the returned font.
} bind def
/DefFont { % Font definition
findfont exch scalefont reencodeFontISO
} def
/F { % Font selection
findfont
dup /Ascent get /Ascent exch def
dup /Descent get /Descent exch def
dup /FontHeight get /FontHeight exch def
dup /UnderlinePosition get /UnderlinePosition exch def
dup /OverlinePosition get /OverlinePosition exch def
dup /StrikeoutPosition get /StrikeoutPosition exch def
dup /LineThickness get /LineThickness exch def
dup /Xshadow get /Xshadow exch def
dup /Yshadow get /Yshadow exch def
dup /SpaceBackground get /SpaceBackground exch def
dup /XBox get /XBox exch def
dup /YBox get /YBox exch def
setfont
} def
/FG /setrgbcolor load def
/bg false def
/BG {
dup /bg exch def
{mark 4 1 roll ]}
{[ 1.0 1.0 1.0 ]}
ifelse
/bgcolor exch def
} def
% B width C
% +-----------+
% | Ascent (usually > 0)
% A + +
% | Descent (usually < 0)
% +-----------+
% E width D
/dobackground { % width --
currentpoint % -- width x y
gsave
newpath
moveto % A (x y)
0 Ascent rmoveto % B
dup 0 rlineto % C
0 Descent Ascent sub rlineto % D
neg 0 rlineto % E
closepath
bgcolor aload pop setrgbcolor
fill
grestore
} def
/eolbg { % dobackground until right margin
PrintWidth % -- x-eol
currentpoint pop % -- cur-x
sub % -- width until eol
dobackground
} def
/PLN {PrintLineNumber {doLineNumber}if} def
/SL { % Soft Linefeed
bg { eolbg } if
0 currentpoint exch pop LineHeight sub moveto
} def
/HL {SL PLN} def % Hard Linefeed
% Some debug
/dcp { currentpoint exch 40 string cvs print (, ) print = } def
/dp { print 2 copy exch 40 string cvs print (, ) print = } def
/W {
( ) stringwidth % Get the width of a space in the current font.
pop % Discard the Y component.
mul % Multiply the width of a space
% by the number of spaces to plot
bg { dup dobackground } if
0 rmoveto
} def
/Effect 0 def
/EF {/Effect exch def} def
% stack: string |- --
% effect: 1 - underline 2 - strikeout 4 - overline
% 8 - shadow 16 - box 32 - outline
/S {
/xx currentpoint dup Descent add /yy exch def
Ascent add /YY exch def def
dup stringwidth pop xx add /XX exch def
Effect 8 and 0 ne {
/yy yy Yshadow add def
/XX XX Xshadow add def
} if
bg {
true
Effect 16 and 0 ne
{SpaceBackground doBox}
{xx yy XX YY doRect}
ifelse
} if % background
Effect 16 and 0 ne {false 0 doBox}if % box
Effect 8 and 0 ne {dup doShadow}if % shadow
Effect 32 and 0 ne
{true doOutline} % outline
{show} % normal text
ifelse
Effect 1 and 0 ne {UnderlinePosition Hline}if % underline
Effect 2 and 0 ne {StrikeoutPosition Hline}if % strikeout
Effect 4 and 0 ne {OverlinePosition Hline}if % overline
} bind def
% stack: position |- --
/Hline {
currentpoint exch pop add dup
gsave
newpath
xx exch moveto
XX exch lineto
closepath
LineThickness setlinewidth stroke
grestore
} bind def
% stack: fill-or-not delta |- --
/doBox {
/dd exch def
xx XBox sub dd sub yy YBox sub dd sub
XX XBox add dd add YY YBox add dd add
doRect
} bind def
% stack: fill-or-not lower-x lower-y upper-x upper-y |- --
/doRect {
/rYY exch def
/rXX exch def
/ryy exch def
/rxx exch def
gsave
newpath
rXX rYY moveto
rxx rYY lineto
rxx ryy lineto
rXX ryy lineto
closepath
% top of stack: fill-or-not
{FillBgColor}
{LineThickness setlinewidth stroke}
ifelse
grestore
} bind def
% stack: string |- --
/doShadow {
gsave
Xshadow Yshadow rmoveto
false doOutline
grestore
} bind def
/st 1 string def
% stack: string fill-or-not |- --
/doOutline {
/-fillp- exch def
/-ox- currentpoint /-oy- exch def def
gsave
LineThickness setlinewidth
{
st 0 3 -1 roll put
st dup true charpath
-fillp- {gsave FillBgColor grestore}if
stroke stringwidth
-oy- add /-oy- exch def
-ox- add /-ox- exch def
-ox- -oy- moveto
} forall
grestore
-ox- -oy- moveto
} bind def
% stack: --
/FillBgColor {bgcolor aload pop setrgbcolor fill} bind def
/L0 6 /Times-Italic DefFont
% stack: --
/doLineNumber {
/LineNumber where
{
pop
currentfont
gsave
0.0 0.0 0.0 setrgbcolor
/L0 findfont setfont
LineNumber Lines ge
{(end )}
{LineNumber 6 string cvs ( ) strcat}
ifelse
dup stringwidth pop neg 0 rmoveto
show
grestore
setfont
/LineNumber LineNumber 1 add def
} if
} def
% stack: --
/printZebra {
gsave
0.985 setgray
/double-zebra ZebraHeight ZebraHeight add def
/yiter double-zebra LineHeight mul neg def
/xiter PrintWidth InterColumn add def
NumberOfColumns {LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
grestore
} def
% stack: lines-per-column |- --
/doColumnZebra {
gsave
dup double-zebra idiv {ZebraHeight doZebra 0 yiter rmoveto}repeat
double-zebra mod
dup 0 le {pop}{dup ZebraHeight gt {pop ZebraHeight}if doZebra}ifelse
grestore
} def
% stack: zebra-height (in lines) |- --
/doZebra {
/zh exch 0.05 sub LineHeight mul def
gsave
0 LineHeight 0.65 mul rmoveto
PrintWidth 0 rlineto
0 zh neg rlineto
PrintWidth neg 0 rlineto
0 zh rlineto
fill
grestore
} def
% tx ty rotation xscale yscale xpos ypos BeginBackImage
/BeginBackImage {
/-save-image- save def
/showpage {}def
translate
scale
rotate
translate
} def
/EndBackImage {
-save-image- restore
} def
% string fontsize fontname rotation gray xpos ypos ShowBackText
/ShowBackText {
gsave
translate
setgray
rotate
findfont exch dup /-offset- exch -0.25 mul def scalefont setfont
0 -offset- moveto
/-saveLineThickness- LineThickness def
/LineThickness 1 def
false doOutline
/LineThickness -saveLineThickness- def
grestore
} def
/BeginDoc {
% ---- save the state of the document (useful for ghostscript!)
/docState save def
% ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
/JackGhostscript where {
pop 1 27.7 29.7 div scale
} if
LandscapeMode {
% ---- translate to bottom-right corner of Portrait page
LandscapePageHeight 0 translate
90 rotate
} if
/ColumnWidth PrintWidth InterColumn add def
% ---- translate to lower left corner of TEXT
LeftMargin BottomMargin translate
% ---- define where printing will start
/f0 F % this installs Ascent
/PrintStartY PrintHeight Ascent sub def
/ColumnIndex 1 def
} def
/EndDoc {
% ---- on last page but not last column, spit out the page
ColumnIndex 1 eq not { showpage } if
% ---- restore the state of the document (useful for ghostscript!)
docState restore
} def
/BeginDSCPage {
% ---- when 1st column, save the state of the page
ColumnIndex 1 eq { /pageState save def } if
% ---- save the state of the column
/columnState save def
} def
/PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
/BeginPage {
% ---- when 1st column, print all background effects
ColumnIndex 1 eq {
0 PrintStartY moveto % move to where printing will start
Zebra {printZebra}if
printGlobalBackground
printLocalBackground
} if
PrintHeader {
PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse {
PrintHeaderFrame {HeaderFrame}if
HeaderText
} if
} if
0 PrintStartY moveto % move to where printing will start
PLN
} def
/EndPage {
bg { eolbg } if
} def
/EndDSCPage {
ColumnIndex NumberOfColumns eq {
% ---- on last column, spit out the page
showpage
% ---- restore the state of the page
pageState restore
/ColumnIndex 1 def
} { % else
% ---- restore the state of the current column
columnState restore
% ---- and translate to the next column
ColumnWidth 0 translate
/ColumnIndex ColumnIndex 1 add def
} ifelse
} def
/SetHeaderLines { % nb-lines --
/HeaderLines exch def
% ---- bottom up
HeaderPad
HeaderLines 1 sub HeaderLineHeight mul add
HeaderTitleLineHeight add
HeaderPad add
/HeaderHeight exch def
} def
% |---------|
% | tm |
% |---------|
% | header |
% |-+-------| <-- (x y)
% | ho |
% |---------|
% | text |
% |-+-------| <-- (0 0)
% | bm |
% |---------|
/HeaderFrameStart { % -- x y
0 PrintHeight HeaderOffset add
} def
/HeaderFramePath {
PrintHeaderWidth 0 rlineto
0 HeaderHeight rlineto
PrintHeaderWidth neg 0 rlineto
0 HeaderHeight neg rlineto
} def
/HeaderFrame {
gsave
0.4 setlinewidth
% ---- fill a black rectangle (the shadow of the next one)
HeaderFrameStart moveto
1 -1 rmoveto
HeaderFramePath
0 setgray fill
% ---- do the next rectangle ...
HeaderFrameStart moveto
HeaderFramePath
gsave 0.9 setgray fill grestore % filled with grey
gsave 0 setgray stroke grestore % drawn with black
grestore
} def
/HeaderStart {
HeaderFrameStart
exch HeaderPad add exch % horizontal pad
% ---- bottom up
HeaderPad add % vertical pad
HeaderDescent sub
HeaderLineHeight HeaderLines 1 sub mul add
} def
/strcat {
dup length 3 -1 roll dup length dup 4 -1 roll add string dup
0 5 -1 roll putinterval
dup 4 2 roll exch putinterval
} def
/pagenumberstring {
PageNumber 32 string cvs
ShowNofN {
(/) strcat
PageCount 32 string cvs strcat
} if
} def
/HeaderText {
HeaderStart moveto
HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
% ---- hack: `PN 1 and' == `PN 2 modulo'
% ---- if duplex and even page number, then exchange left and right
Duplex PageNumber 1 and 0 eq and { exch } if
{ % ---- process the left lines
aload pop
exch F
gsave
dup xcheck { exec } if
show
grestore
0 HeaderLineHeight neg rmoveto
} forall
HeaderStart moveto
{ % ---- process the right lines
aload pop
exch F
gsave
dup xcheck { exec } if
dup stringwidth pop
PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
show
grestore
0 HeaderLineHeight neg rmoveto
} forall
} def
/ReportFontInfo {
2 copy
/t0 3 1 roll DefFont
/t0 F
/lh FontHeight def
/sw ( ) stringwidth pop def
/aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
stringwidth pop exch div def
/t1 12 /Helvetica-Oblique DefFont
/t1 F
gsave
(For ) show
128 string cvs show
( ) show
32 string cvs show
( point, the line height is ) show
lh 32 string cvs show
(, the space width is ) show
sw 32 string cvs show
(,) show
grestore
0 FontHeight neg rmoveto
gsave
(and a crude estimate of average character width is ) show
aw 32 string cvs show
(.) show
grestore
0 FontHeight neg rmoveto
} def
/cm { % cm to point
72 mul 2.54 div
} def
/ReportAllFontInfo {
FontDirectory
{ % key = font name value = font dictionary
pop 10 exch ReportFontInfo
} forall
} def
% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
% 3 cm 20 cm moveto ReportAllFontInfo showpage
/printGlobalBackground {
} def
/printLocalBackground {
} def
/h0 14 /Helvetica-Bold DefFont
/h1 12 /Helvetica DefFont
% ---- These lines must be kept together because...
/h0 F
/HeaderTitleLineHeight FontHeight def
/h1 F
/HeaderLineHeight FontHeight def
/HeaderDescent Descent def
% ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
/f0 8.5 /Courier DefFont
/f1 8.5 /Courier-Bold DefFont
/f2 8.5 /Courier-Oblique DefFont
/f3 8.5 /Courier-BoldOblique DefFont
BeginDoc
%%EndPrologue
%%Page: 1 1
/Lines 34 def
/PageCount 1 def
BeginDSCPage
/LineNumber 1 def
/PageNumber 1 def
/HeaderLinesLeft [
[ /h0 (foo2.pl) ]
[ /h1 (/gcm/jglascoe/EXAMPLES/) ]
] def
/HeaderLinesRight [
[ /h0 /pagenumberstring load ]
[ /h1 (Feb 09 1999) ]
] def
2 SetHeaderLines
BeginPage
/f0 F
false BG
0.000 0.000 0.000 FG
0.698 0.133 0.133 FG
(#! /usr/bin/env perl) S
HL
0.000 0.000 0.000 FG
HL
/f1 F
0.627 0.125 0.941 FG
(use) S
/f0 F
0.000 0.000 0.000 FG
( ) S
0.316 0.316 0.980 FG
(strict) S
0.000 0.000 0.000 FG
(;) S
HL
HL
/f1 F
0.627 0.125 0.941 FG
(sub) S
/f0 F
0.000 0.000 0.000 FG
( ) S
0.316 0.316 0.980 FG
(main) S
0.000 0.000 0.000 FG
HL
({) S
HL
( ) S
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( ) S
(%hash) S
( = \(\);) S
HL
( ) S
/f1 F
0.627 0.125 0.941 FG
(while) S
/f0 F
0.000 0.000 0.000 FG
( \() S
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( $line = <>\)) S
HL
( {) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( ) S
/f1 F
0.722 0.525 0.043 FG
($dateA) S
/f0 F
0.000 0.000 0.000 FG
( = ) S
0.133 0.545 0.133 FG
1 EF
(substr) S
0.000 0.000 0.000 FG
0 EF
(\($line,0,8\);) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( ) S
/f1 F
0.722 0.525 0.043 FG
($num1) S
/f0 F
0.000 0.000 0.000 FG
( = ) S
0.133 0.545 0.133 FG
1 EF
(substr) S
0.000 0.000 0.000 FG
0 EF
(\($line,9,2\);) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( ) S
/f1 F
0.722 0.525 0.043 FG
($num2) S
/f0 F
0.000 0.000 0.000 FG
( = ) S
0.133 0.545 0.133 FG
1 EF
(substr) S
0.000 0.000 0.000 FG
0 EF
(\($line,12,2\);) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(if) S
/f0 F
0.000 0.000 0.000 FG
( \() S
(exists) S
( ) S
($hash) S
({$dateA}\)) S
HL
8 W
({) S
HL
12 W
($hash) S
({$dateA}[0] += $num1;) S
HL
12 W
($hash) S
({$dateA}[1] += $num2;) S
HL
8 W
(}) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(else) S
/f0 F
0.000 0.000 0.000 FG
HL
8 W
({) S
HL
12 W
($hash) S
({$dateA} = [$num1, $num2];) S
HL
8 W
(}) S
HL
( }) S
HL
( ) S
HL
( ) S
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( ) S
(@sorted_keys) S
( = ) S
(sort) S
( { $a <=> $b } ) S
(keys) S
( ) S
(%hash) S
(;) S
HL
( ) S
/f1 F
0.627 0.125 0.941 FG
(foreach) S
/f0 F
0.000 0.000 0.000 FG
( ) S
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( $key \() S
(@sorted_keys) S
(\)) S
HL
( {) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( ) S
/f1 F
0.722 0.525 0.043 FG
($val) S
/f0 F
0.000 0.000 0.000 FG
( = ) S
($hash) S
({$key};) S
HL
8 W
/f1 F
0.627 0.125 0.941 FG
(my) S
/f0 F
0.000 0.000 0.000 FG
( \() S
/f1 F
0.722 0.525 0.043 FG
($num1) S
/f0 F
0.000 0.000 0.000 FG
(, ) S
/f1 F
0.722 0.525 0.043 FG
($num2) S
/f0 F
0.000 0.000 0.000 FG
(\) = @$val;) S
HL
8 W
(print) S
( ) S
0.737 0.561 0.561 FG
("Hay: $key, $num1, $num2 . \\n") S
0.000 0.000 0.000 FG
(;) S
HL
( }) S
HL
(}) S
HL
HL
(main\(\);) S
HL
EndPage
EndDSCPage
%%Trailer
%%Pages: 1
EndDoc
%%EOF
--------------4D2173BFEF919AB7E8DAB120--
------------------------------
Date: Tue, 9 Feb 1999 10:52:53 -0500
From: Brad Baxter <bmb@ginger.libs.uga.edu>
To: g200@my-dejanews.com
Subject: Re: HELP on assoc. array
Message-Id: <Pine.A41.4.02.9902091036460.36116-100000@ginger.libs.uga.edu>
On Tue, 9 Feb 1999 g200@my-dejanews.com wrote:
> please give me some hints....
> Thanks.
>
> --------------------------------------------------------
> #!/usr/local/bin/perl -w
Hint: use 'use strict;'
> while ( $line = <> ) {
> $dateA = substr($line,0,8);
> $number1 = substr($line,9,2);
> $number2 = substr($line,12,2);
Hint: use 'split'.
> print ("Oh... $dateA, $number1, $number2 . \n");
> @DateNumber = ($number1, $number2);
> AddData($dateA, $number1, $number2);
> }
>
> while (($dateA, @DateNumber) = each %DArray) {
Hint: you can't store an array in a hash. You can, however, store a
*reference* to an array. Read up on references and "hashes of arrays".
> print ("Hay: $dateA, $DateNumber[0], $DateNumber[1] . \n" );
> }
>
> sub AddData{
> ($dateA, $number1, $number2) = @_ ;
> $DateNumber[0] += $number1;
> $DateNumber[1] += $number2;
> $DArray{$dateA} = @DateNumber;
> }
You probably meant to store \@DateNumber in the hash. What you stored was
scalar @DateNumber, i.e. 2. But since @DateNumber is a global variable,
that's still not going to do what you want.
Hint: Sit down and write a step by step description of what you want to
do before you code anything. I'm sure there's a more straight-forward way
to do what you're trying that is much less confusing. As it is, I venture
to say you have a number of logic errors.
Cheers!
-Brad
------------------------------
Date: Tue, 9 Feb 1999 08:05:52 -0700
From: "gip" <gibsonc@aztec.asu.edu>
Subject: Re: Help with @array
Message-Id: <79pijo$fuu@bmw.hwcae.az.Honeywell.COM>
The problem, I believe, is how you're specifying an element of an array.
> @item_array[$count] = $skuid;
Should be $item_array[$count] = $skuid;
tszeto wrote in message <36B05FB6.C71FE14C@mindspring.com>...
>Hi,
>
>I can't figure out why I can't print to screen an element of this array.
>I can print the whole array, but when I try to just print out $array[0],
>nothing comes up.
>
>Any help appreciated.
>
>Regards,
>Ted
>
>The script fragment is as follows and I try to print in the last two
>lines.
>
>open (infile, "file");
>
>$line = <infile>;
>chomp $line;
>
>###### beginning of product loop ############
>$count= 0;
>while ($line ne "*** BILLING INFO: ***") {
>
> if ($line =~ /SKUID: /) {
> $skuid = $line;
> $skuid =~ s/SKUID: //;
> $skuid =~ s/ //g;
> @item_array[$count] = $skuid;
> $line = <infile>;
> }
>
> if ($line =~ /QUANTITY: /) {
> $quantity = $line;
> $quantity =~ s/QUANTITY: //;
> $quantity =~ s/ //g;
> @item_array[$count + 1] = $quantity;
> }
>
> $count++;
> $line = <infile>;
> chomp $line;
>
>}
>###### end of product loop ############
>
>print @item_array, "\n";
>print $iem_array[0];
>
>
------------------------------
Date: 09 Feb 1999 02:19:13 -0800
From: Russ Allbery <rra@stanford.edu>
Subject: Re: how do I get a date in perl?
Message-Id: <ylg18fnala.fsf@windlord.stanford.edu>
Steven T Henderson <stevenhenderson@prodigy.net> writes:
> Duc Le wrote in message <36BE41A8.66878025@best.com>...
>> I don't know if Perl has any function for date manipulation besides
>> localtime(). I just want to do a simple task like getting the week
>> date from any given day of the month. For example, given "02/12/1999",
>> I would like to know what date of the week this day falls on.
> yup, i had the same problem so i wrote a cool little library. check out:
> http://www.stevenhenderson.com and select Perl Dates button.
Er... I don't mean to discourage anyone from sharing their code, at all,
but did you realize that you've basically just reinvented a combination of
Date::Parse, Date::Manip, and POSIX::strftime(), the last of which is part
of Perl core, and the former two of which are on CPAN?
If you knew you were doing that and did this anyway, because yours is
faster or smaller or better geared towards something you're doing or just
because you want to, great! But if you didn't know about those other ways
of doing this, I wanted to let you know (and let readers know about them
as well, since they're somewhat more standard -- TimeDate, the CPAN
package that contains Date::Parse, is something that I pretty much always
install as part of any Perl installation).
--
#!/usr/bin/perl -- Russ Allbery, Just Another Perl Hacker
$^=q;@!>~|{>krw>yn{u<$$<[~||<Juukn{=,<S~|}<Jwx}qn{<Yn{u<Qjltn{ > 0gFzD gD,
00Fz, 0,,( 0hF 0g)F/=, 0> "L$/GEIFewe{,$/ 0C$~> "@=,m,|,(e 0.), 01,pnn,y{
rw} >;,$0=q,$,,($_=$^)=~y,$/ C-~><@=\n\r,-~$:-u/ #y,d,s,(\$.),$1,gee,print
------------------------------
Date: Tue, 09 Feb 1999 15:18:26 GMT
From: landen@frg.eur.nl (Peter van der Landen)
Subject: Re: How do I get local IP Address ?
Message-Id: <36c151bc.1150547750@zeus.safenet.nl>
On Fri, 05 Feb 1999 14:29:31 GMT, droby@copyright.com wrote:
>In article <x73e4lnzpr.fsf@home.sysarch.com>,
> Uri Guttman <uri@home.sysarch.com> wrote:
>> >>>>> "MC" == Michael Ching <m_ching@hotmail.com> writes:
>>
>> MC> if under winnt, ipconfig
>>
>> not that i really give a damn, but can that be called from perl or is it
>> another winblows only useless program? you can't parse a window.
>>
>winblows, but DOS shell based, so you can do `ipconfig` and parse the result.
On a similar note, under Windows 95 you have winipcfg, a windowing
app, but I recently learned it also has a batch mode. This, however,
doesn't report to standard output as common sense would suggest, but
to some (fixed location) output file. Better than nothing, I
suppose...
Regards,
------------------------------
Date: Tue, 9 Feb 1999 16:55:25 +0100
From: "Xavier Batlle" <xevi@itfintersoft.com>
Subject: How to get the size of a directory in Active Perl
Message-Id: <79plaa$egd$1@diana.bcn.ttd.net>
Can I get the size of a directory with Active Perl 5.0.(and subdirectories).
Thanks in advanced.
xevi@itfintersoft.com
------------------------------
Date: 09 Feb 1999 07:14:30 -0800
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: locking files
Message-Id: <m1yam7r4mh.fsf@halfdome.holdit.com>
[note... comp.lang.perl has been DEAD for 2.5 years. Please
stop posting to it.]
>>>>> "Chris" == Chris Komuves <nosp_am@kom.com> writes:
Chris> The solution is to do some sort of file locking. In the simpliest
Chris> case, have your script create a lockfile (just a blank file is fine)
Chris> before you start writing to a particular data file, and delete it when
Chris> the write is finished. Before you write to the datafile, check for
Chris> the existance of the lockfile. If there is one, wait (sleep) until it
Chris> is gone, then create your own lockfile, write the data, and delete
Chris> your lockfile. This way, only one process at a time can write to the
Chris> file.
That's the simplest and MOST BROKEN way. Kids, don't try this at
home. That's a VERY BAD locking mechanism, subject to race
conditions. All good lockings systems have a *single* step in which
the lock is tested-for-and-acquired, usually with proper O/S support.
perldoc -f flock, et. al.
print "Just another Perl flocker,"
--
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@teleport.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me
------------------------------
Date: Tue, 09 Feb 1999 15:29:15 GMT
From: jimhutchison@metronet.ca (Jim Hutchison)
Subject: Newbie: Help to convert korn script
Message-Id: <36bf6e3a.28409160@news1.cal.metronet.ca>
As a newbie to perl, I'm still trying to wrap my head around the
language. I'm VERY used to ksh - piping, standard in/out, etc. Maybe
perl has these too, but they haven't jumped up & bit me yet.
I'd like advice from someone who has good knowledge of Unix scripting
to offer suggestions on the following script.
-----------------------------------------------------------------------------------
#!/bin/ksh
# Un-comment to de-bug.
#set -x
read LINE
while [[ $LINE != "" ]]
do
set -A L $(echo $LINE)
IP=${L[0]}
URL=$(echo ${L[6]} | cut -d\/ -f1,2,3 | sed "s/\"//g")
BYTES=${L[8]}
HOUR=$(echo ${L[3]} | cut -d\: -f2)
echo "$IP $URL $BYTES $HOUR"
read LINE
done
------------------------------------------------------------------------------------
Obviously, it accepts a piped file and selects only the wanted fields.
The file sent to it is a proxy log for which I've written a fairly
elaborate reporting tool (...in ksh!), but when the log is fed to this
script, it takes 10 hrs to run. I would assume that a perl script
would simply open the log file & process it, as opposed to feeding the
log file to a perl script one line at a time... right?
I certainly appreciate any help.
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Jim Hutchison
Senior Unix Network Analyst
MetroNet Communications
Calgary AB Canada
T2P-3Y7
Help Wanted: Telepath. You know where to apply.
------------------------------
Date: Tue, 09 Feb 1999 13:09:59 +0000
From: Richard Kingston <rkingsto@jwgrnci6.jaguar.ford.com>
Subject: Re: pattern matching trouble. please help
Message-Id: <36C033A7.316A5E53@jwgrnci6.jaguar.ford.com>
23_skidoo wrote:
> i'm having a problem with pattern matching, i want to check an email
> address to match the following examples:
>
> a@y.z - minimum requirement, 1/more chars (word), @ then word-dot-word
>
> a.b.c@w.x.y.z
>
> open ended requirement: word, 0/more x (dot-word), @ word, 1/more
> (dot-word)
>
> i tried to use this but it doesn't work properly.
>
> if ($input{'email'} !~ /\w+(?:\.\w+)?@\w+(?:\.\w+)+/) {
> &error(bad_email);
> }
>
> i thought my problem was that i'm misusing parentheses but i included ?:
> so they would just act as grouping.
>
> this allows a@b.c. to get through, i had hoped that the final (?:\.\w+)+
> would match
> '1 or more repetitions of dot-word'
> but not
> '1 or more repetitions of (dot-optional_word)'
>
Your problem is that you are checking to see if your string contains the
above regular expression, rather that looking to see if it is equivalent to
that expression. Therefore, it will match a@b.c. because this contains
a@b.c
You must add a $ into the end of your expression to tell it to look for the
end of the string.
Thus, try:
if ($input !~ /\w+(\.\w+)*@\w+(\.\w+)+$/)
Really, I suppose, we should also put a ^ at the front of the expression to
totally enclose it.
>
> which is what it seems to do.
>
> can anyone help here?
>
> thanks for your time
>
> -23
------------------------------
Date: 09 Feb 1999 02:14:54 -0800
From: Russ Allbery <rra@stanford.edu>
Subject: Re: performance penalty: bareword, single quoting, double quoting
Message-Id: <ylk8xrnash.fsf@windlord.stanford.edu>
mlehmann <mlehmann@prismnet.com> writes:
> I have been wondering for a while if I should use barewords for the keys
> in hashes. I started off using:
> $hash{'key_value'}
> because I thought it was the least amount of work for perl to determine
> what I want.
That's really a bad reason for doing that. The amount of work Perl has to
do for $hash{"key_value"} over $hash{'key_value'} or $hash{key_value} is
miniscule and won't be noticed unless you're recompiling that code in a
tight loop (*highly* unlikely). And even then is almost certainly dwarfed
by other factors.
I use '' for strings without interpolation and "" for strings with
interpolation, not because it's faster for Perl, but because it's clearer
for *me* later on. If I see '' around a string, I know immediately that
it's not going to have any variables interpolated into it, and I don't
have to scan the string looking for backslash sequences or variables.
--
#!/usr/bin/perl -- Russ Allbery, Just Another Perl Hacker
$^=q;@!>~|{>krw>yn{u<$$<[~||<Juukn{=,<S~|}<Jwx}qn{<Yn{u<Qjltn{ > 0gFzD gD,
00Fz, 0,,( 0hF 0g)F/=, 0> "L$/GEIFewe{,$/ 0C$~> "@=,m,|,(e 0.), 01,pnn,y{
rw} >;,$0=q,$,,($_=$^)=~y,$/ C-~><@=\n\r,-~$:-u/ #y,d,s,(\$.),$1,gee,print
------------------------------
Date: Tue, 9 Feb 1999 10:29:33 -0500
From: Brad Baxter <bmb@ginger.libs.uga.edu>
Subject: Re: performance penalty: bareword, single quoting, double quoting
Message-Id: <Pine.A41.4.02.9902091018241.36116-100000@ginger.libs.uga.edu>
On 9 Feb 1999, Mark-Jason Dominus wrote:
> Brad Baxter <bmb@ginger.libs.uga.edu> wrote:
> >11 ### Ambiguous use of {x} resolved to {"x"}
> >12 ### at /export/home/bmb/bin/qt line 6.
>
> That confusing and pointless warning message went away in perl5.005,
> I'm glad to say.
Very glad to hear it (I *really* need to upgrade).
> >(Please note, perl did the right thing.) In those cases where you have
> >to, just put those keys in quotes, i.e., $h{'DESTROY'}, $h{'x'}.
>
> The quotes are unnecessary. Perl told you that it resolved your
> `ambiguous' form to the quoted version automatically.
Unnecessay with perl5.005 apparently. Perhaps I should have said "In
those cases where you don't want -w to complain (with older versions of
perl) ... "
Regards,
-Brad
------------------------------
Date: 12 Dec 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Dec 98)
Message-Id: <null>
Administrivia:
Well, after 6 months, here's the answer to the quiz: what do we do about
comp.lang.perl.moderated. Answer: nothing.
]From: Russ Allbery <rra@stanford.edu>
]Date: 21 Sep 1998 19:53:43 -0700
]Subject: comp.lang.perl.moderated available via e-mail
]
]It is possible to subscribe to comp.lang.perl.moderated as a mailing list.
]To do so, send mail to majordomo@eyrie.org with "subscribe clpm" in the
]body. Majordomo will then send you instructions on how to confirm your
]subscription. This is provided as a general service for those people who
]cannot receive the newsgroup for whatever reason or who just prefer to
]receive messages via e-mail.
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.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
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.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
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 V8 Issue 4853
**************************************
