Passing arguments containing spaces from one script to another in Perl - perl

I am trying to pass arguments from one Perl script to another. Some of the arguments contain spaces.
I am reading in a comma-delimited text file and splitting each line on the comma.
my ($jockey, $racecourse, $racenum, $hnamenum, $trainer, $TDRating, $PRO) = split(/,/, $line);
The data in the comma-delimited text file look as follows:
AARON LYNCH,WARRNAMBOOL,RACE 1,DAREBIN (8),ERIC MUSGROVE,B,1
When I print out each variable, from the parent script, they look fine (as above).
print "$jockey\n";
print "$racecourse\n";
print "$racenum\n";
print "$hnamenum\n";
print "$trainer\n";
print "$TDRating\n";
print "$PRO\n";
AARON LYNCH
WARRNAMBOOL
RACE 1
DAREBIN (8)
ERIC MUSGROVE
B
1
When I pass the arguments to the child script (as follows), the arguments are passed incorrectly.
system("perl \"$bindir\\narrative4.pl\" $jockey $racecourse $racenum $hnamenum $trainer $TDRating $PRO");
AARON
LYNCH
WARRNAMBOOL
RACE
1
DAREBIN
(8)
As you can see, $ARGV[0] becomes AARON, $ARGV[1] becomes LYNCH, $ARGV[2] becomes WARRNAMBOOL, and so on.
I have investigated adding quotes to the arguments using qq, quotemeta and Win32::ShellQuote, unfortunately, even if I pass qq{"$jockey"}, the quotes are still stripped before they reach the child script, so they must be protected in some way.
I not sure if either of the aforementioned solutions is the correct but I'm happy to be corrected.
I'd appreciate any suggestions. Thanks in advance.
Note: I am running this using Strawberry Perl on a Windows 10 PC.
Note2: I purposely left out use strict; & use warnings; in these examples.
Parent Script
use Cwd;
$dir = getcwd;
$bin = "bin"; $bindir = "$dir/$bin";
$infile = "FINAL-SORTED-JOCKEY-RIDES-FILE.list";
open (INFILE, "<$infile") or die "Could not open $infile $!\n";
while (<INFILE>)
{
$line = $_;
chomp($line);
my ($jockey, $racecourse, $racenum, $hnamenum, $trainer, $TDRating, $PRO) = split(/,/, $line);
print "$jockey\n";
print "$racecourse\n";
print "$racenum\n";
print "$hnamenum\n";
print "$trainer\n";
print "$TDRating\n";
print "$PRO\n";
system("perl \"$bindir\\narrative4.pl\" $jockey $racecourse $racenum $hnamenum $trainer $TDRating $PRO");
sleep (1);
}
close INFILE;
exit;
Child Script
$passedjockey = $ARGV[0];
$passedracecourse = $ARGV[1];
$passedracenum = $ARGV[2];
$passedhnamenum = $ARGV[3];
$passedtrainer = $ARGV[4];
$passedTDRating = $ARGV[5];
$passedPRO = $ARGV[6];
print "$passedjockey\n";
print "$passedracecourse\n";
print "$passedracenum\n";
print "$passedhnamenum\n";
print "$passedtrainer\n";
print "$passedTDRating\n";
print "$passedPRO\n\n";

