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

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;

Related

perl redirect stdout to lexical filehandle

I'm trying to write a helper function that runs a perl function in another process and returns a closure that produces a line of output at a time when called.
I figured out a way of doing this using pipe that mixes old and new-style filehandles. I used an old-style one for the sink in order to use the open(STDOUT, ">&thing") syntax and a new-style one for the source since it needs to be captured by a closure and I didn't want to burden the caller with providing a filehandle.
Is there a way of using a new-style filehandle in a construction with the same meaning as open(STDOUT, ">&thing")?
#!/usr/bin/env perl
# pipe.pl
# use pipe() to create a pair of fd's.
# write to one and read from the other.
#
# The source needs to be captured by the closure and can't be
# destructed at the end of get_reader(), so it has to be lexical.
#
# We need to be able to redirect stdout to sink in such a way that
# we actually dup the file descriptor (so shelling out works as intended).
# open(STDOUT, ">&FILEHANDLE") achieves this but appears to require an
# old-style filehandle.
use strict;
use warnings;
sub get_reader {
local *SINK;
my $source;
pipe($source, SINK) or die "can't open pipe!";
my $cpid = fork();
if ($cpid == -1) {
die 'failed to fork';
}
elsif ($cpid == 0) {
open STDOUT, ">&SINK" or die "can't open sink";
system("echo -n hi");
exit;
}
else {
return sub {
my $line = readline($source);
printf "from child (%s)\n", $line;
exit;
}
}
}
sub main {
my $reader = get_reader();
$reader->();
}
main();
When run, this produces
from child (hi)
as expected.
sub get_reader {
my ($cmd) = #_;
open(my $pipe, '-|', #$cmd);
return sub {
return undef if !$pipe;
my $line = <$pipe>;
if (!defined($line)) {
close($pipe);
$pipe = undef;
return undef;
}
chomp($line);
return $line;
};
}
If that's not good enough (e.g. because you also need to redirect the child's STDIN or STDERR), you can use IPC::Run instead.
use IPC::Run qw( start );
sub get_reader {
my ($cmd) = #_;
my $buf = '';
my $h = start($cmd, '>', \$buf);
return sub {
return undef if !$h;
while (1) {
if ($buf =~ s/^([^\n]*)\n//) {
return $1;
}
if (!$h->pump())) {
$h->finish();
$h = undef;
return substr($buf, 0, length($buf), '') if length($buf);
return undef;
}
}
};
}
Either way, you can now do
my $i = get_reader(['prog', 'arg', 'arg']);
while (defined( my $line = $i->() )) {
print "$line\n";
}
Either way, error handling left to you.

Picking a specific line with a specific string

