my first perl script!

[Matthias Wille]

Hello

I just started to learn perl and wrote my first program today (a big
step for me, a small step for mankind...). Actually it does what it is
supposed to do except for the part which is supposed to match a
certain string. I would appreciate if some perl cracks in this group
could take a short look at my script an tell me if it is good perl
style and tell me some improvements and shortcuts I can make. After
all I like to be a good perl programmer in the end...

I'm wondering if there is a simpler way for replacing strings in a
file without creating temp files.
Oh yes, the code should be as portable as possible, as it should run
also on windows...

Thanks very much!
Matthias

----

#!/usr/bin/perl

use Cwd;
use File::Copy;
use File::Basename;
use File:ath;
#use strict;
#use warnings;

sub printUsage();

# find out current working directory
$cwd = Cwd::cwd();

# check that we are in the right directory
unless (basename(dirname($cwd)) eq "control") {
die "please run this skript from inside a test family folder, i.e.
'thread'";
}

# get command line arguments
($oldcase, $newcase) = @ARGV;

# require at least one argument
unless (defined $oldcase) {
printUsage();
exit 1;
}

$newcase = "$oldcase_COPY" unless defined $newcase;
$family = basename($cwd);

# check if .pm file of oldcase exists
die "Testcase $oldcase does not exist in this folder" unless (-e
"$oldcase.pm");

# try to open .pm files
open(OLD, "<$oldcase.pm") or die "could not open file $oldcase.pm for
reading: $!";
open(NEW, ">$newcase.pm") or die "could not open file $newcase.pm for
writing: $!";

# read in old file and change all occurances of $oldcase to $newcase
while($line = <OLD>) {
$line =~ s/$oldcase/$newcase/g;
print NEW $line;
}

# now the same again with the html file, if any present
if (-e "$oldcase.html") {
open(OLD, "<$oldcase.html") or die "could not open file $oldcase.html
for reading: $!";
open(NEW, ">$newcase.html") or die "could not open file $newcase.html
for writing: $!";
while($line = <OLD>) {
$line =~ s/$oldcase/$newcase/g;
print NEW $line;
}
}
else {
print STDOUT "html file for testcase $oldcase is missing. you shoul
add one...";
}

# add a new Case section for the new test in the isildap.ini file
open(OLD, "<isildap.ini") or die "could not open file isildap.ini for
reading: $!";
open(NEW, ">isildap.ini.new") or die "could not open file isildap.ini
for writing: $!";

# read all lines of isildap.ini file
$lines = join("", <OLD>);

# find matching 'Case = $oldcase { }' block and duplicate it
print STDOUT "found match\n" if $lines =~
m/Case.*=.*$oldcase.*\{(.*?)\}/s;
print NEW $lines;
print NEW "\n";
$newpattern = $&;
$newpattern =~ s/$oldcase/$newcase/g;
print NEW $newpattern;

# delete old isildap.ini file and rename new one
#unlink("isildap.ini") or die "could not delete old isildap.ini file";
#File::Copy::move("isildap.ini.new", "isildap.ini") or die "could not
rename file";

# add a new addVariants entry for the new test in the <family>.pm file
open(OLD, "<$family.pm") or die "could not open file $family.pm for
reading: $!";
open(NEW, ">$family.pm.new") or die "could not open file $family.pm
for writing: $!";

while($line = <OLD>) {
print NEW $line;
if($line =~ s/'$oldcase'/'$newcase'/g) {
print NEW $line;
}
}

# delete old $family.pm file and rename new one
# unlink("$family.pm") or die "could not delete old $family.pm file";
# File::Copy::move("$family.pm.new", "$family.pm") or die "could not
rename file";

exit 0;

# print some help on usage of this skript
sub printUsage() {
select STDOUT;
print "SYNOPSIS:\n";
print "\ttbcopytest testcasename [ newname ]\n";
}

 

[Tassilo v. Parseval]

Also sprach Matthias Wille:

I just started to learn perl and wrote my first program today (a big
step for me, a small step for mankind...). Actually it does what it is
supposed to do except for the part which is supposed to match a
certain string. I would appreciate if some perl cracks in this group
could take a short look at my script an tell me if it is good perl
style and tell me some improvements and shortcuts I can make. After
all I like to be a good perl programmer in the end...

That's the spirit.

I'm wondering if there is a simpler way for replacing strings in a
file without creating temp files.

Yes, there is, see later.

Oh yes, the code should be as portable as possible, as it should run
also on windows...

Oh, that could have some bearing on the in-place editing of a file. See
later as well.

#!/usr/bin/perl

use Cwd;
use File::Copy;
use File::Basename;
use File:ath;
#use strict;
#use warnings;

