Parse data from Input file and print results

Question

I have written a script which does parsing to the input file and take out some values from them with respect to the node and print the data accordingly.

Below is my script, and it works as expected:

#!/usr/bin/perl

use strict;
use warnings;

use Time::Local 'timelocal';
use List::Util qw(reduce);
use POSIX qw( strftime );

my $i = 0;

print "*"x20; print "\n";

while(<DATA>){
    chomp;
    
    next unless ($_);
    
    my @data = split / /, $_;
    
    $i++;
    my ($node, $time, $date, $time1, $unit);
    my %hash;
    if (scalar @data == 3){
        if( $data[0] =~ /FileName=([^_]+(?=_))_(\S+)_file.csv:(\S+),/gm ){
            ($node, $time, $unit) = ($2, $1, $3);
            if( $time =~ /[a-zA-Z](\d+).(\d+)/gm ){
                $date = $1; $time1 = $2;
            }
        }
        print "Node_$i:$node\n";
        my $datetime = $date.$time1;
        my ($second,$minute,$hour,$day,$month,$year);
        my $unix_time;

       if ($datetime =~ /(....)(..)(..)(..)(..)/){
            ($second,$minute,$hour,$day,$month,$year) = (0, $5, $4, $3, $2, $1);
            $unix_time = timelocal($second,$minute,$hour,$day,$month-1,$year);
        }
       my @vol = split /,/, $data[2];
       foreach my $element (@vol){
            $hash{$unix_time} = $element;
            $unix_time += 6;
        }

        my $key = reduce { $hash{$a} <= $hash{$b} ? $a : $b } keys %hash;
        my $val = $hash{$key};

        my $dt = strftime("%Y-%m-%d %H:%M:%S", localtime($key));

        print "Text_$i:First occured on $dt on the Unit:$unit and the value is $val\n";
    }
}
print "*"x20; print "\n";
print "TotalCount=$i\n";

__DATA__
Node=01:FileName=A20200804.1815+0530-1816+0530_Network=NODE01_file.csv:Unit=R1,Meter=1 Vol 19,12,17,20,23,15,16,11,13,17
Node=02:FileName=A20200804.1830+0530-1831+0530_Network=NODE02_file.csv:Unit=R5,Meter=3 Vol 12,13,15,16,10,15,15,13,14,11

So, here we have 2 lines of data in input file which is giving output something like below:

********************
Node_1:Network=NODE01
Text_1:First occured on 2020-08-04 18:15:42 on the Unit:Unit=R1 and the value is 11
Node_2:Network=NODE02
Text_2:First occured on 2020-08-04 18:30:24 on the Unit:Unit=R5 and the value is 10
********************
TotalCount=2

So, logic in parser is each line data belongs to each node (node will be unique in the input file). Here you can see the Volume data which is generated based on the time. For example, NODE01 volume data it shows for 18:15 to 18:16 (10 volume values, that means each value is been generated in 6secs interval and its fixed through out all the node volume data).

From the list of volumes I should take the least number and its respective time with seconds. I am able to fetch as per the logic explained.

Here I need experts feedback on regex (which I am using) also there are couple of if conditions which looks really odd to me.

Is there any possiblity to simply the script?

Answer 1

The code looks fine and it is working for the given input data. However, it can be difficult to assess which inputs will be regarded as valid, and how it will behave in case of unexpected input. One approach to uncertainty about code (will it work?) is to let it pass through a testing framework. This requires splitting your code into smaller units that can easily be tested.

At the end of this post, I will present an example of how the code can be adapted to a testing framework, but before that there are some minor issues I would like to mention.

Unecessary g and m flag

Consider this line:

