Re^2: Best practices - if any?

[AriSoft]

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

[mirod]

I am not going to get into the details of this, but just a couple of quick stylistic comments:

• instead of including anonymous subs in your hashes, why don't you name them? Instead of row => sub  { # complex code here that ASAIK creates a record }, write row => \&create_record, and then define create_record a little further. This way you're giving a name to that sub, and it becomes easier to see the data structure, without the big, often irrelevant, blob of code right in there.
• $$flight{Reg}; can be written $flight->{Reg};, which is especially handy when writing $cols->[0]</<c> instead of <c>@{$cols}[0]
• the commented-out code does not belong in there, if you have to remove code just do it, the source-control system will keep the old version.