Arguments with quotations(" ") to be not escaped - perl

I am writing a Perl script which enables the addition and modification of parameters maintained in a particular file.
The script takes the following arguments; Parameter name($paraName), Parameter value($paraVal) and the file ($profile).
The script checks if the parameter($paraName) exists already. if it does, it just changes the value($paraVal) else adds both the parameter($paraName) and the value($paraVal) to the file($profile).
Following is the block of code for the same:
print " checking if parameter is already avaialable";
my $response = system("egrep -qs \"$paraName =\" $profile");
$rc = 1;
if ($response == 0) {
print " Parameter is already available, changing the value now! ";
$rc = system("sed -i 's:.*$paraName.*:$paraName = $paraVal \# Parameter changed by $script:' $profile");
print " Parameter $paraName has been updated with the value $paraVal in the Profile successfully \n\n";
}
else{
print " Parameter is not available, Adding the Paremeter now! ";
$rc = system("echo \"$paraName = $paraVal \# Parameter added by $script\" >> $profile");
print " Parameter $paraName has been added with the value $paraVal in the Profile successfully \n\n";
}
The script works fine for most cases, except when I have arguments with double quotes to be added as a new parameter. It works file for hash(#), slashes (), etc, when passes within a single quote(' ').
This is working in case of changing the value($paraVal) when the parameter($paraName) already exists. But while a new parameter has to be added, this fails to add double quotes in the parameter name.
Would appreciate some help here.

Here is an example of how you could write it as pure Perl:
use feature qw(say);
use strict;
use warnings;
my ( $paraName, $paraVal, $profile ) = #ARGV;
my $script = $0;
open ( my $fh, '<', $profile ) or die "Could not open file '$profile': $!";
my $found = 0;
while( my $line = <$fh> ) {
chomp $line;
if ( my ($key) = $line =~ /^(\Q$paraName\E)\s*=\s*/) {
say "$key = $paraVal \# Parameter changed by $script";
$found = 1;
}
else {
say $line;
}
}
close $fh;
if ( !$found ) {
say "$paraName = $paraVal \# Parameter added by $script";
}
Edit:
The above script does not modify the profile file, but instead writes the modified file to standard output. So it was meant to be used together with Shell redirection to save the output to a new file. To modify the profile file directly, you could use:
use feature qw(say);
use strict;
use warnings;
die "Bad arguments!" if #ARGV != 3;
my ( $paraName, $paraVal, $profile ) = #ARGV;
my $script = $0;
#ARGV = ( $profile );
$^I = '.bak';
my $found = 0;
while (my $line = <<>>) {
chomp $line;
if ( my ($key) = $line =~ /^(\Q$paraName\E)\s*=\s*/) {
say "$key = $paraVal \# Parameter changed by $script";
$found = 1;
}
else {
say $line;
}
} continue {
say "$paraName = $paraVal \# Parameter added by $script" if eof && !$found;
}
This will first save the original profile file to a backup file with .bak extension, and then overwrite the profile file with the modified content.

Try following code as alternative
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
my %opt; # program options
my %param; # parameters storage
my $fh; # file handle
GetOptions (
'file|f=s' => \$opt{file},
'name|n=s' => \$opt{name},
'value|v=s' => \$opt{value},
'operation|o=s' => \$opt{op},
'help|h' => \$opt{help},
'man|m' => \$opt{man},
'debug|d' => \$opt{debug}
) or pod2usage(1);
pod2usage(1) if $opt{help};
pod2usage(-exitval => 0, -versose => 2) if $opt{man};
pod2usage(1) unless $opt{file};
open $fh, "< $opt{file}"
or die "Couldn't open $opt{file}";
my #lines = <$fh>;
close $fh;
chomp #lines;
print Dumper(\#lines) if $opt{debug};
push #lines, "$opt{name} = $opt{value}"
if $opt{op} eq 'add';
#lines = map { /$opt{name}\s*=/ ? '' : $_ } #lines
if $opt{op} eq 'del';
#lines = map {
s/($opt{name})\s*=\s*(.*)/$1 = $opt{value}/; $_
} #lines if $opt{op} eq 'mod';
map{ say } #lines
if $opt{op} eq 'view';
map {
/$opt{name}\s*=\s*(.*)/ and say 'Verify: '
. ($1 eq $opt{value} ? 'ok' : 'no')
} #lines if $opt{op} eq 'check';
my %save = map { $_ => 1 } qw/add del mod/;
print Dumper(\#lines) if $opt{debug};
if( $save{ $opt{op} } ) {
open $fh, "> $opt{file}"
or die "Couldn't open $opt{file}";
map { say $fh $_ } #lines;
close $fh;
}
__END__
=head1 NAME
program - modify configuration file
=head1 SYNOPSIS
program [options] [file ...]
Usage:
program -op [add|del|mod|view|check] -n param -v value -f file
Options:
--file,-f configuration filename
--name,-n parameter name
--value,-v parameter value
--operation,-o operation to perform
--help,-h brief help message
--man,-m full documentation
--debug,-d debug mode
=head1 OPTIONS
=over 8
=item B<--file,-f>
Configuration file to edit
=item B<--name,-n>
Configuration parameter name to operate on
=item B<--value,-v>
Configuration parameter value to operate on
=item B<--operation,-o>
Operation to perform on parameter: add, del, mod, view, check
=item B<--debug,-d>
Debug flag to print debug messages.
=item B<--help,-h>
Print a brief help message and exits.
=item B<--man,-m>
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B<This program> allows to operate on configuation files variables.
=head1 AUTHOR
B<Polar Bear> L<https://stackoverflow.com/users/12313309/polar-bear>
=cut

Related

How to pass Arguments when call require_ok '*.pl' to test by Test::More

I'm wondering the way to test each Subroutings in *.pl files individually.
But Can't use 'require' clause because some *.pl requires Arguments.
for example
use Test::More;
require "some.pl"
will always fail Test at 'require'.
because "some.pl " required a argument and end with
exit(0);
of the file.
I just want to test "Func1,usage,...whatever," every subroutings in '*.pl' individually.
some.pl is like that
my ( $cmd) = #ARGV;
if (!defined $cmd ) {
usage();
} else {
&Func1;
}
exit(0);
sub Func1 {
print "hello";
}
sub usage {
print "Usage:\n",
}
How can I write a test code for "sub Func1" by "Test::More"?
Any suggestions appreciate.
To exercise a standalone script that you expect to exit, run it with system. Capture the output and inspect it at the end of the system call.
use Test::More;
my $c = system("$^X some.pl arg1 arg2 > file1 2> file2");
ok($c == 0, 'program exited with successful exit code');
open my $fh, "<", "file1";
my $data1 = do { local $/; <$fh> };
close $fh;
open $fh, "<", "file2";
my $data2 = do { local $/; <$fh> };
close $fh;
ok( $data1 =~ /Funct1 output/, "program called Funct1");
ok( $data2 !~ /This is how you use the program, you moron/,
"usage message not printed to STDERR" );
unlink("file1","file2");

perl: How to make 'warn' think we read from a file?

I have a function (a variation of string++):
sub inc
{
$_[0] =~ /^(.*?)([0-9]+)$/;
my ($a,$b)=($1,$2);
die "cannot increment [$_[0]]" unless defined $b;
warn "increment overflow [$_[0]]" if length(++$b) != length($2);
$a.$b;
}
It is invoked in many places of a script, on different data (sometimes from a file, sometimes from a database).
When I read from a filehandle, die and warn print a message like this:
cannot increment [abc] at script line 5, <filehandle> line 123.
otherwise a shorter message is printed:
cannot increment [abc] at script line 5.
When I read from database I would like to have a message like this:
cannot increment [abc] at script line 5, <SELECT...> line 123.
Is it possible?
Setting the line number is quite simple: an assignment to $. can be made. But how to set the 'filehandle' part and make it visible?
I have found such a workaround:
my $fh = "SELECT...";
open $fh, "/dev/null";
<$fh>;
but it is a bit long, and it actually does open a file.
The filehandle information that appears in warn and die messages is only set after calls to <HANDLE>, readline, tell, eof, and seek. When you fetch data from a database with DBI, for example, you're not calling any of these, so you have to pass the extra data yourself.
One way to do this is to write a custom exception class that stringifies to the text you want:
package MyException;
use strict;
use warnings 'all';
use v5.18.0;
use overload '""' => \&as_string;
sub new {
my ($self, $message, $src, $src_line) = #_;
my ($package, $file, $line) = caller;
if (! defined $src && ref ${^LAST_FH} eq 'GLOB') {
$src = *${^LAST_FH}{NAME};
$src_line = $.;
}
bless { message => $message,
file => $file,
line => $line,
src => $src,
src_line => $src_line }, $self;
}
sub as_string {
my ($self) = #_;
my $message = "$self->{message} at $self->{file} line $self->{line}";
if (defined $self->{src} && defined $self->{src_line}) {
$message .= ", <$self->{src}> line $self->{src_line}";
}
$message .= "\n";
}
1;
Note that Perl 5.18.0 or up is required to use the read-only ${^LAST_FH} variable, which holds a reference to the last read filehandle.
Here's how you would use this when reading from a file:
use strict;
use warnings 'all';
use MyException;
while (<DATA>) {
warn MyException->new('foo'); # equivalent to warn 'foo'
}
__DATA__
first
second
Output:
foo at ./myscript line 9, <DATA> line 1
foo at ./myscript line 9, <DATA> line 2
And here's how you would use it when fetching records from a database:
use strict;
use warnings 'all';
use DBI;
use MyException;
my $dbh = DBI->connect('dbi:mysql:test', 'user', 'pass', {
RaiseError => 1
});
my $sql = 'SELECT * FROM test';
my $sth = $dbh->prepare($sql);
$sth->execute;
my $count;
while (my $row = $sth->fetch) {
warn MyException->new('foo', $sql, ++$count);
}
Output:
foo at ./myscript line 19, <SELECT * FROM test> line 1
foo at ./myscript line 19, <SELECT * FROM test> line 2
(Unfortunately, DBI doesn't provide a method to get the number of rows that have been fetched so far, so you have to count them yourself.)
Since you're trying to warn or die from inside a subroutine, you have to do a little bit more work. The simplest approach for die would be to trap exceptions from your subroutine with eval and re-throw them:
my $count = 1;
while (my $row = $sth->fetch) {
eval {
inc($row[0]);
};
if ($# =~ /^(cannot increment \[.*?\])/) {
die MyException->new($1, $sql, $count);
}
elsif ($#) {
die $#;
}
$count++;
}
You can handle warnings in a similar way by creating a __WARN__ handler:
{
my $count = 1;
local $SIG{__WARN__} = sub {
if ($_[0] =~ /^(increment overflow \[.*?\])/) {
warn MyException->new($1, $sql, $count);
}
else {
warn #_;
}
};
while (my $row = $sth->fetch) {
inc($row[0]);
$count++;
}
}
You may prefer this implementation of your inc subroutine. Your own uses the reserved variables $a and $b, as well as saving and retrieving the initial non-numeric part of the string
Note that the STDERR output is not in sync with STDOUT, so the warning appears prematurely in the aggregated text. In reality the warning is issued only when the passed string has an all-nines numeric field
use strict;
use warnings 'all';
my $s = 'ZZ90';
for ( 1 .. 20 ) {
$s = inc_str($s);
print $s, "\n";
}
sub inc_str {
my ($str) = #_;
$str =~ s{([0-9]+)$}{
my $num = $1;
warn "Increment overflow [$str]" unless $num =~ /[^9]/;
sprintf '%0*d', length($num), $num+1;
}e or die "Cannot increment [$str]";
return $str;
}
output
Increment overflow [ZZ99] at E:\Perl\source\inc_str.pl line 18.
ZZ91
ZZ92
ZZ93
ZZ94
ZZ95
ZZ96
ZZ97
ZZ98
ZZ99
ZZ100
ZZ101
ZZ102
ZZ103
ZZ104
ZZ105
ZZ106
ZZ107
ZZ108
ZZ109
ZZ110

Read ini files without section names

I want to make a configuration file which hold some objects, like this (where of course none of the paramaters can be considered as a primary key)
param1=abc
param2=ghj
param1=bcd
param2=hjk
; always the sames parameters
This file could be read, lets say with Config::IniFiles, because it has a direct transcription into ini file, like this
[0]
param1=abc
param2=ghj
[1]
param1=bcd
param2=hjk
with, for example, something like
perl -pe 'if (m/^\s*$/ || !$section ) print "[", ($section++ || 0) , "]"'
And finish with
open my $fh, '<', "/path/to/config_file.ini" or die $!;
$cfg = Config::IniFiles->new( -file => $fh );
(...parse here the sections starting with 0.)
But, I here ask me some question about the thing becoming quite complex....
(A) Is There a way to transform the $fh, so that it is not required to execute the perl one-liner BEFORE reading the file sequentially? So, to transform the file during perl is actually reading it.
or
(B) Is there a module to read my wonderfull flat database? Or something approching? I let myslef said, that Gnu coreutils does this kind of flat file reading, but I cannot remember how.
You can create a simple subclass of Config::INI::Reader:
package MyReader;
use strict;
use warnings;
use base 'Config::INI::Reader';
sub new {
my $class = shift;
my $self = $class->SUPER::new( #_ );
$self->{section} = 0;
return $self;
}
sub starting_section { 0 };
sub can_ignore { 0 };
sub parse_section_header {
my ( $self, $line ) = #_;
return $line =~ /^\s*$/ ? ++$self->{section} : undef ;
}
1;
With your input this gives:
% perl -MMyReader -MData::Dumper -e 'print Dumper( MyReader->read_file("cfg") )'
$VAR1 = {
'1' => {
'param2' => 'hjk',
'param1' => 'bcd'
},
'0' => {
'param2' => 'ghj',
'param1' => 'abc'
}
};
You can use a variable reference instead of a file name to create a filehandle that reads from it:
use strict;
use warnings;
use autodie;
my $config = "/path/to/config_file.ini";
my $content = do {
local $/;
open my $fh, "<", $config;
"\n". <$fh>;
};
# one liner replacement
my $section = 0;
$content =~ s/^\s*$/ "\n[". $section++ ."]" /mge;
open my $fh, '<', \$content;
my $cfg = Config::IniFiles->new( -file => $fh );
# ...
You can store the modified data in a real file or a string variable, but I suggest that you use paragraph mode by setting the input record separator $/ to the empty string. Like this
use strict;
use warnings;
{
local $/ = ''; # Read file in "paragraphs"
my $section = 0;
while (<DATA>) {
printf "[%d]\n", $section++;
print;
}
}
__DATA__
param1=abc
param2=ghj
param1=bcd
param2=hjk
output
[0]
param1=abc
param2=ghj
[1]
param1=bcd
param2=hjk
Update
If you read the file into a string, adding section identifiers as above, then you can read the result directly into a Config::IniFiles object using a string reference, for instance
my $config = Config::IniFiles->new(-file => \$modified_contents)
This example shows the tie interface, which results in a Perl hash that contains the configuration information. I have used Data::Dump only to show the structure of the resultant hash.
use strict;
use warnings;
use Config::IniFiles;
my $config;
{
open my $fh, '<', 'config_file.ini' or die "Couldn't open config file: $!";
my $section = 0;
local $/ = '';
while (<$fh>) {
$config .= sprintf "[%d]\n", $section++;
$config .= $_;
}
};
tie my %config, 'Config::IniFiles', -file => \$config;
use Data::Dump;
dd \%config;
output
{
# tied Config::IniFiles
"0" => {
# tied Config::IniFiles::_section
param1 => "abc",
param2 => "ghj",
},
"1" => {
# tied Config::IniFiles::_section
param1 => "bcd",
param2 => "hjk",
},
}
You may want to perform operations on a flux of objects (as Powershell) instead of a flux of text, so
use strict;
use warnings;
use English;
sub operation {
# do something with objects
...
}
{
local $INPUT_RECORD_SEPARATOR = '';
# object are separated with empty lines
while (<STDIN>) {
# key value
my %object = ( m/^ ([^=]+) = ([[:print:]]*) $ /xmsg );
# key cannot have = included, which is the delimiter
# value are printable characters (one line only)
operation ( \%object )
}
A like also other answers.

How to write a correct name using combination of variable and string as a filehandler?

I want to make a tool to classify each line in input file to several files
but it seems have some problem in naming a filehandler so I can't go ahead , how do I solve?
here is my program
ARGV[0] is the input file
ARGV[1] is the number of classes
#!/usr/bin/perl
use POSIX;
use warnings;
# open input file
open(Raw,"<","./$ARGV[0]") or die "Can't open $ARGV[0] \n";
# create a directory class to store class files
system("mkdir","Class");
# create files for store class informations
for($i=1;$i<=$ARGV[1];$i++)
{
# it seems something wrong in here
open("Class$i",">","./Class/$i.class") or die "Can't create $i.class \n";
}
# read each line and random decide which class to store
while( eof(Raw) != 1)
{
$Line = readline(*Raw);
$Random_num = ceil(rand $ARGV[1]);
for($k=1;$k<=$ARGV[1];$k++)
{
if($Random_num == $k)
{
# Store to the file
print "Class$k" $Line;
last;
}
}
}
for($h=1;$h<=$ARGV[1];$h++)
{
close "Class$h";
}
close Raw;
thanks
Later I use the advice provided by Bill Ruppert
I put the name of filehandler into array , but it seems appear a syntax bug , but I can't correct it
I label the syntax bug with ######## A syntax error but it looks quite OK ########
here is my code
#!/usr/bin/perl
use POSIX;
use warnings;
use Data::Dumper;
# open input file
open(Raw,"<","./$ARGV[0]") or die "Can't open $ARGV[0] \n";
# create a directory class to store class files
system("mkdir","Class");
# put the name of hilehandler into array
for($i=0;$i<$ARGV[1];$i++)
{
push(#Name,("Class".$i));
}
# create files of classes
for($i=0;$i<=$#Name;$i++)
{
$I = ($i+1);
open($Name[$i],">","./Class/$I.class") or die "Can't create $I.class \n";
}
# read each line and random decide which class to store
while( eof(Raw) != 1)
{
$Line = readline(*Raw);
$Random_num = ceil(rand $ARGV[1]);
for($k=0;$k<=$#Name;$k++)
{
if($Random_num == ($k+1))
{
print $Name[$k] $Line; ######## A syntax error but it looks quite OK ########
last;
}
}
}
for($h=0;$h<=$#Name;$h++)
{
close $Name[$h];
}
close Raw;
thanks
To quote the Perl documentation on the print function:
If you're storing handles in an array or hash, or in general whenever you're using any expression more complex than a bareword handle or a plain, unsubscripted scalar variable to retrieve it, you will have to use a block returning the filehandle value instead, in which case the LIST may not be omitted:
print { $files[$i] } "stuff\n";
print { $OK ? STDOUT : STDERR } "stuff\n";
Thus, print $Name[$k] $Line; needs to be changed to print { $Name[$k] } $Line;.
How about this one:
#! /usr/bin/perl -w
use strict;
use POSIX;
my $input_file = shift;
my $file_count = shift;
my %hash;
open(INPUT, "<$input_file") || die "Can't open file $input_file";
while(my $line = <INPUT>) {
my $num = ceil(rand($file_count));
$hash{$num} .= $line
}
foreach my $i (1..$file_count) {
open(OUTPUT, ">$i.txt") || die "Can't open file $i.txt";
print OUTPUT $hash{$i};
close OUTPUT;
}
close INPUT;

Perl: open file but not overwrite existing one but append number

I wonder if any module exist that can automate file numbering process.
If i try open "foo.bar" and it exists i open "foo_1.bar" without race condition.
What if two apps try open some file. Open fail or they get filehandles with diferent number?
Very thx for help.
I don't know of a canned module to do this off the top of my head, but the basic idea if you want a sequential file name is:
use Fcntl;
use Errno;
$seq = "";
until (defined ($fh = sysopen("foo".$seq.".bar", O_WRONLY|O_CREAT|O_EXCL, 0600))) {
last if $! != EEXIST;
$seq eq '' && $seq = '_0';
$seq =~ s/(\d+)/$1 + 1/e;
}
# if !defined $fh then $! contains the error, otherwise "foo".$seq.".bar" is created
Opens unique file name for writing. Return array ref to IO::File ref and writing name.
If fail return undef. Work with warnings and strict.
use Fcntl;
use Errno;
use IO::File;
sub open_unique {
my $file = shift || '';
unless ($file =~ /^(.*?)(\.[^\.]+)$/) {
print "Bad file name: '$file'\n";
return;
}
my $io;
my $seq = '';
my $base = $1;
my $ext = $2;
until (defined ($io = IO::File->new($base.$seq.$ext
,O_WRONLY|O_CREAT|O_EXCL))) {
last unless $!{EEXIST};
$seq = '_0' if $seq eq '';
$seq =~ s/(\d+)/$1 + 1/e;
}
return [$io,$base.$seq.$ext] if defined $io;
}
You might want to look at File::Temp.
Something like:
($fh, $filename) = tempfile('foo_XXXX', SUFFIX => '.bar');
print $fh "Some data\n";
close($fh) or die;