I am trying this in Perl to pick one complete line from whole document which contains "CURRENT_RUN_ID". I have been using below code to accomplish the above said task but I am unable to enter the while loop.
my $sSuccessString = "CURRENT_RUN_ID";
open(LOG, "$slogfile") or die("Can't open $slogfile\n");
my $sLines;
{
local $/ = undef;
$sLines=<LOG>;
}
my $spool = 0;
my #matchingLines;
while (<LOG>)
{
print OUTLOG "in while loop\n";
if (m/$sSuccessString/i) {
print OUTLOG "in if loop\n";
$spool = 1;
print map { "$_ \n" } #matchingLines;
#matchingLines = ();
}
if ($spool) {
push (#matchingLines, $_);
}
}
You are already done reading from the filehandle LOG after you have slurped it into $sLines. <LOG> in the head of the while will return undef because it has reached eof. You either have to use that variable $sLines in your while loop or get rid of it. You're not using it anyway.
If you only want to print the line that matches, all you need to do is this:
use strict;
use warnings;
open my $fh_in, '<', 'input_file' or die $!;
open my $fh_out '>', 'output_file' or die $!;
while (my $line = <$fh_in>) {
print $fh_out $line if $line =~ m/CURRENT_RUN_ID/;
}
close $fh_in;
close $fh_out;
When you execute this code:
$sLines=<LOG>;
it reads all of the data from LOG into $sLines and it leaves the file pointer for LOG at the end of the file. So when you next try to read from that file handle with:
while (<LOG>)
nothing is returned as there is no more data to read.
If you want to read the file twice, then you will need to use the seek() function to reset the file pointer before your second read.
seek LOG, 0, 0;
But, given that you never do anything with $sLines I suspect that you can probably just remove that whole section of the code.
The whole thing with $spool and #matchingLines seems strange too. What were you trying to achieve there?
I think your code can be simplified to just:
my $sSuccessString = "CURRENT_RUN_ID";
open(LOG, $slogfile) or die("Can't open $slogfile\n");
while (<LOG>) {
print OUTLOG if /$sSuccessString/i/;
}
Personally, I'd make it even simpler, by reading from STDIN and writing to STDOUT.
my $sSuccessString = 'CURRENT_RUN_ID';
while (<>) {
print if /$sSuccessString/i/;
}
And then using Unix I/O redirection to connect up the correct files.
$ ./this_filter.pl < your_input.log > your_output.log

function call in perl

As a part of my course work I have been learning perl programming language for the first time in last the few weeks. I have been writing small functions and making function calls. I have written a function for string matching.
use strict;
use warnings;
sub find_multi_string {
my ($file, #strings) = #_;
my $fh;
open ($fh, "<$file");
#store the whole file in an array
my #array = <$fh>;
for my $string (#strings) {
if (grep /$string/, #array) {
next;
} else {
die "Cannot find $string in $file";
}
}
return 1;
}
find_multi_string('file name', 'string1','string2','string3','string4','string 5');
In the above script I'm passing the arguments in the function call. The script works.
But I'd like to know if there is way to specify the file name and string1... string n in an array in the program itself and just make the function call.
find_multi_string();
That would be a mistake, always pass parameters and return values to your subroutines.
What you're describing is essentially using subroutines solely to subdivide and document your code. If you were to do that, it would better to just remove the subroutine entirely and include a comment before the section of code.
Overall, your code looks good as is. You probably will want to use quotemeta though, and your logic can be simplified a little:
use strict;
use warnings;
use autodie;
sub find_multi_string {
my ($file, #strings) = #_;
# Load the file
my $data = do {
open my $fh, "<", $file;
local $/;
<$fh>
};
for my $string (#strings) {
if ($data !~ /\Q$string/) {
die "Cannot find $string in $file";
}
}
return 1;
}
find_multi_string('file name', 'string1','string2','string3','string4','string 5');
A few improvements of your original code:
use autodie
use 3-args open
as you want to check anywhere in the file, just load the file as a single string
if the matching string are just text without metacharacters from regexp, just use the index function
Your question is about passing the function arguments from your program.
I suspect that you are looking for #ARGV. See perlvar.
Here is the modified code:
use strict;
use warnings;
use autodie;
sub find_multi_string {
my ($file, #strings) = #_;
my $content = do {
open my $fh, '<', $file;
local $/;
<$fh>
};
foreach (#strings) {
die "Cannot find $string in $file" unless index($content, $_) >= 0;
}
return 1;
}
find_multi_string(#ARGV);

Can't call method "network" without a package or object reference at blib/lib/NetAddr/IP.pm

I'm trying to write a Perl script to take a list of IPv4 aggregates and another list of addresses and using NetAddr::IP to take each IP and compare to the list of aggregates to see if it belongs to any of the aggregates. I need to find which ones are not part of any of the list of aggregates I have.
I finally got past all of the Perl errors and now I'm getting some kind of error with the NetAddr::IP module it appears. Can anyone assist?
Here is the error I'm getting:
Can't call method "network" without a package or object reference at blib/lib/NetAddr/IP.pm (autosplit into blib/lib/auto/NetAddr/IP/compactref.al) line 1075.
And here is the code I'm using:
#!/usr/bin/perl
use strict;
use NetAddr::IP;
my $fh = ();
my $sfile = "/home/dkenne201/ex-addresses.txt";
my $afile = "/home/dkenne201/aggs.txt";
my #space;
my #ips;
my $ip;
open($fh, "<", $sfile)
or die "Failed to open file: $!\n";
while(<$fh>) {
chomp;
push #space, $_;
}
close $fh;
open($fh, "<", $afile)
or die "Failed to open file: $!\n";
while(<$fh>) {
chomp;
push #ips, $_;
}
close $fh;
for my $netblock (NetAddr::IP::compact #space)
{
for $ip (map { new NetAddr::IP->new($_) } #ips)
{
if ($ip->within($netblock)) {
print "$ip found within $netblock\n";
}
else {
print "$ip not found within $netblock\n";
}
}
}
Here is an example of the format in the text files that contain the data as well.
Aggs example:
1.1.0.0/16
2.2.0.0/18
Addresses example:
1.1.1.1
192.168.2.3
5.2.3.4
You're calling new twice.
for $ip (map { new NetAddr::IP->new($_) } #ips)
Your code can be cleaned up to the following:
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use NetAddr::IP;
my $sfile = "/home/dkenne201/ex-addresses.txt";
my $afile = "/home/dkenne201/aggs.txt";
my #netblocks = do {
open my $fh, "<", $sfile;
my #space = <$fh>;
chomp #space;
map {NetAddr::IP->new($_)} #space;
};
open my $fh, "<", $afile;
while (<$fh>) {
chomp;
my $ip = NetAddr::IP->new($_);
if (my ($netblock) = grep {$ip->within($_)} #netblocks) {
print "$_ found within $netblock\n";
} else {
print "$_ not found\n";
}
}
close $fh;
Outputs:
1.1.1.1 found within 1.1.0.0/16
192.168.2.3 not found
5.2.3.4 not found
Thanks to Miller for the improved version of my code. I am just re-posting with the $afile and $sfile variables swapped so we are looking for ips within aggs and not aggs within ips (which broke the earlier code in my original post as well). Works perfectly for me with the below code.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use NetAddr::IP;
my $sfile = "ex-addresses.txt";
my $afile = "aggs.txt";
my #netblocks = do {
open my $fh, "<", $afile;
my #space = <$fh>;
chomp #space;
map {NetAddr::IP->new($_)} #space;
};
open my $fh, "<", $sfile;
while (<$fh>) {
chomp;
my $ip = NetAddr::IP->new($_);
if (my ($netblock) = grep {$ip->within($_)} #netblocks) {
print "$_ found within $netblock\n";
} else {
print "$_ not found\n";
}
}
close $fh;

Perl script.file handling issues

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 $_;
}
}