Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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

In reply to Re^2: Best practices - if any? by AriSoft
in thread Best practices - if any? by AriSoft

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (8)
    As of 2014-10-23 09:07 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (125 votes), past polls