These comments are unfortunate. Leave those two lines in:

use strict;
use warnings;

Strictures will require some changes to your script. I'll come to that.

sub printUsage();

# find out current working directory
$cwd = Cwd::cwd();

$cwd is now a global variable. This has some other implications as well,
but for now make the variable a lexical one:

my $cwd = cwd();

This is a requirement of strict. It demands that you declare any
variable you are going to use. Thus it catches a lot of typoes.

# check that we are in the right directory
unless (basename(dirname($cwd)) eq "control") {
die "please run this skript from inside a test family folder, i.e.
'thread'";
}

# get command line arguments
($oldcase, $newcase) = @ARGV;

Those are globals again. Once more, use my():

my ($oldcase, $newcase) = @ARGV;

You must not use my() on @ARGV since it's a special variable provided by
Perl. You find those special variables in perlvar.pod.

# require at least one argument
unless (defined $oldcase) {
printUsage();
exit 1;
}

$newcase = "$oldcase_COPY" unless defined $newcase;
$family = basename($cwd);

$family is a newly introduced variable, therefore:

my $family = basename($cwd);

# check if .pm file of oldcase exists
die "Testcase $oldcase does not exist in this folder" unless (-e
"$oldcase.pm");

# try to open .pm files
open(OLD, "<$oldcase.pm") or die "could not open file $oldcase.pm for
reading: $!";
open(NEW, ">$newcase.pm") or die "could not open file $newcase.pm for
writing: $!";

# read in old file and change all occurances of $oldcase to $newcase
while($line = <OLD>) {
$line =~ s/$oldcase/$newcase/g;
print NEW $line;
}

$line is a variable that you only use within the while-block. That means
that you really should make it valid only in this block. Again, use my()
for that:

