Lets test this theory. Here is one authentic sub from my project. Why should I break it pieces and how this helps to keep it with other subs in the same file? I still prefer to keep this in a separate file like a module.
sub parser
{
my %arrivals; #Arrivals search hash
my $arrstamp = time; #Valid arrival info stamp >= $ArrStamp
my @dates = (
datestr($arrstamp-30*60), #0
datestr($arrstamp-24*3600), #1
datestr($arrstamp), #2
datestr($arrstamp+24*3600) #3
);
$skiptime = timestr($arrstamp-6*3600);
if ($dates[0] eq $dates[2])
{
$prevdate = $dates[3];
$nextdate = $dates[2];
}
else
{
$prevdate = $dates[2];
$nextdate = $dates[1];
}
# 0 1 2 3 4 5
+ 6 7
my @depart_hdr = ('sdt','fltnr','mfltnr','acreg','actype','handl',
+'route 1-4','calls 1-4',
'park (park_prv)','gate (gate_prv)','prt','est
+','ablk','act');
# 8 9 10 11
+ 12 13
my @depart_reqs =
(
{
id => 2, # id for headers table
hdr => sub
{
my ( undef, undef, $cols, undef ) = @_;
die "Unsupported header format in departures." unless
+@{$cols} ~~ @depart_hdr;
}
},
{
id => 3, # id for data table
row => sub
{
my ( undef, undef, $cols, undef ) = @_;
die "Unsupported row format in departures." unless sca
+lar @{$cols} == 14;
my $reg = scan(@{$cols}[3], '^\w{1,6}');
my $fln = scan(@{$cols}[1], '^\w{1,6}');
if ($fln and $reg and @{$cols}[2] eq '' #codeshare len
+to
and @{$cols}[0] =~ /^(\d\d):(\d\d) (\d\d)-(\d\d)-(\d\d
+\d\d)$/o)
{
my $sdt = "$5-$4-$3 $1:$2";
my $key = "$fln.$5$4$3$1$2.$reg";
my $prt = scan(@{$cols}[10], '^(\w|\s){1,11}');
my $time = $sdt;
#if ($prt eq "Delayed" or $prt eq "Cancelled")
#{
# $time = '';
#}
#els
if (my $est = @{$cols}[13] || @{$cols}[12] || @{$c
+ols}[11])
{
$time = timedate($est);
$prt ||= 'Estimated';
}
my %record =
(
Std => $sdt,
Flight => $fln,
Reg => $reg,
Type => scan(@{$cols}[4], '^\w{1,3}'),
Dest => scan(@{$cols}[6], '^\w{1,3}'),
Stand => scan(@{$cols}[8],'^\w{1,3}'),
Stand2 => scan(@{$cols}[8], '\(\w{1,3}\)'),
Time => $time,
Prt => $prt,
Key => $key,
Stamp => time
);
#list $cols;
#hash (\%record);
logger($key, \%record);
}
}
}
);
# 0 1 2 3 4 5
+ 6 7
my @arrival_hdr = ('sdt','fltnr','mfltnr','acreg','actype','handl'
+,'route 1-4','park (park_prv)',
'prt','est','appr','act','ablk','blt area','bel
+t','blt ind');
# 8 9 10 11 12 13 14
+ 15
my @arrival_reqs =
(
{
id => 2, # id for headers table
hdr => sub
{
my ( undef, undef, $cols, undef ) = @_;
die "Unsupported header format in arrivals." unless @{
+$cols} ~~ @arrival_hdr;
},
},
{
id => 3, # id for data table
row => sub
{
my ( undef, undef, $cols, undef ) = @_;
die "Unsupported row format in arrivals." unless scala
+r @{$cols} == 16;
my $reg = scan(@{$cols}[3], '^\w{1,6}');
if ($reg and @{$cols}[0] =~ /^(\d\d):(\d\d) (\d\d)-(\d
+\d)-(\d\d\d\d)$/o)
{
unless ( exists $arrivals{$reg}
and $arrivals{$reg}{aStamp} >= $arrstamp) #no dupl
+icate updates!
{
my $time = "$5-$4-$3 $1:$2";
my $prt = scan(@{$cols}[8], '^(\w|\s){1,11}');
if (my $est = @{$cols}[12] || @{$cols}[11] ||
+@{$cols}[10] || @{$cols}[9])
{
$time = timedate($est);
$prt ||= 'Estimated';
}
my %record =
(
aStand => scan(@{$cols}[7], '^\w{1,3}'),
aStand2 => scan(@{$cols}[7], '\(\w{1,3}\)'
+),
aTime => $time,
aPrt => $prt,
aStamp => time
);
#list $cols;
#hash (\%record);
$arrivals{$reg} = { %record };
#say "Take Arrival $reg @{$cols}[0] $arrivals{
+$reg}{aTime}";
}
else
{
#say "Skip Arrival $reg @{$cols}[0] $arrivals{
+$reg}{aTime}";
}
}
else
{
#list $cols;<>;
}
}
}
);
# 0 1 2 3 4 5 6
+
my @towlist_hdr = ('AC REG','FROM','TO','AFTER','UNTIL','ARR','LAT
+EST ARRTIME',
'ARRTIME TYPE','DEP','LATEST DEPTIME','DEPTIME TYP
+E','AGENT');
# 7 8 9 10
+ 11
my @tow_reqs =
(
{
id => 1, # id for tow table
hdr => sub
{
my ( undef, undef, $cols, undef ) = @_;
die "Unsupported header format in towlist." unless @{$
+cols} ~~ @towlist_hdr;
},
row => sub
{
my ( undef, undef, $cols, undef ) = @_;
die "Unsupported row format in towlist." unless scalar
+ @{$cols} == 12;
if ( @{$cols}[3] =~ /^(\d\d):(\d\d) (\d\d)-(\d\d)-(\d\
+d\d\d)$/o
and @{$cols}[7] eq 'chocks'
and my $reg = scan(@{$cols}[0], '^\w{1,6}') )
{
my $time = "$5-$4-$3 $1:$2";
unless (exists $arrivals{$reg}
and ( $arrivals{$reg}{aTime} le $time or $arrivals
+{$reg}{aStamp} >= $arrstamp ) )
{
my %record =
(
aStand => scan(@{$cols}[1], '^\w{1,3}'),
aStand2 => '',
aTime => $time,
aPrt => 'Chocks',
aStamp => time
);
$arrivals{$reg} = { %record };
#say "Take Tow $reg @{$cols}[0] $time";
}
else
{
#say "Skip Tow $reg @{$cols}[0] $time";
}
}
}
}
);
#-------------- MAIN DATA PARSING routine starts from here -------
+-------#
# scan arrivals
parse_http(ARRIVALS,\@arrival_reqs);
# scan towlist
parse_http(TOWLIST,\@tow_reqs);
# scan departures
parse_http(DEPARTURES,\@depart_reqs);
#Lock database when sorting
$datalock->busy;
#Delete outdated data
while (my ($key, $flight) = each (%departs))
{
if ($arrstamp - $$flight{Stamp} > KEEPHOURS)
{
lock $flight;
say "Delete ",$key if DEBUG;
delete $departs{$key};
#need to delete file too!
}
}
#Sort flights by departure time
@order = sort { $$a{Time} cmp $$b{Time} } values %departs;
#Insert arrival data to sorted departures
foreach my $flight ( @order )
{
my $reg = $$flight{Reg};
if (exists $arrivals{$reg}
and $arrivals{$reg}{aStamp} >= $arrstamp
and $$flight{Prt} ne "Cancelled"
#and $$flight{Prt} eq "Delayed" ||
and $arrivals{$reg}{aTime} lt $$flight{Time})
{
#say "Found arrival for $reg";
logger($flight, $arrivals{$reg});
delete $arrivals{$reg}; #to this flight only
}
}
#Invalidate old data
$validstamp = $arrstamp;
#Free locking
$datalock->free;
#Invalidates old data after 5 min if no updates
$validstamp = $arrstamp if time - $validstamp > 5*60;
say "Orphan arrivals ",scalar %arrivals if DEBUG;
}
