perl : making a script as efficient as a perl one-liner - perl

I'm able to do this on the command line and it works :
~/Tools/perl/edif_extr_cell.pl design.edif nmos1p8v | perl -p -e 's/^/\n/ if /portImplementation|figure\s+device/;' | perl -n -000 -e 'print if /portImplementation/;'
(basically, extracting a section of the EDIF file).
Now, I want to make a utility of this. And my script is below. Question : can this code be more efficient? If feel like it's very inelegant. I could pipe streams easily on the command line but, in a script, I feel lost.
#!/usr/bin/perl -w -p
BEGIN{ $file = '';}
s/^/\n/ if /portImplementation|figure\s+device/;
$file .= $_;
END{
$cmd = q{\rm -f /tmp/dump}.$$.'.txt';
system( $cmd );
open( OUT, ">/tmp/dump$$.txt");
print OUT $file;
close OUT;
$out = `perl -n -000 -e 'print if /portImplementation/;' /tmp/dump$$.txt`;
system( $cmd );
print $out;
}

If I understand correct, you want to be able to do
~/Tools/perl/edif_extr_cell.pl design.edif nmos1p8v | myfilter
Ideally, you'd merge the two Perl scripts into one rather than having one script launch two instances of Perl, but this turns out to be rather hard because of the change to $/ (via -00) and because you insert newlines in the first filter.
The simplest answer:
#!/bin/sh
perl -pe's/^/\n/ if /portImplementation|figure\s+device/' |
perl -00ne'print if /portImplementation/'
It appears that you were trying to write the equivalent of that sh script in Perl. It would look like the following:
#!/usr/bin/perl
use strict;
use warnings;
use IPC::Open qw( open3 );
# open3 has issues with lexical file handles.
pipe(local *PIPE_READER, local *PIPE_WRITER)
or die($!);
my $pid1 = open3('<&STDIN', '>&PIPE_WRITER', '>&STDERR',
'perl', '-pes/^/\n/ if /portImplementation|figure\s+device/');
my $pid2 = open3('<&PIPE_READER', '>&STDOUT', '>&STDERR',
'perl', '-00neprint if /portImplementation/');
waitpid($pid1);
waitpid($pid2);
I'd normally recommend IPC::Run3 or IPC::Run for launching and interfacing with child processes, but low-level open3 does the trick nicely in this particular situation.

I downloaded a random EDIF file from GitHub, running the following script on it gives the same output as your code:
#! /usr/bin/perl
use warnings;
use strict;
my #buffer;
my $found;
my $prepend = q();
while (<>) {
if (/portImplementation|figure\s+device/) {
if ($found && #buffer) {
print $prepend, #buffer;
$prepend = "\n";
}
undef $found;
#buffer = ();
}
$found ||= /portImplementation/;
push #buffer, $_;
}
# Don't forget to output the last paragraph!
print $prepend, #buffer if $found && #buffer;

Related

Getting error while replacing word using perl

