[30116] in Perl-Users-Digest
Perl-Users Digest, Issue: 1359 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Mar 13 14:09:41 2008
Date: Thu, 13 Mar 2008 11:09:07 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Thu, 13 Mar 2008 Volume: 11 Number: 1359
Today's topics:
4th Italian Perl Workshop 2008 - Call for Papers /Parti <bepi@perl.it>
command output <jameslockie@mail.com>
Re: End of my tether trying to retrieve keys from multi <guytew@googlemail.com>
Re: End of my tether trying to retrieve keys from multi <guytew@googlemail.com>
Re: End of my tether trying to retrieve keys from multi <someone@example.com>
Re: Faster file iteration xhoster@gmail.com
Re: Faster file iteration <jurgenex@hotmail.com>
Re: Fastest way to find a match? <bik.mido@tiscalinet.it>
Re: Fastest way to find a match? <workitharder@gmail.com>
Re: How do I stop warnings from external packages? <justin.0803@purestblue.com>
Re: Matching multiple subexpressions in a regular expre <sjackman@gmail.com>
Re: My editfile.pl script <someone@example.com>
Re: My editfile.pl script <ignoramus17007@NOSPAM.17007.invalid>
Re: My editfile.pl script <noreply@gunnar.cc>
Style and subroutines in Perl Programs <pgodfrin@gmail.com>
Re: Style and subroutines in Perl Programs <simon.chao@fmr.com>
Re: Style and subroutines in Perl Programs <smallpond@juno.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 13 Mar 2008 17:22:37 GMT
From: Enrico Sorcinelli <bepi@perl.it>
Subject: 4th Italian Perl Workshop 2008 - Call for Papers /Participation
Message-Id: <20080313182233.e5cc1a5f.bepi@perl.it>
Hi all,
the Italian Perl Mongers and the Pisa.pm group are proud to announce the Fo=
urth
Italian Perl Workshop.
The Workshop is aimed at Perl users, professionals and hobbyists alike, but
also to those who are just starting out in this language and want to learn =
its
characteristics and culture.
The Workshop will be held in Pisa, in rooms kindly offered by the Computer
Science department of the University of Pisa, on September 18-19, 2008.
In addition to classic conference-style talks, there will be discussions and
debates on topics of interest, proposed by participants and guided by exper=
ts.
See:
http://conferences.yapceurope.org/ipw2008/cfp.html
for the complete "Call for Papers & Questions".
Registration and participation are free of charge, and includes a coffee-br=
eak
service, also gratis.
In addition, you could have (by paying the optional ticket conference):
- event T-Shirt
- perl.it gadgets
Even though participation in free of charge, we ask you to register as soon=
as
possible: this will help our logistics.
For more info:
- Web: http://conferences.yapceurope.org/ipw2008/
- E-mail: workshop-info@perl.it
- Mailing list: workshop@perl.it=20
(to subscribe, send a message to listmaster@perl.it with 'subscribe
workshop@perl.it' in the subject)
See you! :-)
- Enrico
IPW 08 Organization - Pisa.pm leader
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
IPW08 current Sponsors
- ActiveState - http://www.activestate.com
- Universit=E0 di Pisa and Computer Science Department - http://www.unipi.it
[If you want to become a sponsor, please contact us at
workshop-sponsorship@perl.it]
------------------------------
Date: Thu, 13 Mar 2008 11:01:50 -0700 (PDT)
From: jammer <jameslockie@mail.com>
Subject: command output
Message-Id: <b871b4f6-a12a-46c7-8d0e-f366d94e3b6b@s13g2000prd.googlegroups.com>
There is no output from this:
`/usr/bin/ls -l "$backupDir/$backupName"`;
This shows correct values:
print "/usr/bin/ls -l $backupDir/$backupName";
------------------------------
Date: Thu, 13 Mar 2008 08:42:54 -0700 (PDT)
From: woodyg <guytew@googlemail.com>
Subject: Re: End of my tether trying to retrieve keys from multi-dimensional hash
Message-Id: <e25d83e4-dfa8-4cf0-9483-b46fb338405c@s37g2000prg.googlegroups.com>
On Mar 13, 2:34=A0pm, Ben Morrow <b...@morrow.me.uk> wrote:
> Quoth guy...@googlemail.com:
>
>
>
>
>
> > First off, apologies if what I'm trying to parse is not a multi-
> > dimensional hash - I'm still confused even having read the perldoc and
> > numerous usenet postings :-(
>
> > I am using a perl module to store various configurations [see snippet
> > below]. =A0I want to be able to create an array called @sids that
> > contains the keys ZA1, YB4, XMM so that I can loop through the array
> > and retrieve Description, Ports or whatever using. =A0It seems all the
> > variations for retrieving keys from the simple
> > keys %Instances to the convoluted display nothing! =A0I'm successfully
> > using the Config when I know the keys, but now I need to build a list
> > to work from. =A0Any solutions gratefully received.
>
> > foreach $sid (@SIDS) {
> > =A0 =A0my $port =3D $BASIS::Config::Instances{$sid}{Ports}
> > =A0 =A0# do something with the retrieved value
>
> $port is a hashref, so you need to apply 'Use Rule 1' from perlreftut:
>
> =A0 =A0 # If I had an ordinary hash, I would extract the keys like this
>
> =A0 =A0 keys %hash
>
> =A0 =A0 # Replace the name of the hash with a block
>
> =A0 =A0 keys %{ }
>
> =A0 =A0 # Put the hashref inside
>
> =A0 =A0 keys %{ $port }
>
> This will do what you want. When you're comfortable with the idea, you
> can shorten that into
>
> =A0 =A0 keys %$port
>
> since $port is a simple scalar; but remember it's just a shorthand. You
> could also use something like
>
> =A0 =A0 keys %{ $BASIS::Config::Instances{$sid}{Ports} }
>
> without the temporary, but that's just ugly :). In this case the {}
> *aren't* optional, as what's inside is too complicated.
>
> Ben- Hide quoted text -
>
> - Show quoted text -
Apologies, Ben, but I couldn't understand how I was going to get the
key names (ZA1,YB4,XMM) using your explanation. I'm trying to find
out how to discover the key names from the %Instances hash. If I use
the following I can retrieve the values, but then I have to hard code
them in the @sids array.
use BASIS::Config qw(:Instances);
@sids =3D qw(ZA1 YB4 XMM);
foreach $sid (@sids) {
print "$sid\t";
print "$BASIS::Config::Instances{$sid}{Description}\t";
print "$BASIS::Config::Instances{$sid}{Ports}\n";
}
which produces the following output:-
ZA1 Production 3300 3200
YB4 Quality 3300 3200
XMM Development 3300 3200
Guy
------------------------------
Date: Thu, 13 Mar 2008 09:07:27 -0700 (PDT)
From: woodyg <guytew@googlemail.com>
Subject: Re: End of my tether trying to retrieve keys from multi-dimensional hash
Message-Id: <2a7a0a0f-5b90-4206-b9cb-9bbc379d1fb1@s8g2000prg.googlegroups.com>
> foreach my $sid ( keys %BASIS::Config::Instances ) {
> =A0 =A0 print "$sid\t";
> =A0 =A0 print "$BASIS::Config::Instances{$sid}{Description}\t";
> =A0 =A0 print "$BASIS::Config::Instances{$sid}{Ports}\n";
>
> }
>
> John
> --
> Perl isn't a toolbox, but a small machine shop where you
> can special-order certain sorts of tools at low cost and
> in short order. =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0-- =
Larry Wall- Hide quoted text -
>
> - Show quoted text -
Cheers John. That worked a treat.
------------------------------
Date: Thu, 13 Mar 2008 15:57:45 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: End of my tether trying to retrieve keys from multi-dimensional hash
Message-Id: <Z9cCj.86176$w57.64258@edtnps90>
woodyg wrote:
>
> Apologies, Ben, but I couldn't understand how I was going to get the
> key names (ZA1,YB4,XMM) using your explanation. I'm trying to find
> out how to discover the key names from the %Instances hash. If I use
> the following I can retrieve the values, but then I have to hard code
> them in the @sids array.
>
> use BASIS::Config qw(:Instances);
>
> @sids = qw(ZA1 YB4 XMM);
>
> foreach $sid (@sids) {
> print "$sid\t";
> print "$BASIS::Config::Instances{$sid}{Description}\t";
> print "$BASIS::Config::Instances{$sid}{Ports}\n";
> }
>
> which produces the following output:-
>
> ZA1 Production 3300 3200
> YB4 Quality 3300 3200
> XMM Development 3300 3200
foreach my $sid ( keys %BASIS::Config::Instances ) {
print "$sid\t";
print "$BASIS::Config::Instances{$sid}{Description}\t";
print "$BASIS::Config::Instances{$sid}{Ports}\n";
}
John
--
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall
------------------------------
Date: 13 Mar 2008 16:19:45 GMT
From: xhoster@gmail.com
Subject: Re: Faster file iteration
Message-Id: <20080313121947.040$Pk@newsreader.com>
"vijay@iavian.com" <vijay@iavian.com> wrote:
> use strict;
>
> my $file_1 = '1.txt'; # File 1
> my $file_2 = '2.txt'; # File 2
>
> if(open(FH1 , $file_1)){
> print "File $file_1 Opened\n";
> }else{
> print "Failed to Open file $file_1\n";
> exit;
> }
>
> if(open(FH2 , $file_2)){
> print "File $file_2 Opened\n";
> }else{
> print "Failed to Open file $file_2\n";
> close FH1;
> exit;
> }
>
> while(chomp(my $line_2 = <FH2>)){
> my($dummy21,$file21_no,$file21_date) = split(/\s+/,$line_2);
> next if($file21_no !~ /\d+/);
> my $counter1 = 0;
> my $least_date1 = 0;
> seek(FH1,0,0);
> $least_date1 = date_compare($file21_date);
> while(chomp(my $line_1 = <FH1>)){
> my($d,$file1_no,$file1_date) = split(/;/,$line_1);
> if($file1_no == $file21_no){
You could pre-load file1 into a hash (by $file1_no) of a list of
lines that have that $file1_no. That way for each line in file2, you
only need to go through those lines of file1 that already meet the
above condition. This by itself should greatly improve things unless
there most of the data is all in the same or just a few $file1_no.
> $file1_date =~/(\d\d\d\d)(\d\d)(\d\d)/;
> my $yr1 = $1;
> $file21_date =~/(\d\d\d\d)(\d\d)(\d\d)/;
> if(($yr1 - $1) < 5){
> $counter1++;
> }
And within a given $file1_no hashed list, you could sort by file1_date,
that way once you meet a non-qualifying date you could abort the loop
early rather than testing all the rest. (This improvement would probably
be quite small, compared to the previous one)
Xho
--
-------------------- http://NewsReader.Com/ --------------------
The costs of publication of this article were defrayed in part by the
payment of page charges. This article must therefore be hereby marked
advertisement in accordance with 18 U.S.C. Section 1734 solely to indicate
this fact.
------------------------------
Date: Thu, 13 Mar 2008 16:23:46 GMT
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: Faster file iteration
Message-Id: <v4lit3ldbfc89hufe60eeasg2m5el3i9gi@4ax.com>
"vijay@iavian.com" <vijay@iavian.com> wrote:
[code snipped]
Thank you for posting the code. But what is it _supposed_ to do?
What are the requirements? Unless you tell us we can't know if you are doing
something unneccessary in your code.
>Here $file_1 has around 12000000 records , it takes 2 mins to go for a
>single record in $file_2.
>
>Any suggestion to make it fast ?
Give us a spec and maybe someone will be able to come up with a better
algorithm.
jue
------------------------------
Date: Thu, 13 Mar 2008 16:53:29 +0100
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: Fastest way to find a match?
Message-Id: <n2jit3poi8oglhofkbh5lcqc6oecq6escr@4ax.com>
On Wed, 12 Mar 2008 16:34:08 -0700 (PDT), bukzor
<workitharder@gmail.com> wrote:
>I'm trying to find the fastest way in perl to see if a name contains
>another.
[...]
>so far, I'm using
>
>foreach $t (keys %A) {
> $v = $B;
> $v = s/$t//;
> if ($v ne $B) {
Funniest way I've seen thus far to check for a match!
> print "MATCH"
How 'bout
use List::Util 'first';
# ...
my @rx=map qr/\Q$_\E/ => @A;
say "match!" if first { $B ~~ $_ } @rx;
?
L::U is XS and should be pretty fast.
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: Thu, 13 Mar 2008 10:47:46 -0700 (PDT)
From: bukzor <workitharder@gmail.com>
Subject: Re: Fastest way to find a match?
Message-Id: <a54c044c-55cf-4a98-8f1a-7d206e921a41@8g2000hse.googlegroups.com>
Thanks everyone for your thoughtful posts. The OP was psuedocode and
not to be taken literally.
The piece to check is indeed always surrounded by underscores. Here is
the solution from a coworker that I've implemented:
What about using a hash table? You could put the 2704 "A" names in
hash table. Then, break done "B" into all the possible parts that
could match something in "A" and see if there is something in the hash
table that matches.
$hash{"foo"} = 1;
$hash{"foo1"} = 1;
...
For "INCASE_foo2_YOUWANT", there is only one possible matcher after
you remove everything before the first underscore and after the last
underscore, so just check the hash table for the existence of "foo2".
For "INCASE_foo2_SOMETHING_YOUWANT", you could check both "foo2" and
"SOMETHING".
Wouldn't that be near instant?
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
before:
51.670u 0.100s 0:57.76 89.6% 0+0k 0+0io 1033pf+0w
after:
0.560u 0.040s 0:00.58 103.4% 0+0k 0+0io 1033pf+0w
I'm a happy camper...
------------------------------
Date: Thu, 13 Mar 2008 15:05:26 -0000
From: Justin C <justin.0803@purestblue.com>
Subject: Re: How do I stop warnings from external packages?
Message-Id: <7501.47d942b6.e85d5@zem>
On 2008-03-11, Frank Seitz <devnull4711@web.de> wrote:
> Justin C wrote:
>>
>> The warning is:
>>
>> Name "ProductCodes::codes" used only once: possible typo at
>>
>> How can I stop this without turning off warnings?
>
> Replace require by use or
>
> { no warnings 'once'; print $ProductCodes::codes{$req_delta}; }
That's got it, thanks Frank.
Justin.
--
Justin C, by the sea.
------------------------------
Date: Thu, 13 Mar 2008 09:57:41 -0700 (PDT)
From: ShaunJ <sjackman@gmail.com>
Subject: Re: Matching multiple subexpressions in a regular expression
Message-Id: <dcb2968d-766a-40ae-84b3-cbd4a87c8e26@i7g2000prf.googlegroups.com>
On Mar 12, 7:40 pm, Frank Seitz <devnull4...@web.de> wrote:
> ShaunJ wrote:
> > If I structure my program as in the example, using many small regex
> > instead of one big regex, Perl 5.8.6 runs out of memory and dies:
> > vm_allocate failed, Out of memory! I have 400'000 regex of exactly 27
> > characters each, and the input string is one line 100 kB long.
> [...]
> > my @restrings = <REFILE>;
> > my @re = map { qr/$_/x } @restrings;
>
> 400'000 precompiled regexes are quite a lot!
> Why don't you read and create them in chunks of, say, 1000?
Hi Frank,
400'000 * 27 = 12 MB. I wouldn't say it's that large. It seems
reasonable that the compiled regex would fit in less than one GB of
memory, which is my only requirement.
In any case, the following 9-line code snippet burns through 100MB of
memory a second using Perl 5.8.6! Certainly a memory leak. The only
explanation I can think of is if the m/$re/g expression were
recompiling the regex every time and the previously compiled regex
weren't being discarded.
Thanks,
Shaun
my @restrings = <REFILE>;
my @re = map { qr/$_/x } @restrings;
while (<>) {
foreach my $re (@re) {
while (m/$re/g) {
print $LAST_MATCH_START[0], "\n";
}
}
}
------------------------------
Date: Thu, 13 Mar 2008 16:50:40 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: My editfile.pl script
Message-Id: <AXcCj.86201$w57.20068@edtnps90>
Ignoramus17007 wrote:
> I wrote a script to edit files from command line. You can either
> replace one line with another, add a line after or before a given
> line. When matching lines, it trims all spaces to at most one
> consecutive space for ease of matching. (ie, a line=20
>=20
> /dev/sda2 /data3
>=20
> would match
>=20
> /dev/sda2 /data3
>=20
> The point of this script is to ease remote system administration or
> administration of a number of machines from cron/CVS.
>=20
> Attached is the script as well as a self test shell script that tests
> this script.=20
>=20
> ######################################################################
> #!/usr/bin/perl
>=20
> #
> # Copyright (C) Igor Chudov, 2008.
> # Released to the public under the GNU Public License V3.
> #
>=20
> use strict;
> use warnings;
>=20
> use Getopt::Long;
> use POSIX;
You are importing the whole POSIX module when it appears that you are=20
only using the one macro &POSIX::SEEK_SET from this module. You should=20
limit the amount of stuff you are importing:
use POSIX 'SEEK_SET';
Or since you are using a fully quantified name you could also do:
use POSIX ();
Which would import nothing.
> my $before =3D undef;
> my $after =3D undef;
> my $atend =3D undef;
> my $replace =3D undef;
> my $text =3D undef;
> my $line =3D undef;
You don't need to assign undef to a variable that already contains undef.=
[ SNIP ]
> ############################## Now we have good command line arguments.=
>=20
>=20
> foreach my $file (@files) {
> my $good =3D undef;
>=20
> open( IN, $file );
> open( OUT, ">$file.new" );
You should *always* verify that files have been opened correctly.
> # Check if file has this line already!
> my $has =3D undef;
> while( my $l =3D <IN> ) {
> chomp $l;
> my $L =3D $l;
> $L =3D~ s/^\s+//;
> $L =3D~ s/\s+$//;
> $L =3D~ s/\s+/ /g;
> if( $L eq $LINE ) {
> $has =3D 1;
> last;
> }
> }
>=20
> unless( $has ) {
> seek( IN, &POSIX::SEEK_SET, 0 );
You have the arguments in the wrong order.
seek FILEHANDLE,POSITION,WHENCE
Sets FILEHANDLE=92s position, just like the "fseek" call of
"stdio". FILEHANDLE may be an expression whose value gives
the name of the filehandle. The values for WHENCE are 0 to
set the new position in bytes to POSITION, 1 to set it to
the current position plus POSITION, and 2 to set it to EOF
plus POSITION (typically negative). For WHENCE you may use
the constants "SEEK_SET", "SEEK_CUR", and "SEEK_END" (start
of the file, current position, end of the file) from the
Fcntl module. Returns 1 upon success, 0 otherwise.
You should verify that seek worked correctly.
[ SNIP ]
> if( $good ) {
> rename( "$file.new", $file );
> } else {
> unlink( "$file.new" );
> }
You should verify that rename and unlink worked correctly.
> unless( $good || $has ) {
> die "$0 Failed to perform requested operation on $file.";
> }
> }
John
--=20
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall
------------------------------
Date: Thu, 13 Mar 2008 12:25:46 -0500
From: Ignoramus17007 <ignoramus17007@NOSPAM.17007.invalid>
Subject: Re: My editfile.pl script
Message-Id: <NJidnQ5HoasH_kTanZ2dnUVZ_jmdnZ2d@giganews.com>
On 2008-03-13, John W. Krahn <someone@example.com> wrote:
> Ignoramus17007 wrote:
>> I wrote a script to edit files from command line. You can either
>> replace one line with another, add a line after or before a given
>> line. When matching lines, it trims all spaces to at most one
>> consecutive space for ease of matching. (ie, a line
>>
>> /dev/sda2 /data3
>>
>> would match
>>
>> /dev/sda2 /data3
>>
>> The point of this script is to ease remote system administration or
>> administration of a number of machines from cron/CVS.
>>
>> Attached is the script as well as a self test shell script that tests
>> this script.
>>
>> ######################################################################
>> #!/usr/bin/perl
>>
>> #
>> # Copyright (C) Igor Chudov, 2008.
>> # Released to the public under the GNU Public License V3.
>> #
>>
>> use strict;
>> use warnings;
>>
>> use Getopt::Long;
>> use POSIX;
>
> You are importing the whole POSIX module when it appears that you are
> only using the one macro &POSIX::SEEK_SET from this module. You should
> limit the amount of stuff you are importing:
>
> use POSIX 'SEEK_SET';
Good idea. done
> Or since you are using a fully quantified name you could also do:
>
> use POSIX ();
>
> Which would import nothing.
>
>
>> my $before = undef;
>> my $after = undef;
>> my $atend = undef;
>> my $replace = undef;
>> my $text = undef;
>> my $line = undef;
>
> You don't need to assign undef to a variable that already contains undef.
>
I like to be explicit. Sorry.
> [ SNIP ]
>
>> ############################## Now we have good command line arguments.
>>
>>
>> foreach my $file (@files) {
>> my $good = undef;
>>
>> open( IN, $file );
>> open( OUT, ">$file.new" );
>
> You should *always* verify that files have been opened correctly.
agreed. done
>
>> # Check if file has this line already!
>> my $has = undef;
>> while( my $l = <IN> ) {
>> chomp $l;
>> my $L = $l;
>> $L =~ s/^\s+//;
>> $L =~ s/\s+$//;
>> $L =~ s/\s+/ /g;
>> if( $L eq $LINE ) {
>> $has = 1;
>> last;
>> }
>> }
>>
>> unless( $has ) {
>> seek( IN, &POSIX::SEEK_SET, 0 );
>
> You have the arguments in the wrong order.
>
> seek FILEHANDLE,POSITION,WHENCE
> Sets FILEHANDLE?s position, just like the "fseek" call of
> "stdio". FILEHANDLE may be an expression whose value gives
> the name of the filehandle. The values for WHENCE are 0 to
> set the new position in bytes to POSITION, 1 to set it to
> the current position plus POSITION, and 2 to set it to EOF
> plus POSITION (typically negative). For WHENCE you may use
> the constants "SEEK_SET", "SEEK_CUR", and "SEEK_END" (start
> of the file, current position, end of the file) from the
> Fcntl module. Returns 1 upon success, 0 otherwise.
>
> You should verify that seek worked correctly.
oops.
It boiled down to transposing a zero with a zero, so I was lucky, but
obviously it needs to be done correctly.
done
> [ SNIP ]
>
>> if( $good ) {
>> rename( "$file.new", $file );
>> } else {
>> unlink( "$file.new" );
>> }
>
> You should verify that rename and unlink worked correctly.
done
>
>> unless( $good || $has ) {
>> die "$0 Failed to perform requested operation on $file.";
>> }
>> }
>
>
> John
Here's the new version:
######################################################################
#!/usr/bin/perl
#
# Copyright (C) Igor Chudov, 2008.
# Released to the public under the GNU Public License V3.
#
use strict;
use warnings;
use Getopt::Long;
use POSIX 'SEEK_SET';
my $before = undef;
my $after = undef;
my $atend = undef;
my $replace = undef;
my $text = undef;
my $line = undef;
my $usage ="USAGE: $0 [--after after_line|--atend|--replace replace_line] --line line {files...}";
die $usage unless
GetOptions(
"before=s" => \$before,
"after=s" => \$after,
"atend!" => \$atend,
"replace=s" => \$replace,
"line=s" => \$line,
);
my @files = @ARGV;
sub Cleanup {
my $x = shift;
return $x unless $x;
# $L and $LINE are used for comparisons to take
# spaces and tabs into account, like diff -w
$x =~ s/^\s+//;
$x =~ s/\s+$//;
$x =~ s/\s+/ /g;
return $x;
}
################################################## Syntax check
my $count = 0;
$count++ if $before;
$count++ if $after;
$count++ if $atend;
$count++ if $replace;
die $usage unless $count == 1;
die $usage unless $line;
die $usage unless @files;
my $BEFORE = Cleanup( $before );
my $AFTER = Cleanup( $after );
my $REPLACE = Cleanup( $replace );
my $LINE = Cleanup( $line );
############################## Now we have good command line arguments.
foreach my $file (@files) {
my $good = undef;
open( IN, $file ) || die "Cannot read from $file";
open( OUT, ">$file.new" ) || die "Cannot write to $file.new";
# Check if file has this line already!
my $has = undef;
while( my $l = <IN> ) {
chomp $l;
my $L = $l;
$L =~ s/^\s+//;
$L =~ s/\s+$//;
$L =~ s/\s+/ /g;
if( $L eq $LINE ) {
$has = 1;
last;
}
}
unless( $has ) {
seek( IN, 0, &POSIX::SEEK_SET ) || die "Cannot seek 0, WTF";
while( my $l = <IN> ) {
chomp $l;
my $L = $l;
$L =~ s/^\s+//;
$L =~ s/\s+$//;
$L =~ s/\s+/ /g;
if( $before ) {
#print "Before: '$L' ? '$before'\n";
if( $L eq $BEFORE ) {
print OUT "$line\n";
$good = 1;
}
print OUT "$l\n";
} elsif( $after ) {
#print "After? '$L' ? '$after'\n";
print OUT "$l\n";
if( $L eq $AFTER ) {
print OUT "$line\n";
$good = 1;
}
} elsif( $replace ) {
if( $L eq $REPLACE ) {
print OUT "$line\n";
$good = 1;
} else {
print OUT "$l\n";
}
} else {
print OUT "$l\n";
}
}
if( $atend ) {
print OUT "$line\n";
$good = 1;
}
}
close( IN );
close( OUT );
if( $good ) {
rename( "$file.new", $file ) || die "Cannot rename $file.new to $file";
} else {
unlink( "$file.new" ) || die "Cannot delete $file.new";
}
unless( $good || $has ) {
die "$0 Failed to perform requested operation on $file.";
}
}
------------------------------
Date: Thu, 13 Mar 2008 18:53:20 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: My editfile.pl script
Message-Id: <63t80hF293fbpU1@mid.individual.net>
John W. Krahn wrote:
> Ignoramus17007 wrote:
>>
>> use POSIX;
>
> You are importing the whole POSIX module when it appears that you are
> only using the one macro &POSIX::SEEK_SET from this module. You should
> limit the amount of stuff you are importing:
>
> use POSIX 'SEEK_SET';
>
> Or since you are using a fully quantified name you could also do:
>
> use POSIX ();
>
> Which would import nothing.
But... he is still _loading_ the whole POSIX module. Why not just:
seek( IN, 0, 0 ) || die ...
Or, if a constant is considered useful:
use Fcntl ':seek';
seek( IN, 0, SEEK_SET ) || die ...
Am I possibly missing something here?
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Thu, 13 Mar 2008 10:19:34 -0700 (PDT)
From: pgodfrin <pgodfrin@gmail.com>
Subject: Style and subroutines in Perl Programs
Message-Id: <5a5be273-f411-44cc-b4fb-1a2a76fd8dcd@s8g2000prg.googlegroups.com>
Greetings,
I've browsed the Camel book and perldoc.perl.org about style in a
program and I was wondering what most people think.
I'm in the habit of the following pseudo-code structure of my programs
(or are they scripts :) ):
0. shebang and comments
1. Use statements
2. 'global' variables or constants
3. INIT or BEGINs
4. Subroutine definitions
5. main program, using a "MAIN:" label (just so I can find it)
6. an exit; statement
7. END code
I've seen some code where the subroutines are placed after the "main"
program - this way (my way) seems logical to me, but short of starting
a war of opinion, I was wondering what others thought about the
placement of subroutines?
regards,
phil g
------------------------------
Date: Thu, 13 Mar 2008 10:49:57 -0700 (PDT)
From: nolo contendere <simon.chao@fmr.com>
Subject: Re: Style and subroutines in Perl Programs
Message-Id: <3802ca83-6f80-422c-aa2f-1c7069093315@k13g2000hse.googlegroups.com>
On Mar 13, 1:19=A0pm, pgodfrin <pgodf...@gmail.com> wrote:
> Greetings,
>
> I've browsed the Camel book and perldoc.perl.org =A0about style in a
> program and I was wondering what most people think.
>
> I'm in the habit of the following pseudo-code structure of my programs
> (or are they scripts :) ):
>
> 0. =A0shebang and comments
> 1. =A0Use statements
> 2. =A0'global' variables or constants
> 3. =A0INIT or BEGINs
> 4. =A0Subroutine definitions
> 5. =A0main program, using a "MAIN:" label (just so I can find it)
> 6. =A0an exit; statement
> 7. =A0END code
>
> I've seen some code where the subroutines are placed after the "main"
> program - this way (my way) seems logical to me, but short of starting
> a war of opinion, I was wondering what others thought about the
> placement of subroutines?
I prefer sticking the subs at the end. So if I open a file, i can look
at the main body of the code, and see what's going on immediately
rather than being thrust into low level subroutines, and having to
search for the main body.
------------------------------
Date: Thu, 13 Mar 2008 10:51:30 -0700 (PDT)
From: smallpond <smallpond@juno.com>
Subject: Re: Style and subroutines in Perl Programs
Message-Id: <6c2ee633-b606-4fdf-a9fa-ddcb0e4c858b@x30g2000hsd.googlegroups.com>
On Mar 13, 1:19 pm, pgodfrin <pgodf...@gmail.com> wrote:
> Greetings,
>
> I've browsed the Camel book and perldoc.perl.org about style in a
> program and I was wondering what most people think.
>
> I'm in the habit of the following pseudo-code structure of my programs
> (or are they scripts :) ):
>
> 0. shebang and comments
> 1. Use statements
> 2. 'global' variables or constants
> 3. INIT or BEGINs
> 4. Subroutine definitions
> 5. main program, using a "MAIN:" label (just so I can find it)
> 6. an exit; statement
> 7. END code
>
> I've seen some code where the subroutines are placed after the "main"
> program - this way (my way) seems logical to me, but short of starting
> a war of opinion, I was wondering what others thought about the
> placement of subroutines?
>
> regards,
> phil g
TMTOWTDI
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 V11 Issue 1359
***************************************