# now the same again with the html file, if any present
if (-e "$oldcase.html") {
open(OLD, "<$oldcase.html") or die "could not open file $oldcase.html
for reading: $!";
open(NEW, ">$newcase.html") or die "could not open file $newcase.html
for writing: $!";
while($line = <OLD>) {
$line =~ s/$oldcase/$newcase/g;
print NEW $line;
}

Same here:

while (my $line = <OLD>) {

Note that the above $line is different from this one. They just appear
to have the same name, but they are two totally unrelated variables,
valid in two different blocks (=scopes).

}
else {
print STDOUT "html file for testcase $oldcase is missing. you shoul
add one...";
}

# add a new Case section for the new test in the isildap.ini file
open(OLD, "<isildap.ini") or die "could not open file isildap.ini for
reading: $!";
open(NEW, ">isildap.ini.new") or die "could not open file isildap.ini
for writing: $!";

# read all lines of isildap.ini file
$lines = join("", <OLD>);

my $lines = join "", <OLD>;

However, there's a better way to slurp in a whole file:

open OLD, ...;
my $lines = do {
local $/; # enable "slurp" mode
<OLD>;
};

The do() block returns its last evaluated statement which is "<OLD>".
local() will give the variable $/ (it's a special variable and it's
global) temporarily a new value. This new value only exists within the
block. Upon leaving the block, it's previous value is restored. This
mechanism is called dynamic scoping...it does not work with variables
that had been declared with my() because those are lexicals. If you just
use a variable without declaring it, you automatically get such a global
and dynamically scoped variable. That's why you should use my(), unless
you really need a dynamic variable.

# find matching 'Case = $oldcase { }' block and duplicate it
print STDOUT "found match\n" if $lines =~
m/Case.*=.*$oldcase.*\{(.*?)\}/s;

You can just say

print "found match\n" ...

Perl is not C.

print NEW $lines;
print NEW "\n";
$newpattern = $&;
$newpattern =~ s/$oldcase/$newcase/g;
print NEW $newpattern;

Here are two problems: you should not use the variable $& (same for $'
and $`) unless you really need them. They will slow down every
pattern-match in your script since now each pattern has to be made
capturing. But you can avoid this global slowdown by making only
selected patterns capturing:

if ($lines =~ /(Case.*=.*$oldcase.*\{(.*?)\})/s) {
print "found match\n";
my $newpattern = $1;
$newpattern =~ s/$oldcase/$newcase/g;
print NEW $newpattern;
}

Another problem is even more serious: you assume that the pattern match
succeeded, but you shouldn't. Whenever you use variables such as $&, $',
$`, $1, $2, ..., make sure that the previous match did in fact succeed.
Otherwise you end up having garbage in this variables. Perl does not
reset them for each pattern match, that's why you have to wrap their
usage as shown above.

# delete old isildap.ini file and rename new one
#unlink("isildap.ini") or die "could not delete old isildap.ini file";
#File::Copy::move("isildap.ini.new", "isildap.ini") or die "could not
rename file";

# add a new addVariants entry for the new test in the <family>.pm file
open(OLD, "<$family.pm") or die "could not open file $family.pm for
reading: $!";
open(NEW, ">$family.pm.new") or die "could not open file $family.pm
for writing: $!";

while($line = <OLD>) {

print NEW $line;
if($line =~ s/'$oldcase'/'$newcase'/g) {
print NEW $line;
}
}

# delete old $family.pm file and rename new one
# unlink("$family.pm") or die "could not delete old $family.pm file";
# File::Copy::move("$family.pm.new", "$family.pm") or die "could not
rename file";

exit 0;

Not really needed, but wont hurt either.

# print some help on usage of this skript
sub printUsage() {
select STDOUT;

That's a little odd. STDOUT is select()ed by default. Unless you haven't
selected a different filehandle, this line is not needed.

print "SYNOPSIS:\n";
print "\ttbcopytest testcasename [ newname ]\n";
}

As for in-place editing of files, there's a useful idiom that is derived
from a typical one-liner technique:

# put all the files you want to edit
# into @ARGV
local @ARGV = qw( file1 file2 file3 );
local $^I = ''; # it it is defined, in-place edit is done
while ($_ = <>) {
$_ =~ s/old/new/g;
print $_;
}

$^I is the value of the -i switch (see 'perldoc perlrun'). <> reads one
after the other each file in @ARGV. The current record (=line in this
case) in the file is replaced with what you print. Note that you can do
away with the $_ altogether:

while (<>) {
s/old/new/g;
print;
}

The limitation is that this is not going to work under Windows. I am not
sure, but you can set $^I to a true value ('.bak') for instance. In this
case, a backup of the original files is created with the suffix .bak.
This might even work on Windows.

Tassilo

 

[Tassilo v. Parseval]

Also sprach Desmond Coughlan:

Just as a matter of interest..how long have you been doing Perl ? I ask
because I've been working with some Perl books and online tutorials for
about three months, now (on and off, admittedly, as I have other
priorities), and I can _just about_ understand 'hello world!'

So if you tell me you started last week, I'm going to be _very_ depressed.

Maybe he just started this morning. ;-)

Anyway, those figures can't be sensibly compared. It depends on one's
background for instance. Someone being familiar with programming, is
likely to pick up Perl more quickly than someone who's not. On the other
hand, sometimes prior knowledge can be in the way. A Java programmer
might though understand the concepts but could have an inner reluctancy
to accept them which could slow down his learning process.

Anyway, keep reading this group...you'll learn by osmosis (things
sneaking secretely into your mind). If not already done, you could also
subscribe to the (e-mail address removed) mailing-list which usually have
discussions on a gentler level.

Tassilo

 

[sdfgsd]

Just as a matter of interest..how long have you been doing Perl ? I ask

because I've been working with some Perl books and online tutorials for
about three months, now (on and off, admittedly, as I have other
priorities), and I can _just about_ understand 'hello world!'

If it's any consolation, I've been developing software for almost 17 years
and somehow have never had to touch perl. Well that ended three weeks ago.

It's a tough language at first because there is so much functionality to be
had in so few lines of code that you really have to know ALL the basics
before developing any non-trivial programs. Best approach (IMHO), learn the
basics and study OPC (other peoples code) and have a specific need to learn
it.

 

[Tad McClellan]

I would appreciate if some perl cracks in this group
could take a short look at my script an tell me if it is good perl
style and tell me some improvements and shortcuts I can make.

I'm wondering if there is a simpler way for replacing strings in a
file without creating temp files.

How do I change one line in a file/
delete a line in a file/
insert a line in the middle of a file/
append to the beginning of a file?

#use strict;
#use warnings;

You lose the benefit of those statments when you comment them out,
so don't do that.

unless (basename(dirname($cwd)) eq "control") {
die "please run this skript from inside a test family folder, i.e.
'thread'";
}

That should be either:

e.g. 'thread' ("for example")

or

i.e. 'control' ("that is")

$newcase = "$oldcase_COPY" unless defined $newcase;

Do you really want $newcase to get the empty string here?

If not, then either warnings or strictures would have found this bug.

Perhaps you meant:

$newcase = "${oldcase}_COPY" unless defined $newcase;
or
$newcase = $oldcase . "_COPY" unless defined $newcase;

 

[Helgi Briem]

It's a tough language at first because there is so much functionality to be
had in so few lines of code that you really have to know ALL the basics
before developing any non-trivial programs.

