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;
Related
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
Here we are looking for the string "reftext" in the given file. The line next to this contains a string with 3 integers. So we are extracting them in #all_num. We are printing the value of #all_num[2] only if is not NULL. But the logic used here doesn't print #all_num[2] even if it has 0.
#!/usr/bin/perl
open( READFILE, "<myfile.txt" );
#list = <READFILE>;
$total_lines = scalar #list;
for ( $count = 0; $count < $total_lines; $count++ ) {
if (#list[ $count =~ /reftext/ )
{
#all_num = #list[ $count + 1 ] =~ /(\d+)/g;
if ( #all_num[2] != NULL ) {
print "#all_num[2]\n";
}
}
}
Hope this helps,
use strict;
use warnings;
my #fvals = (
[ i => undef ],
[ j => 0 ],
[ k => "" ],
);
for my $r (#fvals) {
my ($k, $v) = #$r;
if (!defined($v)) { print "$k is undef\n"; }
elsif (!length($v)) { print "$k is empty string\n"; }
# elsif (!$v) { print "$k is zero\n"; }
# recognizes zero value in "0.0" or "0E0" notation
elsif ($v == 0) { print "$k is zero\n"; }
}
output
i is undef
j is zero
k is empty string
Perl does not include a NULL, so the line
if(#all_num[2]!= NULL)
is nonsensical in Perl. (More accurately, it attempts to locate a sub named NULL and run it to get the value to compare against #all_num[2], but fails to do so because you (presumably) haven't defined such a sub.) Note that, if you had enabled use strict, this would cause a fatal error instead of pretending to work. This is one of the many reasons to always use strict.
Side note: When you pull a value out of an array, it's only a single value, so you should say $all_num[2] rather than #all_num[2] when referring to the third element of the array #all_num. (Yes, this is a little confusing to get used to. I hear that it's been changed in Perl 6, but I'm assuming you're using Perl 5 here.) Note that, if you had enabled use warnings, it would have told you that "Scalar value #all_num[2] better written as $all_num[2]". This is one of the many reasons to always use warnings.
If you want to test whether $all_num[2] contains a value, the proper way to express that in Perl is
if (defined $all_num[2])
This is how your program would look using best practices
You should
Always use strict and use warnings, and declare all your variables with my
Use the three-parameter form of open
Check that open calls succeeded, and include $! in the die string if not
Use a while loop to process a file one line at a time, in preference to reading the entire file into memory
#!/usr/bin/perl
use strict;
use warnings;
open my $fh, '<', 'myfile.txt' or die $!;
while ( <$fh> ) {
next unless /reftext/;
my $next_line = <$fh>;
my #all_num = $next_line =~ /\d+/g;
print "$all_num[2]\n" if defined $all_num[2];
}
Try this:
#!/usr/bin/perl
use warnings;
use strict;
open(READFILE, "<", "myfile.txt") or die $!;
my #list = <READFILE>;
my $total_lines = scalar #list;
close (READFILE);
for(my $count=0; $count<$total_lines; $count++)
{
if($list[$count] =~ /reftext/)
{
my #all_num = $list[$count+1] =~ /(\d+)/g;
if($all_num[2] ne '')
{
print "$all_num[2]\n";
}
}
}
To check a variable is null or not:
if ($str ne '')
{
print $str;
}
or better:
my ($str);
$str = "";
if (defined($str))
{
print "defined";
}
else
{
print "not defined";
}
If the other answers do not work, try treating the variable as a string:
if ( $all_num[2] == 'null' && length($all_num[2]) == 4 ){
# null
} else {
# not null
}
As with any code you write, be sure to test your code.
I am having an input file like this:
Input file
I need to replace the value #pSBSB_ID="*" of #rectype=#pRECTYPE="SBSB" with #pMEME_SSN="034184233", value of #pRECTYPE="SMSR", ..and have to delete the row where #rectype='#pRECTYPE="SMSR", '
Example:
So, after changes have been made, the file should be like this:
....#pRECTYPE="SBSB", #pGWID="17199269", #pINPUT_METHOD="E", #pGS08="005010X220A1", #pSBSB_FAM_UPDATE_CD="UP", #pSBSB_ID="034184233".....
....#pRECTYPE="SBEL", #pSBEL_EFF_DT="01/01/2013", #pSBEL_UPDATE_CD="TM", #pCSPD_CAT="M", #pCSPI_ID="MHMO1003"
.
.
.
Update
I tried below mentioned code:
Input file extension: mms and there are multiple files to process.
my $save_for_later;
my $record;
my #KwdFiles;
my $r;
my $FilePath = $ARGV[0];
chdir($FilePath);
#KwdFiles = <*>;
foreach $File(#KwdFiles)
{
unless(substr($File,length($File)-4,length($File)) eq '.mms')
{
next;
}
unless(open(INFILE, "$File"))
{
print "Unable to open file: $File";
exit(0);
}
print "Successfully opened the file: \"$File\" for processing\n\n";
while ( my $record = <INFILE> ) {
my %r = $record =~ /\#(\w+) = '(.*?)'/xg;
if ($r{rectype} eq "SMSR") {
$save_for_later = $r{pMEME_SSN};
next;
}
elsif ($r{rectype} eq "SBSB" and $r{pSBSB_ID} eq "*") {
$record =~ s|(\#pSBSB_ID = )'.*?'|$1'$save_for_later'|x;
}
close(INFILE);
}
}
But, I am still not getting the updated values in the file.
#!/usr/bin/perl
open IN, "< in.txt";
open OUT, "> out.txt";
my $CUR_RECID = 1^1;
while (<IN>) {
if ($CUR_RECID) {
s/recname='.+?'/recname='$CUR_RECID'/ if /rectype='DEF'/;
$CUR_RECID = 1^1;
print OUT;
}
$CUR_RECID = $1 if /rectype='ABC'.+?rec_id='(.+?)'/;
}
close OUT;
close IN;
Try that whole code. No need a separate function; This code does everything.
Run this script from your terminal with the files to be modified as arguments:
use strict;
use warnings;
$^I = '.bak'; #modify original file and create a backup of the old ones with .bak appended to the name
my $replacement;
while (<>) {
$replacement = $1 if m/(?<=\#pMEME_SSN=)("\d+")/; #assume replacement will be on the first line of every file.
next if m/^\s*\#pRECTYPE="SMSR"/;
s/(?<=\#pSBSB_ID=)("\*")/$replacement/g;
print;
}
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;
I have written a Perl script:
#!/usr/bin/perl
use strict;
use warnings;
my $file_name;
my $ext = ".text";
my $subnetwork2;
my %files_list = ();
opendir my $dir, "." or die "Cannot open directory: $!";
my #files = readdir $dir;
sub create_files() {
my $subnetwork;
open(MYFILE, 'file.txt');
while (<MYFILE>) {
if (/.subnetwork/) {
my #string = split /[:,\s]+/, $_;
$subnetwork = $string[2];
}
if (/.set/ && (defined $subnetwork)) {
my #string = split /[:,\s]+/, $_;
my $file = $subnetwork . $string[1];
open FILE, ">", "$file.text" or die $!;
close(FILE);
}
}
close(MYFILE);
}
sub create_hash() {
foreach (#files) {
if (/.text/) {
open($files_list{$_}, ">>$_") || die("This file will not open!");
}
}
}
sub init() {
open(MYFILE3, 'file.txt');
while (<MYFILE3>) {
if (/.subnetwork/) {
my #string3 = split /[:,\s]+/, $_;
$subnetwork2 = $string3[2];
last;
}
}
close(MYFILE3);
}
sub main_process() {
init;
create_files;
create_hash;
open(MYFILE1, 'file.txt');
while (<MYFILE1>) {
if (/.subnetwork/) {
my #string3 = split /[:,\s]+/, $_;
$subnetwork2 = $string3[2];
}
if (/.set/) {
my #string2 = split /[:,\s]+/, $_;
$file_name = $subnetwork2 . $string2[1] . $ext;
}
if (/.domain/ || /.end/ || ($. < 6)) {
my $domain = $_;
foreach (#files) {
if (/.text/ && /$subnetwork2/) {
prnt { $files_list{$_} } "$domain";
}
}
}
elsif ($. >= 6) {
print { $files_list{$file_name} } "$_";
}
}
close(MYFILE1);
foreach my $val (values %files_list) { close($val); }
closedir $dir;
}
main_process;
This script creates files in the current directory based upon the content of file.txt, and then open those files again.
Then it starts processing file.txt and redirects the lines according to the filename set dynamically.
This setting of the file name is also based upon the data in the file file.txt.
The problem that I am facing here is that the redirection is only to a single file. That means there is some problem with the file handle.
All the files that are expected to be created are created perfectly but the data goes into only one of them.
I doubt if there is a problem with the file handle that I am using while redirecting.
Could anyone please help?
Sample input file is below:
..cnai #Generated on Thu Aug 02 18:33:18 2012 by CNAI R21D06_EC01, user tcssrpi
..capabilities BASIC
.utctime 2012-08-02 13:03:18
.subnetwork ONRM_ROOT_MO:NETSim_BAG
.domain BSC
.set BAG01
AFRVAMOS="OFF"
AWBVAMOS="OFF"
ALPHA=0
AMRCSFR3MODE=1,3,4,7
AMRCSFR3THR=12,21,21
AMRCSFR3HYST=2,3,3
AMRCSFR3ICM=
AMRCSFR4ICM=
USERDATA=""
.set BAG02
AFRVAMOS="OFF"
AWBVAMOS="OFF"
ALPHA=0
AMRCSFR3MODE=1,3,4,7
AMRCSFR3THR=12,21,21
AMRCSFR3HYST=2,3,3
..end
The problem that i am facing is during execution:
> process.pl
Use of uninitialized value in ref-to-glob cast at process.pl line 79, <MYFILE1> line 6.
Can't use string ("") as a symbol ref while "strict refs" in use at process.pl line 79, <MYFILE1> line 6.
The problem i can understand is with this line:
print { $files_list{$_} } "$domain";
but i am unable to understand why!!
The output i need is :
> cat NETSim_BAGBAG01.text
.set BAG01
AFRVAMOS="OFF"
AWBVAMOS="OFF"
ALPHA=0
AMRCSFR3MODE=1,3,4,7
AMRCSFR3THR=12,21,21
AMRCSFR3HYST=2,3,3
AMRCSFR3ICM=
AMRCSFR4ICM=
USERDATA=""
> cat NETSim_BAGBAG02.text
.set BAG02
AFRVAMOS="OFF"
AWBVAMOS="OFF"
ALPHA=0
AMRCSFR3MODE=1,3,4,7
AMRCSFR3THR=12,21,21
AMRCSFR3HYST=2,3,3
>
Your problem in following lines:
open(PLOT,">>$_") || die("This file will not open!");
$files_list{$_}=*PLOT;
You should replace they with:
open($files_list{$_},">>$_") || die("This file will not open!");
This portion of your code is the key:
open(PLOT,">>$_") || die("This file will not open!");
$files_list{$_}=*PLOT;
The problem is that you are essentially using the filehandle PLOT as a global variable; every single entry in your hash is pointing to this same filehandle. Replace with something like this:
local *PLOT;
open(PLOT,">>$_") || die("This file will not open!");
$files_list{$_}=*PLOT;
You have got youself very entangled with this program. There is no need for the hash table or the multiple subroutines.
Here is a quick refactoring of your code that works with your data and writes files NETSim_BAG.BAG01.text and NETSim_BAG.BAG02.text. I put a dot between the subnet and the set to make the names a little clearer.
use strict;
use warnings;
my $out_fh;
open my $fh, '<', 'file.txt' or die $!;
my ($subnetwork, $set, $file);
while (<$fh>) {
if ( /^\.subnetwork\s+\w+:(\w+)/ ) {
$subnetwork = $1;
}
elsif ( /^\.set\s+(\w+)/ and $subnetwork) {
$set = $1;
$file = "$subnetwork.$set.text";
open $out_fh, '>', $file or die qq(Unable to open "$file" for output: $!);
print $out_fh;
}
elsif ( /^\.\.end/ ) {
undef $subnetwork;
undef $file;
}
if (/^[^.]/ and $file) {
print $out_fh $_;
}
}