mapping grep result to csv file - perl

I'm trying to populate the grep result to csv file. But it is showing the following error.
"Use of uninitialized value in concatenation (.) or string at"
code:
sub gen_csv {
my $db_ptr = shift #_;
my $cvs_file_name = shift #_;
open( FILE, ">$cvs_file_name" ) or die("Unable to open CSV FILE $cvs_file_name\n");
print FILE "Channel no, Page no, \n";
foreach my $s ( #{$db_ptr} ) {
my $tmp = "$s->{'ch_no'},";
$tmp .= "$s->{'pg_no'},";
print FILE $tmp;
}
close(FILE);
}
sub parse_test_logs {
my $chnl;
my $page;
my $log = "sample.log";
open my $log_fh, "<", $log;
while ( my $line = <$log_fh> ) {
if ( $line =~ /(.*):.*solo_(.*): queueing.*/ ) {
my $chnl = $1;
my $page = $2;
}
my %test_details = (
'ch_no' => $chnl,
'pg_no' => $page, # <- was missing closing single quote
);
push( #{$dba_ptr}, \%test_details );
}
close log_fh;
}
Any suggestions on what i'm missing out?
(i'm getting the above error pointing to my $tmp = "$s->{'ch_no'},"; in gen_csv module)

Most likely this is due to NULL values in your DB records or the keys you are using are wrong. Either way, the warning is because the ch_no value does not exist.
If you don't care about NULL values, and you are fine with some of the values being missing, then you can suppress warnings for uninitialized values.
no warnings 'uninitialized';

Your problem involves this block:
if ( $line =~ /(.*):.*solo_(.*): queueing.*/ ) {
my $chnl = $1;
my $page = $2;
}
my %test_details = (
'ch_no' => $chnl,
'pg_no' => $page,
);
You're capturing your variables, but you have them declared with my within the if block. Those lexicals then go out of scope and are undef when used to initialize the hash.
I recommend simplifying your parsing function to the following:
sub parse_test_logs {
my $log = "sample.log";
open my $log_fh, "<", $log;
while (<$log_fh>) {
if ( my ( $chnl, $page ) = /(.*):.*solo_(.*): queueing.*/ ) {
push #{$dba_ptr}, { 'ch_no' => $chnl, 'pg_no' => $page };
} else {
warn "regex did not match for line $.: $_";
}
}
close $log_fh;
}
Finally, it's possible that you already are, but I just want to pass on the ever necessary advice to always include use strict; and use warnings; at the top of EVERY Perl script.

Related

Config::Simple, how to change default output header?

Testing the generation on the fly of config files in ini format with the package Config::Simple generates the desired file but always with the same header section, which includes the name of the Perl package at the beginning of the file. Does Config::Simple have a method to modify this default printing? I would like to replace this name with a new one. Is it possible with some feature in the package?
Here is a toy code:
#!/usr/bin/perl
use strict;
use warnings;
use Config::Simple;
my $cfg = new Config::Simple(
syntax => 'ini'
) or die Config::Simple->error();
$cfg->param("Program.mode", "ALL");
$cfg->param("Program.strategies", "1,2,3,4,5,6,7,8,9,10");
$cfg->param("Data.name_specie", "Homo sapiens");
$cfg->write("test.cfg") or die $cfg->error();
The output:
; Config::Simple 4.58
; Mon Mar 16 12:33:55 2020
[Program]
strategies=1,2,3,4,5,6,7,8,9,10
mode=ALL
[Data]
name_specie=Homo sapiens
Just wanted to replace the ; Config::Simple 4.58 line.
Thanks in advance for your suggestions.
"Simple" modules often aren't simple because they make so many decisions for you. If you don't like those decisions, you are stuck. This particular module hasn't been updated in over a decade and has several architectural issues. If you want INI files, use a different module, such as Config:: IniFiles, Config::Tiny, or Config::INI which are maintained and flexible.
My first thought was to subclass and override the method that adds the header since it was hard-baked into one of the methods. This is onerous because the module uses a combination of "private" subroutines and package variables. I tend to try this first because I don't disturb the original package:
use strict;
use warnings;
use v5.12;
use Config::Simple;
package Local::Config::Simple {
use parent qw(Config::Simple);
# generates a writable string
sub as_string {
my $self = shift;
my $syntax = $self->{_SYNTAX} or die "'_SYNTAX' is not defined";
my $sub_syntax = $self->{_SUB_SYNTAX} || '';
my $currtime = localtime;
my $STRING = undef;
if ( $syntax eq 'ini' ) {
while ( my ($block_name, $key_values) = each %{$self->{_DATA}} ) {
unless ( $sub_syntax eq 'simple-ini' ) {
$STRING .= sprintf("[%s]\n", $block_name);
}
while ( my ($key, $value) = each %{$key_values} ) {
my $values = join (Config::Simple::WRITE_DELIM(), map { Config::Simple::quote_values($_) } #$value);
$STRING .= sprintf("%s=%s\n", $key, $values );
}
$STRING .= "\n";
}
} elsif ( $syntax eq 'http' ) {
while ( my ($key, $value) = each %{$self->{_DATA}} ) {
my $values = join (Config::Simple::WRITE_DELIM(), map { Config::Simple::quote_values($_) } #$value);
$STRING .= sprintf("%s: %s\n", $key, $values);
}
} elsif ( $syntax eq 'simple' ) {
while ( my ($key, $value) = each %{$self->{_DATA}} ) {
my $values = join (Config::Simple::WRITE_DELIM(), map { Config::Simple::quote_values($_) } #$value);
$STRING .= sprintf("%s %s\n", $key, $values);
}
}
$STRING .= "\n";
return $STRING;
}
}
my $cfg = Local::Config::Simple->new(
syntax => 'ini'
) or die Config::Simple->error();
$cfg->param("Program.mode", "ALL");
$cfg->param("Program.strategies", "1,2,3,4,5,6,7,8,9,10");
$cfg->param("Data.name_specie", "Homo sapiens");
$cfg->write("file.ini") or die $cfg->error();
That works and gives the output:
[Data]
name_specie=Homo sapiens
[Program]
mode=ALL
strategies=1,2,3,4,5,6,7,8,9,10
However, it broke several OO ideas, so I find this approach unpleasant. I can do a little bit less work by fixing the original package by redefining the original subroutine. Then the package variables and subroutines still work. Load the original module first then add your redefinitions:
use strict;
use warnings;
use v5.12;
use Config::Simple;
no warnings 'redefine';
package Config::Simple {
# generates a writable string
sub as_string {
my $self = shift;
my $syntax = $self->{_SYNTAX} or die "'_SYNTAX' is not defined";
my $sub_syntax = $self->{_SUB_SYNTAX} || '';
my $currtime = localtime;
my $STRING = undef;
if ( $syntax eq 'ini' ) {
while ( my ($block_name, $key_values) = each %{$self->{_DATA}} ) {
unless ( $sub_syntax eq 'simple-ini' ) {
$STRING .= sprintf("[%s]\n", $block_name);
}
while ( my ($key, $value) = each %{$key_values} ) {
my $values = join (WRITE_DELIM, map { quote_values($_) } #$value);
$STRING .= sprintf("%s=%s\n", $key, $values );
}
$STRING .= "\n";
}
} elsif ( $syntax eq 'http' ) {
while ( my ($key, $value) = each %{$self->{_DATA}} ) {
my $values = join (WRITE_DELIM, map { quote_values($_) } #$value);
$STRING .= sprintf("%s: %s\n", $key, $values);
}
} elsif ( $syntax eq 'simple' ) {
while ( my ($key, $value) = each %{$self->{_DATA}} ) {
my $values = join (WRITE_DELIM, map { quote_values($_) } #$value);
$STRING .= sprintf("%s %s\n", $key, $values);
}
}
$STRING .= "\n";
return $STRING;
}
}
my $cfg = Config::Simple->new(
syntax => 'ini'
) or die Config::Simple->error();
$cfg->param("Program.mode", "ALL");
$cfg->param("Program.strategies", "1,2,3,4,5,6,7,8,9,10");
$cfg->param("Data.name_specie", "Homo sapiens");
$cfg->write("file.ini") or die $cfg->error();
I write quite a bit about this in Effective Perl Programming as a way to deal with legacy code.
As a side note, you asked if there was some method in the module. You could have simply looked at the source to see what was happening and what was available. You would have seen that the header was hard-coded into as_string.

File comparison in Perl - by line or substring

i m trying to compare 2 text files and i got down the following perl script, but for some reason even when i use the /same/ file as a base and filter, it doesnt output anything. I m really new to Perl, so apologies if any of this sounds base.
my $file_base = 'CSP8216.TXT';
my $file_filter = 'CSP8216.TXT';
open my $info_filter, $file_filter or die "Die: Could not open $file_filter: $!";
while(my $line_filter = <$info_filter>)
{
open my $info_base, $file_base or die "Die: Could not open $file_base: $!";
while(my $line_base = <$info_base>)
{
if("$line_filter"=="$line_base")
#if(substr($line_filter, 0, 11)==substr($line_base, 0, 11))
{
print $line_base;
}
}
close $info_bae;
}
close $info_filter;
Could someone point out why this doesnt seem to work?
Use eq to compare strings:
if($line_filter eq $line_base).
Also use use strict to see errors in your program
I would do it a little different
Obviously you probably done want to push the file into an array if they are large.
use strict;
use warnings;
use Data::Dumper;
my $file_base = '1.TXT';
my $file_filter = '2.TXT';
open ( FILTER, "<$file_filter" )
or die "Die: Could not open $file_filter: $!";
open ( BASE, "<$file_base" )
or die "Die: Could not open $file_base: $!";
my #filterArray = <FILTER>;
my #baseArray = <BASE>;
close BASE;
close FILTER;
unless( arrayDiff( \#filterArray , \#baseArray ) )
{
print "Success!";
}
sub arrayDiff {
my $array1 = shift(#_);
my $array2 = shift(#_);
my %array1_hash;
my %array2_hash;
# Create a hash entry for each element in #array1
for my $element ( #{$array1} ) {
$array1_hash{$element} = #{$array1};
}
# Same for #array2: This time, use map instead of a loop
map { $array2_hash{$_} = 1 } #{$array2};
for my $entry ( #{$array2} ) {
if ( not $array1_hash{$entry} ) {
return 1; #Entry in #array2 but not #array1: Differ
}
}
if ( keys %array1_hash != keys %array2_hash ) {
return 1; #Arrays differ
}
else {
return 0; #Arrays contain the same elements
}
}
perl 1156663.pl
Success!

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

GetOption - Perl - Referencing

So I have stumbled upon a little issue when trying to build out a simple "Airport Search Script" in Perl.
my $filename = '/home/student/perl-basic/topic-07/iata_airports.csv';
my $number = '1';
my $matching;
my $latitude;
my $longitude;
my $word = 'false';
GetOptions (
"filename=s" => \$filename,
"number=i" => \$number,
"matching=s" => \$matching,
"latitude=f" => \$latitude,
"longitude=f" => \$longitude,
"word=s" => \$word
);
sub parse_airports {
my $file = shift;
my $csv = Text::CSV->new( { binary => 1, eol => $/ } );
open ( my $fh, "<", $file ), or die "Error opening input file: $!";
my $ra_colnames = $csv->getline ( $fh );
$csv->column_names( #$ra_colnames );
my $ra_airports = $csv->getline_hr_all( $fh );
close ( $fh );
return $ra_airports;
}
sub get_name_matching_airports {
}
my $rah_airports = parse_airports( $filename );
my $rah_airports_found = [];
if ($matching) {
say "Up to $number airports matching $matching in $filename:";
$rah_airports_found = get_name_matching_airports(
airports => $rah_airports,
matching_string => $matching,
word => $word,
);
}
elsif ($latitude && $longitude) {
say "Up to $number airports near [$latitude, $longitude] in $filename:"
}
else {
say "Must have at least --matching, or --latitude and --longitude as arguments";
}
print pp($rah_airports_found);
So where I am struggling is in the "sub get_name_matching_airports"
Because you do not have the file let me explain the file structure.
It is a hash (ALL IATA Airports) with hashes (DETAILS of each airport). There are around 15 keys in each airport hash and one of the keys titles is (NAME). I have opened the file and parsed all the info into a hash ref which is returned at the end of the sub "parse_airports".
In the sub "get_name_matching_airports" I need to find additional airports with similar names based on the argument I passed in, into ($matching).
EXAMPLE: I parse (case-insensitive) "London" as an argument from the command line e.g. ./search_airports2 --matching London. In the sub "get_name_matching_airports" I will need to respond with any airport that has london (case-insensitive) in key(name).
Then push these newly found airports which are similar into the array "rah_airports_found" and in the end print this out.
SO I SOLVED MY PROBLEM WITH THE FOLLOWING CODE:
sub get_name_matching_airports {
my %params = (
airports => undef,
matching_string => undef,
word => undef,
#_
);
my #rah_airports_found;
my $ra_airports = $params{airports};
my $counter = 0;
foreach my $i ( #$ra_airports ) {
if ( $params{word} ) {
if ( $i->{name} eq $params{matching_string} ) {
push #rah_airports_found, $i;
$counter++;
}
}
else {
if ( $i->{name} =~ /$params{matching_string}/i ) {
push #rah_airports_found, $i;
$counter++;
}
if ( defined( $number ) && $counter == $number ) {
return \#rah_airports_found;
}
}
}
return \#rah_airports_found;
}
Example:
for my $Airport_rf (keys %{$rah_airports}) {
if ( $Airport_rf->{NAME} =~ m{\Q$matching\E}xi) {
# do your stuff here
}
}
If you donĀ“t know the exact key of the hashref, you have to match the CLI parameter against all values.

How to distinguish between "0" and NULL in perl?

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.