if( $data[0] =~ /FileName=([^_]+(?=_))_(\S+)_file.csv:(\S+),/gm ){

Since the code is only processing a single line at a time and there is only one node on each line, global matching is not necessary. Also the m is not needed. It allows ^ and $ to match internal the start and end of internal lines for a multiline string.

Unnecessary use of lookahead regex

Consider this line:

if( $data[0] =~ /FileName=([^_]+(?=_))_(\S+)_file.csv:(\S+),/gm ){

First, as commented above we can remove the g and m flags. Then

/[^_]+(?=_)_/ 

is simpler written as

/[^_]+_/

Make code easier to read

This code:

($node, $time, $unit) = ($2, $1, $3);

is easier to read (my opinion) if written as:

($time, $node, $unit) = ($1, $2, $3);

such that the capture variables are sorted in numerical order. Similar for this line:

my ($second,$minute,$hour,$day,$month,$year) = (0, $5, $4, $3, $2, $1);

it can be written as:

my ($year, $month, $day, $hour, $minute, $second ) = ( $1, $2, $3, $4, $5, 0);

Shebang

See this blog for more information. I usually use #!/usr/bin/env perl instead of #!/usr/bin/perl. Most systems have /usr/bin/env, and it allows your script to run if you e.g.have multiple perls on your system. For example if you are using perlbrew.

say vs print

I prefer to use say instead of print to avoid typing a final newline character for print statements. The say function was introduced in perl 5.10, and is mad available by adding use v5.10 or use use feature qw(say) to the top of your script.

Declare variable as close to their definition as possible

By declaring variable in the same scope as they are used and as close the their first usage point as possible will help a reader to quickly reason about the code, which will help producing correct code. For example, in this code

my ($second,$minute,$hour,$day,$month,$year);
if ($datetime =~ /(....)(..)(..)(..)(..)/){
    ($second,$minute,$hour,$day,$month,$year) = (0, $5, $4, $3, $2, $1);

the variables are only used within the if clause, so we can write it as:

if ($datetime =~ /(....)(..)(..)(..)(..)/){
    my ($second,$minute,$hour,$day,$month,$year) = (0, $5, $4, $3, $2, $1);

Easier parsing of dates using Time::Piece

In the program below, I show how you can use Time::Piece instead of timelocal to simplify the parsing of dates.

Example code with unit tests

Main script p.pl:

 #! /usr/bin/env perl

package Main;
use feature qw(say);
use strict;
use warnings;

use Carp;
use Data::Dumper qw(Dumper);

# Written as a modulino: See Chapter 17 in "Mastering Perl". Executes main() if
#   run as script, otherwise, if the file is imported from the test scripts,
#   main() is not run.
main() unless caller;

sub main {
    my $self = Main->new();
    $self->run_program();
}

# ---------------------------------------------
# Methods and subroutines in alphabetical order
# ---------------------------------------------

sub bad_arguments { die "Bad arguments\n" }

sub init_process_line {
    my ( $self ) = @_;

    $self->{lineno} = 1;
}

sub new {
    my ( $class, %args ) = @_;

    my $self = bless \%args, $class;
}

sub process_line {
    my ($self, $line) = @_;

    my $proc = ProcessLine->new( $line, $self->{lineno} );
    $self->{lineno}++;
    return $proc->process();
}

sub read_data {
    my ( $self ) = @_;

    # TODO: Read the data from file instead!
    my $data = [
'Node=01:FileName=A20200804.1815+0530-1816+0530_Network=NODE01_file.csv:Unit=R1,Meter=1 Vol 19,12,17,20,23,15,16,11,13,17',
'Node=02:FileName=A20200804.1830+0530-1831+0530_Network=NODE02_file.csv:Unit=R5,Meter=3 Vol 12,13,15,16,10,15,15,13,14,11'
   ];

    $self->{data} = $data;
}

sub run_program {
    my ( $self ) = @_;
    $self->read_data();
    $self->init_process_line();
    for my $line ( @{$self->{data}} ) {
        my ($node, $dt, $unit, $val) = $self->process_line($line);
        my $res = {
            node => $node,
            dt   => $dt,
            unit => $unit,
            val  => $val,
        };
        # TODO: write the data to STDOUT or to file in correct format
        print Dumper($res);
    }
}

package ProcessLine;
use feature qw(say);
use strict;
use warnings;

use Carp;
use POSIX qw( strftime );
use Time::Piece;

sub convert_date_to_epoch {
    my ( $self,  $date ) = @_;

    my $unix_time = Time::Piece->strptime( $date, "%Y%m%d.%H%M%z" )->epoch();
    return $unix_time;
}

# INPUT:
#  - $time_piece : initialized Time::Piece object
#
#
sub convert_epoch_to_date {
    my ( $self,  $time_piece ) = @_;

    my $dt = $time_piece->strftime("%Y-%m-%d %H:%M:%S");

    return $dt;
}

sub get_volumes {
    my ( $self,  $data ) = @_;

    $self->parse_error("No volumes") if !defined $data;
    my @vols = split /,/, $data;
    $self->parse_error("No volumes") if @vols == 0;
    for my $vol ( @vols ) {
        if ( $vol !~ /^\d+$/ ) {
            $self->parse_error("Volume not positive integer");
        }
    }
    return \@vols;
}

# INPUT:
#  - $volumes : list of volumes (integers).
#
# RETURNS: - index of smallest item (if there are multiple minimal, the index of
#  the first is returned.
#
# ASSUMES:
#  - Length of list >= 1
#  - Each item is a positive integer.
#  - NOTE: The items do not need to be unique.
#
sub find_min_vol {
    my ( $self, $volumes) = @_;

    my $min = $volumes->[0];
    my $idx = 0;
    for my $i (1..$#$volumes) {
        my $value = $volumes->[$i];
        if ( $value < $min) {
            $min = $value;
            $idx = $i;
        }
    }
    return $idx;
}

sub new {
    my ( $class, $line, $lineno ) = @_;

    my $self = bless {line => $line, lineno => $lineno}, $class;
}

sub parse_error {
    my ( $self, $msg ) = @_;

    croak ( sprintf( "Line %d: %s : '%s'\n", $self->{lineno}, $msg,
                 $self->{line} // "[undef]" ) );
}

sub process {
    my ($self) = @_;

    my $line = $self->{line};
    chomp $line;
    $self->parse_error("Empty line") if !$line;

    my ($field1, $field3) = $self->split_line( $line );
    my $date = $field1->get_date();
    my $node = $field1->get_node();
    my $unit = $field1->get_unit();
    my $unix_time = $self->convert_date_to_epoch( $date );
    my $volumes = $self->get_volumes( $field3 );
    my $idx = $self->find_min_vol($volumes);
    my $vol = $volumes->[$idx];
    my $vol_epoch = $unix_time + $idx*6;
    my $time_piece = localtime($vol_epoch);  # convert to local time zone
    my $dt = $self->convert_epoch_to_date( $time_piece );
    return ($node, $dt, $unit, $vol);
}

# INPUT:
#  - $line: defined string
#
sub split_line {
    my ( $self, $line ) = @_;

    my @data = split / /, $line;
    my $N = scalar @data;
    $self->parse_error( "Expected 3 fields (space-separated). Got $N fields.") if $N !=3;
    return (Field0->new($self, $data[0]), $data[2]);
}

package Field0;
use feature qw(say);
use strict;
use warnings;

sub get_date {
    my ( $self ) = @_;
    my $data = $self->{data};
    my $date;
    if( $data =~ s/FileName=([^_]+)_// ) {
        my $time = $1;
        if( $time =~ /[a-zA-Z](\d{8}\.\d{4}[+-]\d{4})-\d{4}[+-]/ ) {
            $date = $1;
        }
        else {
            $self->{parent}->parse_error("Could not parse time info");
        }
    }
    else {
        $self->{parent}->parse_error("Could not parse time info");
    }
    $self->{data} = $data;
    return $date;
}

sub get_node {
    my ( $self ) = @_;
    my $data = $self->{data};
    my $node;
    if( $data =~ s/(\S+)_// ) {
        $node = $1;
    }
    else {
        $self->{parent}->parse_error("Could not parse node info");
    }
    $self->{data} = $data;
    return $node;
}

sub get_unit {
    my ( $self ) = @_;
    my $data = $self->{data};
    my $unit;
    if( $data =~ s/file\.csv:(\S+),// ) {
        $unit = $1;
    }
    else {
        $self->{parent}->parse_error("Could not parse unit info");
    }
    $self->{data} = $data;
    return $unit;
}

sub new {
    my ( $class, $parent, $data ) = @_;
    return bless {parent => $parent, data => $data}, $class;
}

Unit test script t/main.t:

use strict;
use warnings;
use Test2::Tools::Basic qw(diag done_testing note ok);
use Test2::Tools::Compare qw(is like);
use Test2::Tools::Exception qw(dies lives);
use Test2::Tools::Subtest qw(subtest_buffered);
use lib '.';
require "p.pl";

{
    subtest_buffered "split line" => \&split_line;
    subtest_buffered "get_date" => \&get_date;
    subtest_buffered "get_node" => \&get_node;
    # TODO: Complete the test suite..
    done_testing;
}

sub get_date {
    my $proc = ProcessLine->new( "", 1 );
    my $fld = Field0->new($proc, "Node=01:FileName=A20200804.1815+0530-1816+0530_N");
    is($fld->get_date(), '20200804.1815+0530', 'correct');
    $fld = Field0->new($proc, "ileName=A20200804.1815+0530-1816+0530_N");
    like(dies { $fld->get_date() }, qr/Could not parse/, "bad input");
    $fld = Field0->new($proc, "FileName=A20200804.1815-1816+0530_N");
    like(dies { $fld->get_date() }, qr/Could not parse/, "bad input2");
}

sub get_node {
    my $proc = ProcessLine->new( "", 1 );
    my $fld = Field0->new($proc, "Node=01:FileName=A20200804.1815+0530-1816+0530_N");
    # TODO: complete this sub test..
}

sub split_line {
    my $proc = ProcessLine->new( "", 1 );
    like(dies { $proc->split_line( "" ) }, qr/Got 0 fields/, "zero fields");
    like(dies { $proc->split_line( " " ) }, qr/Got 0 fields/, "zero fields");
    like(dies { $proc->split_line( "1" ) }, qr/Got 1 fields/, "one field");
    like(dies { $proc->split_line( "1 2" ) }, qr/Got 2 fields/, "two fields");
    my ($f1, $f3);
    ok(lives { ($f1, $f3) = $proc->split_line( "1 2 3" ) }, "three fields");
    is($f1->{data}, "1", "correct value");
    is($f3, "3", "correct value");
}