I am writing a script for replacing 2 words from a text file. The script is
count=1
for f in *.pdf
do
filename="$(basename $f)"
filename="${filename%.*}"
filename="${filename//_/ }"
echo $filename
echo $f
perl -pe 's/intime_mean_pu.pdf/'$f'/' fig.tex > fig_$count.tex
perl -pi 's/TitleFrame/'$filename'/' fig_$count.tex
sed -i '/Pointer-rk/r fig_'$count'.tex' $1.tex
count=$((count+1))
done
But the replacing of words using the second perl command is giving error:
Can't open perl script "s/TitleFrame/Masses1/": No such file or directory
Please suggest what I am doing wrong.
You could change your script to something like this:
#!/bin/bash
for f in *.pdf; do
filename=$(basename "$f" .pdf)
filename=${filename//_/}
perl -spe 's/intime_mean_pu.pdf/$a/;
s/TitleFrame/$b/' < fig.tex -- -a="$f" -b="$filename" > "fig_$count.tex"
sed -i "/Pointer-rk/r fig_$count.tex" "$1.tex"
((++count))
done
As well as some other minor changes to your script, I have made use of the -s switch to Perl, which means that you can pass arguments to the one-liner. The bash variables have been double quoted to avoid problems with spaces in filenames, etc.
Alternatively, you could do the whole thing in Perl:
#!/usr/bin/env perl
use strict;
use warnings;
use autodie;
use File::Basename;
my $file_arg = shift;
my $count = 1;
for my $f (glob "*.pdf") {
my $name = fileparse($f, qq(.pdf));
open my $in, "<", $file_arg;
open my $out, ">", 'tmp';
open my $fig, "<", 'fig.tex';
# copy up to match
while (<$in>) {
print $out $_;
last if /Pointer-rk/;
}
# insert contents of figure (with substitutions)
while (<$fig>) {
s/intime_mean_pu.pdf/$f/;
s/TitleFrame/$name/;
print $out $_;
}
# copy rest of file
print $out $_ while <$in>;
rename 'tmp', $file_arg;
++$count;
}
Use the script like perl script.pl "$1.tex".
You're missing the -e in the second perl call

How to mimic -l inside script

Is there a simple way to mimic the effect of the -l command-line switch within perl scripts? (Of course, I can always chomp each line and then append "\n" to each line I print, but the point is to avoid having to do this.)
No. You can get the automatic appending of "\n" by using $\, but you have to add the chomp yourself.
Here's how -l works.
$ perl -MO=Deparse -ne 'print $_'
LINE: while (defined($_ = <ARGV>)) {
print $_;
}
$ perl -MO=Deparse -lne 'print $_'
BEGIN { $/ = "\n"; $\ = "\n"; } # -l added this line
LINE: while (defined($_ = <ARGV>)) {
chomp $_; # -l added this line
print $_;
}
(The comments are mine.) Notice that -l added a literal chomp $_ at the beginning of the loop generated by -n (and it only does that if you use -n or -p). There's no variable you can set to mimic that behaviour.
It's a little-known fact that -l, -n, and -p work by wrapping boilerplate text around the code you supply before it's compiled.
Yes, try using this at the beginning of your script after the shebang and strictures:
$/ = $\ = "\n"; # setting the output/input record separator like OFS in awk
and use in the loop :
chomp;
print;
Or like this :
use strict; use warnings;
use English qw/-no_match_vars/;
$OUTPUT_RECORD_SEPARATOR = "\n";
while (<>) {
chomp;
print;
}
I do not recommend to use
#!/usr/bin/perl -l
for a better clarity =)
See perldoc perlvar
You can add it to your shebang line:
#!/usr/bin/perl -l

using perl script to invoke cleartool commands using fmt