I disagree very vehemently. This may be true of Java or C++,
but you can start doing useful stuff *much* earlier in Perl.

Best approach (IMHO), learn the basics
Yes.
and study OPC (other peoples code)

With reservations. There's an awful lot of *horrible*
Perl code out there. Yours is very good by comparison.
There are repositories where you can see good Perl
code, for example:
http://www.stonehenge.com/merlyn/columns.html
http://nms-cgi.sourceforge.net/
http://www.perl.com
http://www.perlmonks.org/

and have a specific need to learn it.

Yes. Learn to use perldoc, too. It will save you no end of
trouble.

 

[Matthias Wille]

Am Mon, 20 Oct 2003 11:30:32 +0200 schrieb Desmond Coughlan:

Just as a matter of interest..how long have you been doing Perl ? I ask
because I've been working with some Perl books and online tutorials for
about three months, now (on and off, admittedly, as I have other
priorities), and I can _just about_ understand 'hello world!'

So if you tell me you started last week, I'm going to be _very_ depressed.

I started about 1 Week ago with perl programming and I think i got the
main principles by now. But I'm a computer scientist, so I already have
experience with programming and understand the basic programming concepts.
So learning a new programming language is just a matter of learning new
syntax, although Perl has quite some constructs I have never seen in other
languages.... very interesting!

Greetings
Matthias

 

[Matthias Wille]

Am Mon, 20 Oct 2003 11:19:46 +0000 schrieb Tassilo v. Parseval:

Thanks for your code review and your tips. You were very helpful!

$cwd is now a global variable. This has some other implications as well,
but for now make the variable a lexical one:

my $cwd = cwd();

This is a requirement of strict. It demands that you declare any
variable you are going to use. Thus it catches a lot of typoes.

Actually I was aware of the 'my' and the whole scoping thing but I thought
it would be cooler not to use it... guess I have still much to learn..

my $lines = join "", <OLD>;

However, there's a better way to slurp in a whole file:

open OLD, ...;
my $lines = do {
local $/; # enable "slurp" mode
<OLD>;
};

The do() block returns its last evaluated statement which is "<OLD>".
local() will give the variable $/ (it's a special variable and it's
global) temporarily a new value. This new value only exists within the
block. Upon leaving the block, it's previous value is restored. This
mechanism is called dynamic scoping...it does not work with variables
that had been declared with my() because those are lexicals. If you just
use a variable without declaring it, you automatically get such a global
and dynamically scoped variable. That's why you should use my(), unless
you really need a dynamic variable.

And why is your 'slurp'-method exactly better? is it faster?

Perl is not C.


Here are two problems: you should not use the variable $& (same for $'
and $`) unless you really need them. They will slow down every
pattern-match in your script since now each pattern has to be made
capturing. But you can avoid this global slowdown by making only
selected patterns capturing:

if ($lines =~ /(Case.*=.*$oldcase.*\{(.*?)\})/s) {
print "found match\n";
my $newpattern = $1;
$newpattern =~ s/$oldcase/$newcase/g; print NEW $newpattern;
}
}
Another problem is even more serious: you assume that the pattern match
succeeded, but you shouldn't. Whenever you use variables such as $&, $',
$`, $1, $2, ..., make sure that the previous match did in fact succeed.
Otherwise you end up having garbage in this variables. Perl does not
reset them for each pattern match, that's why you have to wrap their
usage as shown above.

ok, I rewrote the whole section, because it didn't work to match what i
wanted with regular expressions. Or do you know if it is possible to match
the following string with a reasonable simple regexp?

Case = SOME_CASE {

subcase1 = {.....}
....
subcase2 = {......}

)

The whole block should be matched, but how do I tell the regexp not to
match the inner brackets?

As for in-place editing of files, there's a useful idiom that is derived
from a typical one-liner technique:

# put all the files you want to edit
# into @ARGV
local @ARGV = qw( file1 file2 file3 ); local $^I = ''; # it it
is defined, in-place edit is done while ($_ = <>) {
$_ =~ s/old/new/g;
print $_;
}
}
$^I is the value of the -i switch (see 'perldoc perlrun'). <> reads one
after the other each file in @ARGV. The current record (=line in this
case) in the file is replaced with what you print. Note that you can do
away with the $_ altogether:

while (<>) {
s/old/new/g;
print;
}
}
The limitation is that this is not going to work under Windows. I am not
sure, but you can set $^I to a true value ('.bak') for instance. In this
case, a backup of the original files is created with the suffix .bak.
This might even work on Windows.

ok, thanks, I found this tip also in the camel-perl-book. Really, really
simple i must say...

Thanks again for your help

