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 perl
s 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");
}
A
&B
. The input shown is fromA
and that need to captured in a file and send to SystemB
. FromB
script should read the file and create a Alarm for a nodes which are already available inB
. So basically this script will act as an parser to read a input file, and help to generate an alarm. \$\endgroup\$