That whole double-quoted string that is passed to system is first evaluated and thus all variables are interpolated -- so the intended multi-word arguments become merely words in a list. So in the end the string has a command to run with individual words as arguments.
Then, even if you figure out how to stick which quotes in there just right, so to keep those multi-word arguments "together," there's still a chance of a shell being invoked, in which case those arguments again get broken up into words before being passed to the program.
Instead of all this use the LIST form of system. The first argument is then the name of the program that will be directly executed without a shell (see docs for some details on that), and the remaining arguments are passed as they are to that program.
parent
use warnings;
use strict;
use feature 'say';
my #args = ('first words', 'another', 'two more', 'final');
my $prog = 'print_args.pl';
system($prog, #args) == 0
or die "Error w/ system($prog, #args): $!";
and the invoked print_args.pl
use warnings;
use strict;
use feature 'say';
say for #ARGV;
The #ARGV contains arguments passed to the program at invocation. There's more that can be done to inspect the error, see docs and links in them.†
By what you show you indeed don't need a shell and the LIST form is generally easy to recommend as a basic way to use system, when the shell isn't needed. If you were to need shell's capabilities for something in that command then you'd have to figure out how to protect those spaces.
† And then there are modules for running external programs that are far better than system & Co. From ease-of-use to features and power:
IPC::System::Simple, Capture::Tiny, IPC::Run3, IPC::Run.

Related

Can one concatenate two Perl scripts which use different input record separators?

Two Perl scripts, using different input record separators, work together to convert a LaTeX file into something easily searched for human-readable phrases and sentences. Of course, they could be wrapped together by a single shell script. But I am curious whether they can be incorporated into a single Perl script.
The reason for these scripts: It would be a hassle to find "two three" inside short.tex, for instance. But after conversion, grep 'two three' will return the first paragraph.
For any LaTeX file (here, short.tex), the scripts are invoked as follows.
cat short.tex | try1.pl | try2.pl
try1.pl works on paragraphs. It gets rid of LaTeX comments. It makes sure that each word is separated from its neighbors by a single space, so that no sneaky tabs, form feeds, etc., lurk between words. The resulting paragraph occupies a single line, consisting of visible characters separated by single spaces --- and at the end, a sequence of at least two newlines.
try2.pl slurps the entire file. It makes sure that paragraphs are separated from each other by exactly two newlines. And it ensures that the last line of the file is non-trivial, containing visible character(s).
Can one elegantly concatenate two operations such as these, which depend on different input record separators, into a single Perl script, say big.pl? For instance, could the work of try1.pl and try2.pl be accomplished by two functions or bracketed segments inside the larger script?
Incidentally, is there a Stack Overflow keyword for "input record separator"?
###File try1.pl:
#!/usr/bin/perl
use strict;
use warnings;
use 5.18.2;
local $/ = ""; # input record separator: loop through one paragraph at a time. position marker $ comes only at end of paragraph.
while (<>) {
s/[\x25].*\n/ /g; # remove all LaTeX comments. They start with %
s/[\t\f\r ]+/ /g; # collapse each "run" of whitespace to one single space
s/^\s*\n/\n/g; # any line that looks blank is converted to a pure newline;
s/(.)\n/$1/g; # Any line that does not look blank is joined to the subsequent line
print;
print "\n\n"; # make sure each paragraph is separated from its fellows by newlines
}
###File try2.pl:
#!/usr/bin/perl
use strict;
use warnings;
use 5.18.2;
local $/ = undef; # input record separator: entire text or file is a single record.
while (<>) {
s/[\n][\n]+/\n\n/g; # exactly 2 blank lines separate paragraphs. Like cat -s
s/[\n]+$/\n/; # last line is nontrivial; no blank line at the end
print;
}
###File short.tex:
\paragraph{One}
% comment
two % also 2
three % or 3
% comment
% comment
% comment
% comment
% comment
% comment
So they said%
that they had done it.
% comment
% comment
% comment
Fleas.
% comment
% comment
After conversion:
\paragraph{One} two three
So they said that they had done it.
Fleas.
To combine try1.pl and try2.pl into a single script you could try:
local $/ = "";
my #lines;
while (<>) {
[...] # Same code as in try1.pl except print statements
push #lines, $_;
}
$lines[-1] =~ s/\n+$/\n/;
print for #lines;
A pipe connects the output of one process to the input of another process. Neither one knows about the other nor cares how it operates.
But, putting things together like this breaks the Unix pipeline philosophy of small tools that each excel at a very narrow job. Should you link these two things, you'll always have to do both tasks even if you want one (although you could get into configuration to turn off one, but that's a lot of work).
I process a lot of LaTeX, and I control everything through a Makefile. I don't really care about what the commands look like and I don't even have to remember what they are:
short-clean.tex: short.tex
cat short.tex | try1.pl | try2.pl > $#
Let's do it anyways
I'll limit myself to the constraint of basic concatenation instead of complete rewriting or rearranging, most because there are some interesting things to show.
Consider what happens should you concatenate those two programs by simply adding the text of the second program at the end of the text of the first program.
The output from the original first program still goes to standard output and the second program now doesn't get that output as input.
The input to the program is likely exhausted by the original first program and the second program now has nothing to read. That's fine because it would have read the unprocessed input to the first program.
There are various ways to fix this, but none of them make much sense when you already have two working program that do their job. I'd shove that in the Makefile and forget about it.
But, suppose you do want it all in one file.
Rewrite the first section to send its output to a filehandle connected to a string. It's output is now in the programs memory. This basically uses the same interface, and you can even use select to make that the default filehandle.
Rewrite the second section to read from a filehandle connected to that string.
Alternately, you can do the same thing by writing to a temporary file in the first part, then reading that temporary file in the second part.
A much more sophisticated program would the first program write to a pipe (inside the program) that the second program is simultaneously reading. However, you have to pretty much rewrite everything so the two programs are happening simultaneously.
Here's Program 1, which uppercases most of the letters:
#!/usr/bin/perl
use v5.26;
$|++;
while( <<>> ) { # safer line input operator
print tr/a-z/A-Z/r;
}
and here's Program 2, which collapses whitespace:
#!/usr/bin/perl
use v5.26;
$|++;
while( <<>> ) { # safer line input operator
print s/\s+/ /gr;
}
They work serially to get the job done:
$ perl program1.pl
The quick brown dog jumped over the lazy fox.
THE QUICK BROWN DOG JUMPED OVER THE LAZY FOX.
^D
$ perl program2.pl
The quick brown dog jumped over the lazy fox.
The quick brown dog jumped over the lazy fox.
^D
$ perl program1.pl | perl program2.pl
The quick brown dog jumped over the lazy fox.
THE QUICK BROWN DOG JUMPED OVER THE LAZY FOX.
^D
Now I want to combine those. First, I'll make some changes that don't affect the operation but will make it easier for me later. Instead of using implicit filehandles, I'll make those explicit and one level removed from the actual filehandles:
Program 1:
#!/usr/bin/perl
use v5.26;
$|++;
my $output_fh = \*STDOUT;
while( <<>> ) { # safer line input operator
print { $output_fh } tr/a-z/A-Z/r;
}
Program 2:
#!/usr/bin/perl
$|++;
my $input_fh = \*STDIN;
while( <$input_fh> ) { # safer line input operator
print s/\s+/ /gr;
}
Now I have the chance to change what those filehandles are without disturbing the meat of the program. The while doesn't know or care what that filehandle is, so let's start by writing to a file in Program 1 and reading from that same file in Program 2:
Program 1:
#!/usr/bin/perl
use v5.26;
open my $output_fh, '>', 'program1.out' or die "$!";
while( <<>> ) { # safer line input operator
print { $output_fh } tr/a-z/A-Z/r;
}
close $output_fh;
Program 2:
#!/usr/bin/perl
$|++;
open my $input_fh, '<', 'program1.out' or die "$!";
while( <$input_fh> ) { # safer line input operator
print s/\h+/ /gr;
}
However, you can no longer run these in a pipeline because Program 1 doesn't use standard output and Program 2 doesn't read standard input:
% perl program1.pl
% perl program2.pl
You can, however, now join the programs, shebang and all:
#!/usr/bin/perl
use v5.26;
open my $output_fh, '>', 'program1.out' or die "$!";
while( <<>> ) { # safer line input operator
print { $output_fh } tr/a-z/A-Z/r;
}
close $output_fh;
#!/usr/bin/perl
$|++;
open my $input_fh, '<', 'program1.out' or die "$!";
while( <$input_fh> ) { # safer line input operator
print s/\h+/ /gr;
}
You can skip the file and use a string instead, but at this point, you've gone beyond merely concatenating files and need a little coordination for them to share the scalar with the data. Still, the meat of the program doesn't care how you made those filehandles:
#!/usr/bin/perl
use v5.26;
my $output_string;
open my $output_fh, '>', \ $output_string or die "$!";
while( <<>> ) { # safer line input operator
print { $output_fh } tr/a-z/A-Z/r;
}
close $output_fh;
#!/usr/bin/perl
$|++;
open my $input_fh, '<', \ $output_string or die "$!";
while( <$input_fh> ) { # safer line input operator
print s/\h+/ /gr;
}
So let's go one step further and do what the shell was already doing for us.
#!/usr/bin/perl
use v5.26;
pipe my $input_fh, my $output_fh;
$output_fh->autoflush(1);
while( <<>> ) { # safer line input operator
print { $output_fh } tr/a-z/A-Z/r;
}
close $output_fh;
while( <$input_fh> ) { # safer line input operator
print s/\h+/ /gr;
}
From here, it gets a bit tricky and I'm not going to go to the next step with polling filehandles so one thing can write and the the next thing reads. There are plenty of things that do that for you. And, you're now doing a lot of work to avoid something that was already simple and working.
Instead of all that pipe nonsense, the next step is to separate code into functions (likely in a library), and deal with those chunks of code as named things that hide their details:
use Local::Util qw(remove_comments minify);
while( <<>> ) {
my $result = remove_comments($_);
$result = minify( $result );
...
}
That can get even fancier where you simply go through a series of steps without knowing what they are or how many of them there will be. And, since all the baby steps are separate and independent, you're basically back to the pipeline notion:
use Local::Util qw(get_input remove_comments minify);
my $result;
my #steps = qw(get_input remove_comments minify)
while( ! eof() ) { # or whatever
no strict 'refs'
$result = &{$_}( $result ) for #steps;
}
A better way makes that an object so you can skip the soft reference:
use Local::Processor;
my #steps = qw(get_input remove_comments minify);
my $processer = Local::Processor->new( #steps );
my $result;
while( ! eof() ) { # or whatever
$result = $processor->$_($result) for #steps;
}
Like I did before, the meat of the program doesn't care or know about the steps ahead of time. That means that you can move the sequence of steps to configuration and use the same program for any combination and sequence:
use Local::Config;
use Local::Processor;
my #steps = Local::Config->new->get_steps;
my $processer = Local::Processor->new;
my $result;
while( ! eof() ) { # or whatever
$result = $processor->$_($result) for #steps;
}
I write quite a bit about this sort of stuff in Mastering Perl and Effective Perl Programming. But, because you can do it doesn't mean you should. This reinvents a lot that make can already do for you. I don't do this sort of thing without good reason—bash and make have to be pretty annoying to motivate me to go this far.
The motivating problem was to generate a "cleaned" version of a LaTeX file, which would be easy to search, using regex, for complex phrases or sentences.
The following single Perl script does the job, whereas previously I required one shell script and two Perl scripts, entailing three invocations of Perl. This new, single script incorporates three consecutive loops, each with a different input record separator.
First loop:
input = STDIN, or a file passed as argument; record separator=default, loop by line; print result to fileafterperlLIN, a temporary
file on the hard drive.
Second loop:
input = fileafterperlLIN;
record separator = "", loop by paragraph;
print result to fileafterperlPRG, a temporary file on the hard drive.
Third loop:
input = fileafterperlPRG;
record separator = undef, slurp entire file
print result to STDOUT
This has the disadvantage of printing to and reading from two files on the hard drive, which may slow it down. Advantages are that the operation seems to require only one process; and all the code resides in a single file, which should make it easier to maintain.
#!/usr/bin/perl
# 2019v04v05vFriv17h18m41s
use strict;
use warnings;
use 5.18.2;
my $diagnose;
my $diagnosticstring;
my $exitcode;
my $userName = $ENV{'LOGNAME'};
my $scriptpath;
my $scriptname;
my $scriptdirectory;
my $cdld;
my $fileafterperlLIN;
my $fileafterperlPRG;
my $handlefileafterperlLIN;
my $handlefileafterperlPRG;
my $encoding;
my $count;
sub diagnosticmessage {
return unless ( $diagnose );
print STDERR "$scriptname: ";
foreach $diagnosticstring (#_) {
printf STDERR "$diagnosticstring\n";
}
}
# Routine setup
$scriptpath = $0;
$scriptname = $scriptpath;
$scriptname =~ s|.*\x2f([^\x2f]+)$|$1|;
$cdld = "$ENV{'cdld'}"; # A directory to hold temporary files used by scripts
$exitcode = system("test -d $cdld && test -w $cdld || { printf '%\n' 'cdld not a writeable directory'; exit 1; }");
die "$scriptname: system returned exitcode=$exitcode: bail\n" unless $exitcode == 0;
$scriptdirectory = "$cdld/$scriptname"; # To hold temporary files used by this script
$exitcode = system("test -d $scriptdirectory || mkdir $scriptdirectory");
die "$scriptname: system returned exitcode=$exitcode: bail\n" unless $exitcode == 0;
diagnosticmessage ( "scriptdirectory=$scriptdirectory" );
$exitcode = system("test -w $scriptdirectory && test -x $scriptdirectory || exit 1;");
die "$scriptname: system returned exitcode=$exitcode: $scriptdirectory not writeable or not executable. bail\n" unless $exitcode == 0;
$fileafterperlLIN = "$scriptdirectory/afterperlLIN.tex";
diagnosticmessage ( "fileafterperlLIN=$fileafterperlLIN" );
$exitcode = system("printf '' > $fileafterperlLIN;");
die "$scriptname: system returned exitcode=$exitcode: bail\n" unless $exitcode == 0;
$fileafterperlPRG = "$scriptdirectory/afterperlPRG.tex";
diagnosticmessage ( "fileafterperlPRG=$fileafterperlPRG" );
$exitcode=system("printf '' > $fileafterperlPRG;");
die "$scriptname: system returned exitcode=$exitcode: bail\n" unless $exitcode == 0;
# This script's job: starting with a LaTeX file, which may compile beautifully in pdflatex but be difficult
# to read visually or search automatically,
# (1) convert any line that looks blank --- a "trivial line", containing only whitespace --- to a pure newline. This is because
# (a) LaTeX interprets any whitespace line following a non-blank or "nontrivial" line as end of paragraph, whereas
# (b) Perl needs two consecutive newlines to signal end of paragraph.
# (2) remove all LaTeX comments;
# (3) deal with the \unskip LaTeX construct, etc.
# The result will be
# (4) each LaTeX paragraph will occupy a unique line
# (5) exactly one pair of newlines --- visually, one blank line --- will divide each pair of consecutive paragraphs
# (6) first paragraph will be on first line (no opening blank line) and last paragraph will be on last line (no ending blank line)
# (7) whitespace in output will consist of only
# (a) a single space between readable strings, or
# (b) double newline between paragraphs
#
$handlefileafterperlLIN = undef;
$handlefileafterperlPRG = undef;
$encoding = ":encoding(UTF-8)";
diagnosticmessage ( "fileafterperlLIN=$fileafterperlLIN" );
open($handlefileafterperlLIN, ">> $encoding", $fileafterperlLIN) || die "$0: can't open $fileafterperlLIN for appending: $!";
# Loop 1 / line:
# Default input record separator: loop through one line at a time, delimited by \n
$count = 0;
while (<>) {
$count = $count + 1;
diagnosticmessage ( "line $count" );
s/^\s*\n/\n/mg; # Convert any trivial line to a pure newline.
print $handlefileafterperlLIN $_;
}
close($handlefileafterperlLIN);
open($handlefileafterperlLIN, "< $encoding", $fileafterperlLIN) || die "$0: can't open $fileafterperlLIN for reading: $!";
open($handlefileafterperlPRG, ">> $encoding", $fileafterperlPRG) || die "$0: can't open $fileafterperlPRG for appending: $!";
# Loop PRG / paragraph:
local $/ = ""; # Input record separator: loop through one paragraph at a time. position marker $ comes only at end of paragraph.
$count = 0;
while (<$handlefileafterperlLIN>) {
$count = $count + 1;
diagnosticmessage ( "paragraph $count" );
s/(?<!\x5c)[\x25].*\n/ /g; # Remove all LaTeX comments.
# They start with % not \% and extend to end of line or newline character. Join to next line.
# s/(?<!\x5c)([\x24])/\x2a/g; # 2019v04v01vMonv13h44m09s any $ not preceded by backslash \, replace $ by * or something.
# This would be only if we are going to run detex on the output.
s/(.)\n/$1 /g; # Any line that has something other than newline, and then a newline, is joined to the subsequent line
s|([^\x2d])\s*(\x2d\x2d\x2d)([^\x2d])|$1 $2$3|g; # consistent treatment of triple hyphen as em dash
s|([^\x2d])(\x2d\x2d\x2d)\s*([^\x2d])|$1$2 $3|g; # consistent treatment of triple hyphen as em dash, continued
s/[\x0b\x09\x0c\x20]+/ /gm; # collapse each "run" of whitespace other than newline, to a single space.
s/\s*[\x5c]unskip(\x7b\x7d)?\s*(\S)/$2/g; # LaTeX whitespace-collapse across newlines
s/^\s*//; # Any nontrivial line: No indenting. No whitespace in first column.
print $handlefileafterperlPRG $_;
print $handlefileafterperlPRG "\n\n"; # make sure each paragraph ends with 2 newlines, hence at least 1 blank line.
}
close($handlefileafterperlPRG);
open($handlefileafterperlPRG, "< $encoding", $fileafterperlPRG) || die "$0: can't open $fileafterperlPRG for reading: $!";
# Loop slurp
local $/ = undef; # Input record separator: entire file is a single record.
$count = 0;
while (<$handlefileafterperlPRG>) {
$count = $count + 1;
diagnosticmessage ( "slurp $count" );
s/[\n][\n]+/\n\n/g; # Exactly 2 blank lines (newlines) separate paragraphs. Like cat -s
s/[\n]+$/\n/; # Last line is visible or "nontrivial"; no trivial (blank) line at the end
s/^[\n]+//; # No trivial (blank) line at the start. The first line is "nontrivial."
print STDOUT;
}

Data::Dumper wraps second word's output

I'm experiencing a rather odd problem while using Data::Dumper to try and check on my importing of a large list of data into a hash.
My Data looks like this in another file.
##Product ID => Market for product
ABC => Euro
XYZ => USA
PQR => India
Then in my script, I'm trying to read in my list of data into a hash like so:
open(CONFIG_DAT_H, "<", $config_data);
while(my $line = <CONFIG_DAT_H>) {
if($line !~ /^\#/) {
chomp($line);
my #words = split(/\s*\=\>\s/, $line);
%product_names->{$words[0]} = $words[1];
}
}
close(CONFIG_DAT_H);
print Dumper (%product_names);
My parsing is working for the most part that I can find all of my data in the hash, but when I print it using the Data::Dumper it doesn't print it properly. This is my output.
$VAR1 = 'ABC';
';AR2 = 'Euro
$VAR3 = 'XYZ';
';AR4 = 'USA
$VAR5 = 'PQR';
';AR6 = 'India
Does anybody know why the Dumper is printing the '; characters over the first two letters on my second column of data?
There is one unclear thing in the code: is *product_names a hash or a hashref?
If it is a hash, you should use %product_names{key} syntax, not %product_names->{key}, and need to pass a reference to Data::Dumper, so Dumper(\%product_names).
If it is a hashref then it should be labelled with a correct sigil, so $product_names->{key} and Dumper($product_names}.
As noted by mob if your input has anything other than \n it need be cleaned up more explicitly, say with s/\s*$// per comment. See the answer by ikegami.
I'd also like to add, the loop can be simplified by loosing the if branch
open my $config_dat_h, "<", $config_data or die "Can't open $config_data: $!";
while (my $line = <$config_dat_h>)
{
next if $line =~ /^\#/; # or /^\s*\#/ to account for possible spaces
# ...
}
I have changed to the lexical filehandle, the recommended practice with many advantages. I have also added a check for open, which should always be in place.
Humm... this appears wrong to me, even you're using Perl6:
%product_names->{$words[0]} = $words[1];
I don't know Perl6 very well, but in Perl5 the reference should be like bellow considering that %product_names exists and is declared:
$product_names{...} = ... ;
If you could expose the full code, I can help to solve this problem.
The file uses CR LF as line endings. This would become evident by adding the following to your code:
local $Data::Dumper::Useqq = 1;
You could convert the file to use unix line endings (seeing as you are on a unix system). This can be achieved using the dos2unix utility.
dos2unix config.dat
Alternatively, replace
chomp($line);
with the more flexible
$line =~ s/\s+\z//;
Note: %product_names->{$words[0]} makes no sense. It happens to do what you want in old versions of Perl, but it rightfully throws an error in newer versions. $product_names{$words[0]} is the proper syntax for accessing the value of an element of a hash.
Tip: You should be using print Dumper(\%product_names); instead of print Dumper(%product_names);.
Tip: You might also find local $Data::Dumper::Sortkeys = 1; useful. Data::Dumper has such bad defaults :(
Tip: Using split(/\s*=>\s*/, $line, 2) instead of split(/\s*=>\s*/, $line) would permit the value to contain =>.
Tip: You shouldn't use global variable without reason. Use open(my $CONFIG_DAT_H, ...) instead of open(CONFIG_DAT_H, ...), and replace other instances of CONFIG_DAT_H with $CONFIG_DAT_H.
Tip: Using next if $line =~ /^#/; would avoid a lot of indenting.

perl error: Use of uninitialized value $_ in concatenation (.) or string

I get the following error:
Use of uninitialized value $_ in concatenation (.) or string at checkfornewfiles.pl line 34.
when attempting to run the following code :
#!/usr/bin/perl -w
#Author: mimo
#Date 3/2015
#Purpose: monitor directory for new files...
AscertainStatus();
######### start of subroutine ########
sub AscertainStatus {
my $DIR= "test2";
####### open handler #############
opendir (HAN1, "$DIR") || die "Problem: $!";
########## assign theoutput of HAN1 to array1 ##########
my #array1= readdir(HAN1);
######## adding some logic #########
if ("$#array1" > 1) { #### if files exists (more than 1) in the directory #######
for (my $i=0; $i<2; $i++) {shift #array1;} ####### for i in position 0 (which is the . position) loop twice and add one (the position ..) get rid of them #######
MailNewFiles(#array1);
} else { print "No New Files\n";}
}
sub MailNewFiles {
$mail= "sendmail";
open ($mail, "| /usr/lib/sendmail -oi -t" ) ||die "errors with sendmail $!"; # open handler and pipe it to sendmail
print $mail <<"EOF"; #print till the end of fiEOF
From: "user";
To: "root";
Subject: "New Files Found";
foreach (#_) {print $mail "new file found:\n $_\n";}
EOF
close($mail);
}
#End
I am new to perl and I don't know what's going wrong. Can anyone help me ?
A few suggestions:
Perl isn't C. Your main program loop shouldn't be a declared subroutine which you then execute. Eliminate the AscertainStatus subroutine.
Always, always use strict; and use warnings;.
Indent correctly. It makes it much easier for people to read your code and help analyze what you did wrong.
Use a more modern Perl coding style. Perl is an old language, and over the years new coding style and techniques have been developed to help you eliminate basic errors and help others read your code.
Don't use system commands when there are Perl modules that can do this for you in a more standard way, and probably do better error checking. Perl comes with the Net::SMTP that handles mail communication for you. Use that.
The error Use of uninitialized value $_ in concatenation (.) or string is exactly what it says. You are attempting to use a value of a variable that hasn't been set. In this case, the variable is the #_ variable in your foreach statement. Your foreach isn't a true foreach, but part of your print statement since your EOF is after your for statement. This looks like an error.
Also, what is the value of #_? This variable contains a list of values that have been passed to your subroutine. If none are passed, it will be undefined. Even if #_ is undefined, foreach (undef) will simply skip the loop. However, since foreach (#_) { is a string to print, your Perl program will crash without #_ being defined.
If you remove the -w from #!/usr/bin/perl, your program will actually "work" (Note the quotes), and you'll see that your foreach will literally print.
I do not recommend you not to use warnings which is what -w does. In fact, I recommend you use warnings; rather than -w. However, in this case, it might help you see your error.
You have EOF after the line with foreach. It contains $_ which is interpolated here but $_ is not initialized yet because it is not in foreach loop. It is not code but just text. Move EOF before foreach.
But probably you would like
sub MailNewFiles {
$mail= "sendmail";
open ($mail, "| /usr/lib/sendmail -oi -t" ) ||die "errors with sendmail $!"; # open handler and pipe it to sendmail
local $"="\n"; # " make syntax highlight happy
print $mail <<"EOF"; #print till the end of fiEOF
From: "user";
To: "root";
Subject: "New Files Found";
New files found:
#_
EOF
close($mail);
}
See perlvar for more informations about $".
The message
Use of uninitialized value $xxx in ...
is very straightforward. When you encounter it, it means that you are using a variable ($xxx) in any way, but that the variable has not ever been initialized.
Sometimes, adding an initialization command at the start of you code is enough :
my $str = '';
my $num = 0;
Sometimes, your algorithm is wrong, or you just mistyped your variable, like in :
my $foo = 'foo';
my $bar = $ffo . 'bar'; # << There is a warning on this line
# << because you made a mistake on $foo ($ffo)

CGI.pm: file handle in global hash lost between subroutines?

I'd like to store file handle to a global hash and read() it in a subroutine without revealing CGI object, but I find that it doesn't work(resulting zero sized output file).
Here is the simplified perl code:
#!/usr/local/bin/perl
use CGI;
use vars qw(%in);
&init_hash;
$fname = &process_uploaded_file if($in{'upfile'});
$fsize = -s $fname;
print "Content-Type: text/plain\r\n\r\n";
print "in{'upfile'}=",$in{'upfile'},"\r\n";
print "in{'desc'}=",$in{'desc'},"\r\n";
print "fname=",$fname,"\r\n";
print "fsize=",$fsize,"\r\n";
sub init_hash{
my $q = new CGI;
$in{'desc'} = $q->param('desc');
$in{'upfile'} = $q->param('upfile');
$in{'upfh'} = $q->upload('upfile') if($in{'upfile'});
}
sub process_uploaded_file{
my $fname = time.'.bin';
open(OUT,'>',$fname) || die('open file failed');
while(my $read = read($in{'upfh'}, my $buff, 4096)){
print OUT $buff;
}
close(OUT);
eval { close($in{'upfh'}); };
return $fname;
}
EDIT: I should provide perl and cgi.pm version.
Perl version: This is perl 5, version 12, subversion 2 (v5.12.2) built for MSWin32-x86-multi-thread
(with 8 registered patches, see perl -V for more detail)
$CGI::VERSION='3.50';
There is so much wrong with your code.
First your problem: you are trying to optimize where optimization isn't due. And the temp files of the CGI object are deleted before you actually access them. Your code should work when you extend the lifetime of the CGI object, e.g. by adding it to the %in hash.
Always use strict; use warnings;. There are no excuses.
Global variables are declared with our. The vars pragma is a historical artifact. But please don't use global variables, as they are unneccessary here.
Don't call functions like &foo unless you can tell me what exactly this does. Until you have this knowledge: foo().
Use the header method of the CGI object to write headers: $q->header('text/plain').
The \n may not be what you think it is. Do a binmode STDOUT to remove the :crlf PerlIO-layer if it is currently applied. Although equivalent to \r\n, It may be clearer to write \015\012 to demonstrate that you care about the actual bytes.
You can interpolate variables into strings, you know. You can also specify a string that is to be appended after each print by setting $\:
{
local $\ = "\015\012";
print "in{'upfile'}=$in{'upfile'}";
print "in{'desc'}=$in{'desc'}";
print "fname=$fname";
print "fsize=$fsize";
}
Don't use bareword filehandles. Instead of open OUT, "<", $fname you should open my $outfh, "<", $fname.
Why did you put one close in an eval? I don't see how this should die.

How can I translate a shell script to Perl?

I have a shell script, pretty big one. Now my boss says I must rewrite it in Perl.
Is there any way to write a Perl script and use the existing shell code as is in my Perl script. Something similar to Inline::C.
Is there something like Inline::Shell? I had a look at inline module, but it supports only languages.
I'll answer seriously. I do not know of any program to translate a shell script into Perl, and I doubt any interpreter module would provide the performance benefits. So I'll give an outline of how I would go about it.
Now, you want to reuse your code as much as possible. In that case, I suggest selecting pieces of that code, write a Perl version of that, and then call the Perl script from the main script. That will enable you to do the conversion in small steps, assert that the converted part is working, and improve gradually your Perl knowledge.
As you can call outside programs from a Perl script, you can even replace some bigger logic with Perl, and call smaller shell scripts (or other commands) from Perl to do something you don't feel comfortable yet to convert. So you'll have a shell script calling a perl script calling another shell script. And, in fact, I did exactly that with my own very first Perl script.
Of course, it's important to select well what to convert. I'll explain, below, how many patterns common in shell scripts are written in Perl, so that you can identify them inside your script, and create replacements by as much cut&paste as possible.
First, both Perl scripts and Shell scripts are code+functions. Ie, anything which is not a function declaration is executed in the order it is encountered. You don't need to declare functions before use, though. That means the general layout of the script can be preserved, though the ability to keep things in memory (like a whole file, or a processed form of it) makes it possible to simplify tasks.
A Perl script, in Unix, starts with something like this:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
#other libraries
(rest of the code)
The first line, obviously, points to the commands to be used to run the script, just like normal shells do. The following two "use" lines make then language more strict, which should decrease the amount of bugs you encounter because you don't know the language well (or plain did something wrong). The third use line imports the "Dumper" function of the "Data" module. It's useful for debugging purposes. If you want to know the value of an array or hash table, just print Dumper(whatever).
Note also that comments are just like shell's, lines starting with "#".
Now, you call external programs and pipe to or pipe from them. For example:
open THIS, "cat $ARGV[0] |";
That will run cat, passing "$ARGV[0]", which would be $1 on shell -- the first argument passed to it. The result of that will be piped into your Perl script through "THIS", which you can use to read that from it, as I'll show later.
You can use "|" at the beginning or end of line, to indicate the mode "pipe to" or "pipe from", and specify a command to be run, and you can also use ">" or ">>" at the beginning, to open a file for writing with or without truncation, "<" to explicitly indicate opening a file for reading (the default), or "+<" and "+>" for read and write. Notice that the later will truncate the file first.
Another syntax for "open", which will avoid problems with files with such characters in their names, is having the opening mode as a second argument:
open THIS, "-|", "cat $ARGV[0]";
This will do the same thing. The mode "-|" stands for "pipe from" and "|-" stands for "pipe to". The rest of the modes can be used as they were (>, >>, <, +>, +<). While there is more than this to open, it should suffice for most things.
But you should avoid calling external programs as much as possible. You could open the file directly, by doing open THIS, "$ARGV[0]";, for example, and have much better performance.
So, what external programs you could cut out? Well, almost everything. But let's stay with the basics: cat, grep, cut, head, tail, uniq, wc, sort.
CAT
Well, there isn't much to be said about this one. Just remember that, if possible, read the file only once and keep it in memory. If the file is huge you won't do that, of course, but there are almost always ways to avoid reading a file more than once.
Anyway, the basic syntax for cat would be:
my $filename = "whatever";
open FILE, "$filename" or die "Could not open $filename!\n";
while(<FILE>) {
print $_;
}
close FILE;
This opens a file, and prints all it's contents ("while(<FILE>)" will loop until EOF, assigning each line to "$_"), and close it again.
If I wanted to direct the output to another file, I could do this:
my $filename = "whatever";
my $anotherfile = "another";
open (FILE, "$filename") || die "Could not open $filename!\n";
open OUT, ">", "$anotherfile" or die "Could not open $anotherfile for writing!\n";
while(<FILE>) {
print OUT $_;
}
close FILE;
This will print the line to the file indicated by "OUT". You can use STDIN, STDOUT and STDERR in the appropriate places as well, without having to open them first. In fact, "print" defaults to STDOUT, and "die" defaults to "STDERR".
Notice also the "or die ..." and "|| die ...". The operators or and || means it will only execute the following command if the first returns false (which means empty string, null reference, 0, and the like). The die command stops the script with an error message.
The main difference between "or" and "||" is priority. If "or" was replaced by "||" in the examples above, it would not work as expected, because the line would be interpreted as:
open FILE, ("$filename" || die "Could not open $filename!\n");
Which is not at all what is expected. As "or" has a lower priority, it works. In the line where "||" is used, the parameters to open are passed between parenthesis, making it possible to use "||".
Alas, there is something which is pretty much what cat does:
while(<>) {
print $_;
}
That will print all files in the command line, or anything passed through STDIN.
GREP
So, how would our "grep" script work? I'll assume "grep -E", because that's easier in Perl than simple grep. Anyway:
my $pattern = $ARGV[0];
shift #ARGV;
while(<>) {
print $_ if /$pattern/o;
}
The "o" passed to $patttern instructs Perl to compile that pattern only once, thus gaining you speed. Not the style "something if cond". It means it will only execute "something" if the condition is true. Finally, "/$pattern/", alone, is the same as "$_ =~ m/$pattern/", which means compare $_ with the regex pattern indicated. If you want standard grep behavior, ie, just substring matching, you could write:
print $_ if $_ =~ "$pattern";
CUT
Usually, you do better using regex groups to get the exact string than cut. What you would do with "sed", for instance. Anyway, here are two ways of reproducing cut:
while(<>) {
my #array = split ",";
print $array[3], "\n";
}
That will get you the fourth column of every line, using "," as separator. Note #array and $array[3]. The # sigil means "array" should be treated as an, well, array. It will receive an array composed of each column in the currently processed line. Next, the $ sigil means array[3] is a scalar value. It will return the column you are asking for.
This is not a good implementation, though, as "split" will scan the whole string. I once reduced a process from 30 minutes to 2 seconds just by not using split -- the lines where rather large, though. Anyway, the following has a superior performance if the lines are expected to be big, and the columns you want are low:
while(<>) {
my ($column) = /^(?:[^,]*,){3}([^,]*),/;
print $column, "\n";
}
This leverages regular expressions to get the desired information, and only that.
If you want positional columns, you can use:
while(<>) {
print substr($_, 5, 10), "\n";
}
Which will print 10 characters starting from the sixth (again, 0 means the first character).
HEAD
This one is pretty simple:
my $printlines = abs(shift);
my $lines = 0;
my $current;
while(<>) {
if($ARGV ne $current) {
$lines = 0;
$current = $ARGV;
}
print "$_" if $lines < $printlines;
$lines++;
}
Things to note here. I use "ne" to compare strings. Now, $ARGV will always point to the current file, being read, so I keep track of them to restart my counting once I'm reading a new file. Also note the more traditional syntax for "if", right along with the post-fixed one.
I also use a simplified syntax to get the number of lines to be printed. When you use "shift" by itself it will assume "shift #ARGV". Also, note that shift, besides modifying #ARGV, will return the element that was shifted out of it.
As with a shell, there is no distinction between a number and a string -- you just use it. Even things like "2"+"2" will work. In fact, Perl is even more lenient, cheerfully treating anything non-number as a 0, so you might want to be careful there.
This script is very inefficient, though, as it reads ALL file, not only the required lines. Let's improve it, and see a couple of important keywords in the process:
my $printlines = abs(shift);
my #files;
if(scalar(#ARGV) == 0) {
#files = ("-");
} else {
#files = #ARGV;
}
for my $file (#files) {
next unless -f $file && -r $file;
open FILE, "<", $file or next;
my $lines = 0;
while(<FILE>) {
last if $lines == $printlines;
print "$_";
$lines++;
}
close FILE;
}
The keywords "next" and "last" are very useful. First, "next" will tell Perl to go back to the loop condition, getting the next element if applicable. Here we use it to skip a file unless it is truly a file (not a directory) and readable. It will also skip if we couldn't open the file even then.
Then "last" is used to immediately jump out of a loop. We use it to stop reading the file once we have reached the required number of lines. It's true we read one line too many, but having "last" in that position shows clearly that the lines after it won't be executed.
There is also "redo", which will go back to the beginning of the loop, but without reevaluating the condition nor getting the next element.
TAIL
I'll do a little trick here.
my $skiplines = abs(shift);
my #lines;
my $current = "";
while(<>) {
if($ARGV ne $current) {
print #lines;
undef #lines;
$current = $ARGV;
}
push #lines, $_;
shift #lines if $#lines == $skiplines;
}
print #lines;
Ok, I'm combining "push", which appends a value to an array, with "shift", which takes something from the beginning of an array. If you want a stack, you can use push/pop or shift/unshift. Mix them, and you have a queue. I keep my queue with at most 10 elements with $#lines which will give me the index of the last element in the array. You could also get the number of elements in #lines with scalar(#lines).
UNIQ
Now, uniq only eliminates repeated consecutive lines, which should be easy with what you have seen so far. So I'll eliminate all of them:
my $current = "";
my %lines;
while(<>) {
if($ARGV ne $current) {
undef %lines;
$current = $ARGV;
}
print $_ unless defined($lines{$_});
$lines{$_} = "";
}
Now here I'm keeping the whole file in memory, inside %lines. The use of the % sigil indicates this is a hash table. I'm using the lines as keys, and storing nothing as value -- as I have no interest in the values. I check where the key exist with "defined($lines{$_})", which will test if the value associated with that key is defined or not; the keyword "unless" works just like "if", but with the opposite effect, so it only prints a line if the line is NOT defined.
Note, too, the syntax $lines{$_} = "" as a way to store something in a hash table. Note the use of {} for hash table, as opposed to [] for arrays.
WC
This will actually use a lot of stuff we have seen:
my $current;
my %lines;
my %words;
my %chars;
while(<>) {
$lines{"$ARGV"}++;
$chars{"$ARGV"} += length($_);
$words{"$ARGV"} += scalar(grep {$_ ne ""} split /\s/);
}
for my $file (keys %lines) {
print "$lines{$file} $words{$file} $chars{$file} $file\n";
}
Three new things. Two are the "+=" operator, which should be obvious, and the "for" expression. Basically, a "for" will assign each element of the array to the variable indicated. The "my" is there to declare the variable, though it's unneeded if declared previously. I could have an #array variable inside those parenthesis. The "keys %lines" expression will return as an array they keys (the filenames) which exist for the hash table "%lines". The rest should be obvious.
The third thing, which I actually added only revising the answer, is the "grep". The format here is:
grep { code } array
It will run "code" for each element of the array, passing the element as "$_". Then grep will return all elements for which the code evaluates to "true" (not 0, not "", etc). This avoids counting empty strings resulting from consecutive spaces.
Similar to "grep" there is "map", which I won't demonstrate here. Instead of filtering, it will return an array formed by the results of "code" for each element.
SORT
Finally, sort. This one is easy too:
my #lines;
my $current = "";
while(<>) {
if($ARGV ne $current) {
print sort #lines;
undef #lines;
$current = $ARGV;
}
push #lines, $_;
}
print sort #lines;
Here, "sort" will sort the array. Note that sort can receive a function to define the sorting criteria. For instance, if I wanted to sort numbers I could do this:
my #lines;
my $current = "";
while(<>) {
if($ARGV ne $current) {
print sort #lines;
undef #lines;
$current = $ARGV;
}
push #lines, $_;
}
print sort {$a <=> $b} #lines;
Here "$a" and "$b" receive the elements to be compared. "<=>" returns -1, 0 or 1 depending on whether the number is less than, equal to or greater than the other. For strings, "cmp" does the same thing.
HANDLING FILES, DIRECTORIES & OTHER STUFF
As for the rest, basic mathematical expressions should be easy to understand. You can test certain conditions about files this way:
for my $file (#ARGV) {
print "$file is a file\n" if -f "$file";
print "$file is a directory\n" if -d "$file";
print "I can read $file\n" if -r "$file";
print "I can write to $file\n" if -w "$file";
}
I'm not trying to be exaustive here, there are many other such tests. I can also do "glob" patterns, like shell's "*" and "?", like this:
for my $file (glob("*")) {
print $file;
print "*" if -x "$file" && ! -d "$file";
print "/" if -d "$file";
print "\t";
}
If you combined that with "chdir", you can emulate "find" as well:
sub list_dir($$) {
my ($dir, $prefix) = #_;
my $newprefix = $prefix;
if ($prefix eq "") {
$newprefix = $dir;
} else {
$newprefix .= "/$dir";
}
chdir $dir;
for my $file (glob("*")) {
print "$prefix/" if $prefix ne "";
print "$dir/$file\n";
list_dir($file, $newprefix) if -d "$file";
}
chdir "..";
}
list_dir(".", "");
Here we see, finally, a function. A function is declared with the syntax:
sub name (params) { code }
Strictly speakings, "(params)" is optional. The declared parameter I used, "($$)", means I'm receiving two scalar parameters. I could have "#" or "%" in there as well. The array "#_" has all the parameters passed. The line "my ($dir, $prefix) = #_" is just a simple way of assigning the first two elements of that array to the variables $dir and $prefix.
This function does not return anything (it's a procedure, really), but you can have functions which return values just by adding "return something;" to it, and have it return "something".
The rest of it should be pretty obvious.
MIXING EVERYTHING
Now I'll present a more involved example. I'll show some bad code to explain what's wrong with it, and then show better code.
For this first example, I have two files, the names.txt file, which names and phone numbers, the systems.txt, with systems and the name of the responsible for them. Here they are:
names.txt
John Doe, (555) 1234-4321
Jane Doe, (555) 5555-5555
The Boss, (666) 5555-5555
systems.txt
Sales, Jane Doe
Inventory, John Doe
Payment, That Guy
I want, then, to print the first file, with the system appended to the name of the person, if that person is responsible for that system. The first version might look like this:
#!/usr/bin/perl
use strict;
use warnings;
open FILE, "names.txt";
while(<FILE>) {
my ($name) = /^([^,]*),/;
my $system = get_system($name);
print $_ . ", $system\n";
}
close FILE;
sub get_system($) {
my ($name) = #_;
my $system = "";
open FILE, "systems.txt";
while(<FILE>) {
next unless /$name/o;
($system) = /([^,]*)/;
}
close FILE;
return $system;
}
This code won't work, though. Perl will complain that the function was used too early for the prototype to be checked, but that's just a warning. It will give an error on line 8 (the first while loop), complaining about a readline on a closed filehandle. What happened here is that "FILE" is global, so the function get_system is changing it. Let's rewrite it, fixing both things:
#!/usr/bin/perl
use strict;
use warnings;
sub get_system($) {
my ($name) = #_;
my $system = "";
open my $filehandle, "systems.txt";
while(<$filehandle>) {
next unless /$name/o;
($system) = /([^,]*)/;
}
close $filehandle;
return $system;
}
open FILE, "names.txt";
while(<FILE>) {
my ($name) = /^([^,]*),/;
my $system = get_system($name);
print $_ . ", $system\n";
}
close FILE;
This won't give any error or warnings, nor will it work. It returns just the sysems, but not the names and phone numbers! What happened? Well, what happened is that we are making a reference to "$_" after calling get_system, but, by reading the file, get_system is overwriting the value of $_!
To avoid that, we'll make $_ local inside get_system. This will give it a local scope, and the original value will then be restored once returned from get_system:
#!/usr/bin/perl
use strict;
use warnings;
sub get_system($) {
my ($name) = #_;
my $system = "";
local $_;
open my $filehandle, "systems.txt";
while(<$filehandle>) {
next unless /$name/o;
($system) = /([^,]*)/;
}
close $filehandle;
return $system;
}
open FILE, "names.txt";
while(<FILE>) {
my ($name) = /^([^,]*),/;
my $system = get_system($name);
print $_ . ", $system\n";
}
close FILE;
And that still doesn't work! It prints a newline between the name and the system. Well, Perl reads the line including any newline it might have. There is a neat command which will remove newlines from strings, "chomp", which we'll use to fix this problem. And since not every name has a system, we might, as well, avoid printing the comma when that happens:
#!/usr/bin/perl
use strict;
use warnings;
sub get_system($) {
my ($name) = #_;
my $system = "";
local $_;
open my $filehandle, "systems.txt";
while(<$filehandle>) {
next unless /$name/o;
($system) = /([^,]*)/;
}
close $filehandle;
return $system;
}
open FILE, "names.txt";
while(<FILE>) {
my ($name) = /^([^,]*),/;
my $system = get_system($name);
chomp;
print $_;
print ", $system" if $system ne "";
print "\n";
}
close FILE;
That works, but it also happens to be horribly inefficient. We read the whole systems file for every line in the names file. To avoid that, we'll read all data from systems once, and then use that to process names.
Now, sometimes a file is so big you can't read it into memory. When that happens, you should try to read into memory any other file needed to process it, so that you can do everything in a single pass for each file. Anyway, here is the first optimized version of it:
#!/usr/bin/perl
use strict;
use warnings;
our %systems;
open SYSTEMS, "systems.txt";
while(<SYSTEMS>) {
my ($system, $name) = /([^,]*),(.*)/;
$systems{$name} = $system;
}
close SYSTEMS;
open NAMES, "names.txt";
while(<NAMES>) {
my ($name) = /^([^,]*),/;
chomp;
print $_;
print ", $systems{$name}" if defined $systems{$name};
print "\n";
}
close NAMES;
Unfortunately, it doesn't work. No system ever appears! What has happened? Well, let's look into what "%systems" contains, by using Data::Dumper:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
our %systems;
open SYSTEMS, "systems.txt";
while(<SYSTEMS>) {
my ($system, $name) = /([^,]*),(.*)/;
$systems{$name} = $system;
}
close SYSTEMS;
print Dumper(%systems);
open NAMES, "names.txt";
while(<NAMES>) {
my ($name) = /^([^,]*),/;
chomp;
print $_;
print ", $systems{$name}" if defined $systems{$name};
print "\n";
}
close NAMES;
The output will be something like this:
$VAR1 = ' Jane Doe';
$VAR2 = 'Sales';
$VAR3 = ' That Guy';
$VAR4 = 'Payment';
$VAR5 = ' John Doe';
$VAR6 = 'Inventory';
John Doe, (555) 1234-4321
Jane Doe, (555) 5555-5555
The Boss, (666) 5555-5555
Those $VAR1/$VAR2/etc is how Dumper displays a hash table. The odd numbers are the keys, and the succeeding even numbers are the values. Now we can see that each name in %systems has a preceeding space! Silly regex mistake, let's fix it:
#!/usr/bin/perl
use strict;
use warnings;
our %systems;
open SYSTEMS, "systems.txt";
while(<SYSTEMS>) {
my ($system, $name) = /^\s*([^,]*?)\s*,\s*(.*?)\s*$/;
$systems{$name} = $system;
}
close SYSTEMS;
open NAMES, "names.txt";
while(<NAMES>) {
my ($name) = /^\s*([^,]*?)\s*,/;
chomp;
print $_;
print ", $systems{$name}" if defined $systems{$name};
print "\n";
}
close NAMES;
So, here, we are aggressively removing any spaces from the beginning or end of name and system. There are other ways to form that regex, but that's beside the point. There is still one problem with this script, which you'll have seen if your "names.txt" and/or "systems.txt" files have an empty line at the end. The warnings look like this:
Use of uninitialized value in hash element at ./exemplo3e.pl line 10, <SYSTEMS> line 4.
Use of uninitialized value in hash element at ./exemplo3e.pl line 10, <SYSTEMS> line 4.
John Doe, (555) 1234-4321, Inventory
Jane Doe, (555) 5555-5555, Sales
The Boss, (666) 5555-5555
Use of uninitialized value in hash element at ./exemplo3e.pl line 19, <NAMES> line 4.
What happened here is that nothing went into the "$name" variable when the empty line was processed. There are many ways around that, but I choose the following:
#!/usr/bin/perl
use strict;
use warnings;
our %systems;
open SYSTEMS, "systems.txt" or die "Could not open systems.txt!";
while(<SYSTEMS>) {
my ($system, $name) = /^\s*([^,]+?)\s*,\s*(.+?)\s*$/;
$systems{$name} = $system if defined $name;
}
close SYSTEMS;
open NAMES, "names.txt" or die "Could not open names.txt!";
while(<NAMES>) {
my ($name) = /^\s*([^,]+?)\s*,/;
chomp;
print $_;
print ", $systems{$name}" if defined($name) && defined($systems{$name});
print "\n";
}
close NAMES;
The regular expressions now require at least one character for name and system, and we test to see if "$name" is defined before we use it.
CONCLUSION
Well, then, these are the basic tools to translate a shell script. You can do MUCH more with Perl, but that was not your question, and it wouldn't fit here anyway.
Just as a basic overview of some important topics,
A Perl script that might be attacked by hackers need to be run with the -T option, so that Perl will complain about any vulnerable input which has not been properly handled.
There are libraries, called modules, for database accesses, XML&cia handling, Telnet, HTTP & other protocols. In fact, there are miriads of modules which can be found at CPAN.
As mentioned by someone else, if you make use of AWK or SED, you can translate those into Perl with A2P and S2P.
Perl can be written in an Object Oriented way.
There are multiple versions of Perl. As of this writing, the stable one is 5.8.8 and there is a 5.10.0 available. There is also a Perl 6 in development, but experience has taught everyone not to wait too eagerly for it.
There is a free, good, hands-on, hard & fast book about Perl called Learning Perl The Hard Way. It's style is similar to this very answer. It might be a good place to go from here.
I hope this helped.
DISCLAIMER
I'm NOT trying to teach Perl, and you will need to have at least some reference material. There are guidelines to good Perl habits, such as using "use strict;" and "use warnings;" at the beginning of the script, to make it less lenient of badly written code, or using STDOUT and STDERR on the print lines, to indicate the correct output pipe.
This is stuff I agree with, but I decided it would detract from the basic goal of showing patterns for common shell script utilities.
I don't know what's in your shell script, but don't forget there are tools like
a2p - awk-to-perl
s2p - sed-to-perl
and perhaps more. Worth taking a look around.
You may find that due to Perl's power/features, it's not such a big job, in that you may have been jumping through hoops with various bash features and utility programs to do something that comes out of Perl natively.
Like any migration project, it's useful to have some canned regression tests to run with both solutions, so if you don't have those, I'd generate those first.
I'm surprised no-one has yet mentioned the Shell module that is included with core Perl, which lets you execute external commands using function-call syntax. For example (adapted from the synopsis):
use Shell qw(cat ps cp);
$passwd = cat '</etc/passwd';
#pslines = ps '-ww';
cp "/etc/passwd", "/tmp/passwd";
Provided you use parens, you can even call other programs in the $PATH that you didn't mention on the use line, e.g.:
gcc('-o', 'foo', 'foo.c');
Note that Shell gathers up the subprocess's STDOUT and returns it as a string or array. This simplifies scripting, but it is not the most efficient way to go and may cause trouble if you rely on a command's output being unbuffered.
The module docs mention some shortcomings, such as that shell internal commands (e.g. cd) cannot be called using the same syntax. In fact they recommend that the module not be used for production systems! But it could certainly be a helpful crutch to lean on until you get your code ported across to "proper" Perl.
The inline shell thingy is called system. If you have user-defined functions you're trying to expose to Perl, you're out of luck. However, you can run short bits of shell using the same environment as your running Perl program. You can also gradually replace parts of the shell script with Perl. Start writing a module that replicates the shell script functionality and insert Perly bits into the shell script until you eventually have mostly Perl.
There's no shell-to-Perl translator. There was a long running joke about a csh-to-Perl translator that you could email your script to, but that was really just Tom Christainsen translating it for you to show you how cool Perl was back in the early 90s. Randal Schwartz uploaded a sh-to-Perl translator, but you have to check the upload date: it was April Fool's day. His script merely wrapped everything in system.
Whatever you do, don't lose the original shell script. :)
I agree that learning Perl and trying to write Perl instead of shell is for the greater good. I did the transfer once with the help of the "Replace" function of Notepad++.
However, I had a similar problem to the one initially asked while I was trying to create a Perl wrapper around a shell script (that could execute it).
I came with the following code that works in my case.
It might help.
#!perl
use strict;
use Data::Dumper;
use Cwd;
#Variables read from shell
our %VAR;
open SH, "<$ARGV[0]" or die "Error while trying to read $ARGV[0] ($!)\n";
my #SH=<SH>;
close SH;
sh2perl(#SH);
#Subroutine to execute shell from Perl (read from array)
sub sh2perl {
#Variables
my %case; #To store data from conditional block of "case"
my %if; #To store data from conditional block of "if"
foreach my $line (#_) {
#Remove blanks at the beginning and EOL character
$line=~s/^\s*//;
chomp $line;
#Comments and blank lines
if ($line=~/^(#.*|\s*)$/) {
#Do nothing
}
#Conditional block - Case
elsif ($line=~/case.*in/..$line=~/esac/) {
if ($line=~/case\s*(.*?)\s*\in/) {
$case{'var'}=transform($1);
} elsif ($line=~/esac/) {
delete $case{'curr_pattern'};
#Run conditional block
my $case;
map { $case=$_ if $case{'var'}=~/$_/ } #{$case{'list_patterns'}};
$case ? sh2perl(#{$case{'patterns'}->{$case}}) : sh2perl(#{$case{'patterns'}->{"*"}});
} elsif ($line=~/^\s*(.*?)\s*\)/) {
$case{'curr_pattern'}=$1;
push(#{$case{'list_patterns'}}, $case{'curr_pattern'}) unless ($line=~m%\*\)%)
} else {
push(#{$case{'patterns'}->{ $case{'curr_pattern'} }}, $line);
}
}
#Conditional block - if
elsif ($line=~/^if/..$line=~/^fi/) {
if ($line=~/if\s*\[\s*(.*\S)\s*\];/) {
$if{'condition'}=transform($1);
$if{'curr_cond'}="TRUE";
} elsif ($line=~/fi/) {
delete $if{'curr_cond'};
#Run conditional block
$if{'condition'} ? sh2perl(#{$if{'TRUE'}}) : sh2perl(#{$if{'FALSE'}});
} elsif ($line=~/^else/) {
$if{'curr_cond'}="FALSE";
} else {
push(#{$if{ $if{'curr_cond'} }}, $line);
}
}
#echo
elsif($line=~/^echo\s+"?(.*?[^"])"?\s*$/) {
my $str=$1;
#echo with redirection
if ($str=~m%[>\|]%) {
eval { system(transform($line)) };
if ($#) { warn "Error while evaluating $line: $#\n"; }
#print new line
} elsif ($line=~/^echo ""$/) {
print "\n";
#default
} else {
print transform($str),"\n";
}
}
#cd
elsif($line=~/^\s*cd\s+(.*)/) {
chdir $1;
}
#export
elsif($line=~/^export\s+((\w+).*)/) {
my ($var,$exported)=($2,$1);
if ($exported=~/^(\w+)\s*=\s*(.*)/) {
while($exported=~/(\w+)\s*=\s*"?(.*?\S)"?\s*(;(?:\s*export\s+)?|$)/g) { $VAR{$1}=transform($2); }
}
# export($var,$VAR{$var});
$ENV{$var}=$VAR{$var};
print "Exported variable $var = $VAR{$var}\n";
}
#Variable assignment
elsif ($line=~/^(\w+)\s*=\s*(.*)$/) {
$1 eq "" or $VAR{$1}=""; #Empty variable
while($line=~/(\w+)\s*=\s*"?(.*?\S)"?\s*(;|$)/g) {
$VAR{$1}=transform($2);
}
}
#Source
elsif ($line=~/^source\s*(.*\.sh)/) {
open SOURCE, "<$1" or die "Error while trying to open $1 ($!)\n";
my #SOURCE=<SOURCE>;
close SOURCE;
sh2perl(#SOURCE);
}
#Default (assuming running command)
else {
eval { map { system(transform($_)) } split(";",$line); };
if ($#) { warn "Error while doing system on \"$line\": $#\n"; }
}
}
}
sub transform {
my $src=$_[0];
#Variables $1 and similar
$src=~s/\$(\d+)/$ARGV[$1-1]/ge;
#Commands stored in variables "$(<cmd>)"
eval {
while ($src=~m%\$\((.*)\)%g) {
my ($cmd,$new_cmd)=($1,$1);
my $curr_dir=getcwd;
$new_cmd=~s/pwd/echo $curr_dir/g;
$src=~s%\$\($cmd\)%`$new_cmd`%e;
chomp $src;
}
};
if ($#) { warn "Wrong assessment for variable $_[0]:\n=> $#\n"; return "ERROR"; }
#Other variables
$src=~s/\$(\w+)/$VAR{$1}/g;
#Backsticks
$src=~s/`(.*)`/`$1`/e;
#Conditions
$src=~s/"(.*?)"\s*==\s*"(.*?)"/"$1" eq "$2" ? 1 : 0/e;
$src=~s/"(.*?)"\s*!=\s*"(.*?)"/"$1" ne "$2" ? 1 : 0/e;
$src=~s/(\S+)\s*==\s*(\S+)/$1 == $2 ? 1 : 0/e;
$src=~s/(\S+)\s*!=\s*(\S+)/$1 != $2 ? 1 : 0/e;
#Return Result
return $src;
}
You could start your "Perl" script with:
#!/bin/bash
Then, assuming bash was installed at that location, perl would automatically invoke the bash interpretor to run it.
Edit: Or maybe the OS would intercept the call and stop it getting to Perl. I'm finding it hard to track down the documentation on how this actually works. Comments to documentation would be welcomed.