I use Perl scripts to run commands for several users in several VOBs on ClearCase. I have a list of the VOBs which I read in from a text file. I then loop on that list and do whatever ClearCase command I am trying to do. However, this time the script does not seem to work. If I print out the command to the screen then go and copy and paste it at the prompt it works fine. It just will not executed from the Perl script. The only difference I saw was the fmt characters but even when I remove that it does not execute. I tried first putting the fmt on the line directly then tried setting them to variables. You will see the first comment line is the one that failed but I left it there as an example of what I tried. The last two comments are from another script that I run like this that does work.
Code:
#! /usr/local/bin/perl -w
use strict;
open(VOBS,"vobs.txt") || die "Can't open: !$\n";
my $u = '%u';
my $a ='%Ad';
my $n ='%N/n';
my $user='john';
my $ct = '/usr/atria/bin/cleartool';
while(my $newvobs=<VOBS>){
chomp($newvobs);
my $tag = $newvobs;
print "\n $tag \n";
print " $ct lstype -kind brtype -invob $tag | grep $user ";
`$ct lstype -kind brtype -invob $tag | grep $user`;
# `/usr/atria/bin/cleartool lstype -kind brtype -invob $tag -fmt '%u %Ad %N/\n' `;
# print "\n cleartool rmtag -view $tag \n";
#`/usr/atria/bin/cleartool rmtag -view $tag `;
}
close(VOBS);
Actually Your program runs, but is does not print anything.
Example:
#!/usr/bin/perl
use strict;
use warnings;
my $cmd = "cat";
`$cmd $0 | grep warning`;
Output: (nothing)
Easiest to fix. Last line
print `$cmd $0 | grep warning`
Output:
use warnings;
print `$cmd $0 | grep warning`;
If You need the exit code, replace last line with
my $exit = system("$cmd $0 | grep warning");
print $exit;
Output:
use warnings;
my $exit = system("$cmd $0 | grep warning");
0
Or use open to process output:
open my $fh, "$cmd $0 | grep warning|" or die;
while (<$fh>) { print $_; }
close $fh;
Output:
use warnings;
open my $fh, "$cmd $0 | grep warning|" or die;
But I could suggest something like bellow. Using AUTOLOAD the clearcase commands can be used as internal perl commands.
#!/usr/bin/perl
use strict;
use warnings;
sub AUTOLOAD {
(my $sub = $::AUTOLOAD) =~ s/.*:://;
print "---\n";
system("time $sub #_");
print "---\n";
}
my $cmd = "cat";
eval "$cmd($0)";
Output:
---
#!/usr/bin/perl
use strict;
use warnings;
sub AUTOLOAD {
(my $sub = $::AUTOLOAD) =~ s/.*:://;
print "---\n";
system("time $sub #_");
print "---\n";
}
cat($0);
0.00user 0.00system 0:00.00elapsed 400%CPU (0avgtext+0avgdata 2112maxresident)k
0inputs+0outputs (0major+174minor)pagefaults 0swaps
---
For reference, here is a perl script which uses -fmt, "Finding the latest baseline for a component":
Example:
ccperl StreamComp.pl mystream#\pvobtag | findstr {component}
Script "streamcomp.pl":
#!/usr/bin/perl -w
my $cmdout = `cleartool desc -fmt '%[latest_bls]CXp' stream:$ARGV[0]`;
my #baselines = split(/,/,$cmdout);
foreach $baseline (#baselines)
{
$compname=`cleartool desc -fmt '%[component]p' $baseline`;
printf("%-30s \t %s\n", $compname, $baseline);
}
It is a program working for a ClearCase UCM environment, but it could give you an idea of the kind of working statements (try without grep first) you could try to reproduce in your own base ClearCase program.

One-liner Perl command to rename files

So far this one-liner is stripping off one line and renaming the file, but I need help to alter it so that it strips that line I am looking for Data for and remove the old file extension .csv instead of adding to it. (.csv.out). I am not sure if this can be done with one-liner.
Instead it's adding on the the extension filename.csv.out
Example
test_20110824.csv.out
One-liner:
find -type f -name '*.csv' -exec perl -i.out -wlne '/^Data for/ or print' {} \;
I want to replace the extension:
test_20110824.out
perl -MFile::Copy -we 'for (glob "*.csv") { my ($name) = /^(.+).csv/i; move($_, $name . ".out"); }'
To remove the header matching Data for:
perl -MFile::Copy -MTie::File -wE 'for (glob '*x.csv') { tie my #file,
"Tie::File", $_ or die $!; shift #file if $file[0] =~ /^Data for/;
untie #file; my ($name) = /^(.*).csv/i; move($_, $name . ".out"); }'
But then it's really not a one-liner anymore...
use strict;
use warnings;
use Tie::File;
use File::Copy;
use autodie;
for (#ARGV) {
tie my #file, "Tie::File", $_;
shift #file if $file[0] =~ /^Data for/;
untie #file;
my ($name) = /^(.*).csv/i;
move($_, $name . ".out");
}
And use with:
$ script.pl *.csv
A simple Bash shell script will suffice
(shopt -s failglob; for i in *.csv.out; do echo mv $i ${i%csv.out}out; done)
The shopt -s failglob is needed to ensure that if there are no matches the command will fail instead of trying to rename *.csv.out to *.out. The construct ${i%csv.out}out removes a trailing csv.out and replaces it with just out.
As I have coded it here, this will just echo the commands it would execute. When you're satisfied it does what you want, remove the word echo.

Do we have an autochomp in Perl?

This is what my Perl code looks like for monitoring a Unix folder :
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions;
my $date = `date`; chomp $date;
my $datef = `date +%Y%m%d%H%M.%S`; chomp $datef;
my $pwd = `pwd`; chomp $pwd;
my $cache = catfile($pwd, "cache");
my $monitor = catfile($pwd, "monme");
my $subject = '...';
my $msg = "...";
my $sendto = '...';
my $owner = '...';
sub touchandmail {
`touch $cache -t "$datef"`;
`echo "$msg" | mail -s "$subject" $owner -c $sendto`;
}
while(1) {
$date = `date`; chomp $date;
$datef = `date +%Y%m%d%H%M.%S`; chomp $datef;
if (! -e "$cache") {
touchandmail();
} elsif ("`find $monitor -newer $cache`" ne "") {
touchandmail();
}
sleep 300;
}
To do a chomp after every assignment does not look good. Is there some way to do an "autochomp"?
I am new to Perl and might not have written this code in the best way. Any suggestions for improving the code are welcome.
Don't use the shell, then.
#! /usr/bin/perl
use warnings;
use strict;
use Cwd;
use POSIX qw/ strftime /;
my $date = localtime;
my $datef = strftime "%Y%m%d%H%M.%S", localtime;
my $pwd = getcwd;
The result is slightly different: the output of the date command contains a timezone, but the value of $date above will not. If this is a problem, follow the excellent suggestion by Chas. Owens below and use strftime to get the format you want.
Your sub
sub touchandmail {
`touch $cache -t "$datef"`;
`echo "$msg" | mail -s "$subject" $owner -c $sendto`;
}
will fail silently if something goes wrong. Silent failures are nasty. Better would be code along the lines of
sub touchandmail {
system("touch", "-t", $datef, $cache) == 0
or die "$0: touch exited " . ($? >> 8);
open my $fh, "|-", "mail", "-s", $subject, $owner, "-c", $sendto
or die "$0: could not start mail: $!";
print $fh $msg
or warn "$0: print: $!";
unless (close $fh) {
if ($! == 0) {
die "$0: mail exited " . ($? >> 8);
}
else {
die "$0: close: $!";
}
}
}
Using system rather than backticks is more expressive of your intent because backticks are for capturing output. The system(LIST) form bypasses the shell and having to worry about quoting arguments.
Getting the effect of the shell pipeline echo ... | mail ... without the shell means we have to do a bit of the plumbing work ourselves, but the benefit—as with system(LIST)—is not having to worry about shell quoting. The code above uses many-argument open:
For three or more arguments if MODE is '|-', the filename is interpreted as a command to which output is to be piped, and if MODE is '-|', the filename is interpreted as a command that pipes output to us. In the two-argument (and one-argument) form, one should replace dash ('-') with the command. See Using open for IPC in perlipc for more examples of this.
The open above forks a mail process, and $fh is connected to its standard input. The parent process (the code still running touchandmail) performs the role of echo with print $fh $msg. Calling close flushes the handle's I/O buffers plus a little extra because of how we opened it:
If the filehandle came from a piped open, close returns false if one of the other syscalls involved fails or if its program exits with non-zero status. If the only problem was that the program exited non-zero, $! will be set to 0. Closing a pipe also waits for the process executing on the pipe to exit—in case you wish to look at the output of the pipe afterwards—and implicitly puts the exit status value of that command into $? and ${^CHILD_ERROR_NATIVE}.
More generally, the IO::All module does indeed provide the equivalent of an autochomp:
use IO::All;
# for getting command output:
my #date = io("date|")->chomp->slurp;
#$date[0] contains the chomped first line of the output
or more generally:
my $fh = io("file")->chomp->tie;
while (<$fh>) {
# no need to chomp here ! $_ is pre-chomped
}
Granted, for this particular case of date I would agree with the other answerers that you are probably better off using one of the DateTime modules, but if you are simply reading in a file and want all your lines to be chomped, then IO::All with the chomp and tie options applied is very convenient.
Note also that the chomp trick doesn't work when slurping the entire contents of the handle into a scalar directly (that's just the way it is implemented).
Try putting it into a function:
sub autochomp {
my $command = shift;
my $retval = `$command`;
chomp $retval;
return $retval;
}
And then call that for each command you want to execute and then chomp.
Use DateTime or other of the date modules on CPAN instead of the date utility.
For example:
use DateTime;
my $dt = DateTime->now;
print $dt->strftime('%Y%m%d%H%M.%S');
It is possible to assign and chomp in a single line using the following syntax:
chomp ( my $date = `date` );
As for speaking more Perlishly, if you find yourself repeating the same thing over and over again, roll it into a sub:
sub assign_and_chomp {
my #result;
foreach my $cmd (#_) {
chomp ( my $chomped = $cmd );
push #result, $chomped;
}
return #result;
}
my ( $date , $datef , $pwd )
= assign_and_chomp ( `date` , `date +%Y%m%d%H%M.%S` , `pwd` );