Matthias

 

[Tad McClellan]

Am Mon, 20 Oct 2003 11:19:46 +0000 schrieb Tassilo v. Parseval:

And why is your 'slurp'-method exactly better? is it faster?

perldoc Benchmark

Or do you know if it is possible to match
the following string with a reasonable simple regexp?

Sure!

This one is pretty simple:

/.*/s

and it will match that string.

This one is even simpler and will also match:

//


Want to rephrase your question?


Is it possible to match balanced/nested things like the
curly brackets in the following string?

Case = SOME_CASE {

subcase1 = {.....}
....
subcase2 = {......}

)

^
^ I sure hope that was supposed to be a {curly} bracket character...

The whole block should be matched, but how do I tell the regexp not to
match the inner brackets?

The inner brackets are enclosed in the "whole block" so they
_must_ be matched if you want the whole block to be matched...

Want to rephrase that question too?


How do I tell the regex to match the _corresponding_
closing curly bracket?


I think this Perl FAQ answers what you meant to ask:

Can I use Perl regular expressions to match balanced text?

 

[Joe Minicozzi]

[snip]

I started about 1 Week ago with perl programming and I think i got the
main principles by now. But I'm a computer scientist, so I already have
experience with programming and understand the basic programming concepts.
So learning a new programming language is just a matter of learning new
syntax, although Perl has quite some constructs I have never seen in other
languages.... very interesting!

Greetings
Matthias

Perl has the often useful and sometimes maddening characteristic of having
"assimilated" features from a number of languages. ("Resistance is
futile.") It has features of C, the UNIX C/system call library, UNIX
shells, a bit of SED/AWK, a bit of C++/Java and possibly some Lisp (which I
don't know so I can't say). So if you are familiar with those, Perl can
look fairly familiar. The maddening part is that some of the assimilated
features are juuuust a little different, which can trip you up. I've been
working with Perl for 5 years and I always have either the "Camel" book or
the Perl docs at hand, so I can double-check things like syntax, semantics
and argument order.

 

[Tassilo v. Parseval]

Also sprach Matthias Wille:

Am Mon, 20 Oct 2003 11:19:46 +0000 schrieb Tassilo v. Parseval:

my $lines = join "", <OLD>;

However, there's a better way to slurp in a whole file:

open OLD, ...;
my $lines = do {
local $/; # enable "slurp" mode
<OLD>;
};

[...]

And why is your 'slurp'-method exactly better? is it faster?

It is likely to be faster, yes. But also, it might make the intention of
the code clearer. It is a common idiom for slurping so fellow
programmers could quickly reckognize what the code is supposed to do.

ok, I rewrote the whole section, because it didn't work to match what i
wanted with regular expressions. Or do you know if it is possible to match
the following string with a reasonable simple regexp?

Case = SOME_CASE {

subcase1 = {.....}
....
subcase2 = {......}

)

The whole block should be matched, but how do I tell the regexp not to
match the inner brackets?

You want a reasonably simple regex, but there is none for this task. It
would have to be recursive, that is: the regexp containing itself. But as
Anno Siegel recently said: it's an obscenity. Using Text::Balanced is an
easier and more robust solution.

Tassilo

 

[Matthias Wille]

Am Thu, 23 Oct 2003 00:10:49 -0500 schrieb Tad McClellan:

perldoc Benchmark

OK, thanks, then I suppose it IS faster...

Sure!

This one is pretty simple:

/.*/s

and it will match that string.

This one is even simpler and will also match:

//


Want to rephrase your question?

OK, I admit it, my question was fairly bad and your answert of course
correct. But what I actually meant is that i have several of those Case =
CASENAME { .. } blocks in a file and want to match one with a specific
name. Obviously the following doesn't work out:

$text =~ m/Case?=?$name?\{.*?\}/s

because the second bracket would also match potential inner brackets. My
question is now if there IS a regexp to match such bracketed
expressions...?

Is it possible to match balanced/nested things like the
curly brackets in the following string?

Case = SOME_CASE {

subcase1 = {.....}
....
subcase2 = {......}

]

^
^ I sure hope that was supposed to be a {curly} bracket character...

Of course, but both square and curly brackets look almost the same with a
small font and anti aliasing, so I didn't notice ...

The inner brackets are enclosed in the "whole block" so they
_must_ be matched if you want the whole block to be matched...

Want to rephrase that question too?

see above!

How do I tell the regex to match the _corresponding_
closing curly bracket?


I think this Perl FAQ answers what you meant to ask:

Can I use Perl regular expressions to match balanced text?

Yeah, exactly, that's what I want to do... thanks!

Greetings
Matthias