Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Re^2: Best practices - if any?

by AriSoft (Sexton)
on Feb 21, 2010 at 19:24 UTC ( #824522=note: print w/ replies, xml ) Need Help??


in reply to Re: Best practices - if any?
in thread Best practices - if any?

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


Comment on Re^2: Best practices - if any?
Download Code
Re^3: Best practices - if any?
by mirod (Canon) on Feb 22, 2010 at 10:18 UTC

    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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://824522]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (11)
As of 2014-09-01 13:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (10 votes), past polls