Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Coding for maintainability

by monsterzero (Monk)
on Feb 16, 2006 at 17:48 UTC ( #530713=perlquestion: print w/ replies, xml ) Need Help??
monsterzero has asked for the wisdom of the Perl Monks concerning the following question:

Hi All,

I have a perl script that I maintain and need some advice as how to improve the code to make it easier to maintain. The code is as follows:

#!/app/bin/perl use DBI; use Data::Dumper; use DateTime; use DateTime::Span; use DateTime::Format::Strptime; use warnings; use strict; use Mail::Mailer; use Text::Table; use Getopt::Long; use vars qw(%convert_name %people %family_list $family $family_release @by_fa +mily $start $end $normal $dt_set); my @family = qw(TOTAL NX1 NX2 NX3 NX4 TC_ENG TC_COM SE16 SE17 SE18 W +EBTOOLS other); my $parsed_date = DateTime::Format::Strptime->new( pattern => '%m-%d-% +Y', ); my $success = GetOptions( 'sd=s' => \$start, 'ed=s' => \$end, 'N' => \$normal ); if ( $start && $end ) { $dt_set = DateTime::Span->from_datetimes( start => $parsed_date->parse_datetime($start), before => $parsed_date->parse_datetime($end), ); } else { my $this_month = DateTime->today->truncate( to => 'month' ); $dt_set = DateTime::Span->from_datetimes( start => $this_month->clone->subtract( months => 1 ), before => $this_month, ); } #my $dbh = DBI->connect( 'DBI:Ingres:fsing0::prod_db', '', '' )or die" +Cannot connect"; my $dbh = DBI->connect( 'DBI:Ingres:report::ustac_db', '', '' ); my $statement = "SELECT tac_employee_id, emp_first_name, emp_last_name FROM tac_employee_table WHERE emp_mgr_id = 'spain' and emp_fla +g = 'a' and location='CYPRESS'"; my $sth = $dbh->prepare("$statement"); $sth->execute; while ( my @row = $sth->fetchrow_array ) { $row[1] =~ s/(\w+)/\u\L$1/g; $row[2] =~ s/(\w+)/\u\L$1/g; $convert_name{ $row[0] } = "$row[1] $row[2]"; } my $format_date = DateTime::Format::Strptime->new( pattern => '%m-%d-%Y %H:%M:%S', ); my $select_statement = "select cm.family, cm.family_release from ir_ta +ble ir, call_master_table cm"; my $where_statement = " where ir.ir_id = cm.call_master_id and "; $where_statement .= " ir.closed_date is not NULL and "; $where_statement .= "(ir.closed_date >= '" . $format_date->format_date +time( $dt_set->min ) . "' and"; $where_statement .= " ir.closed_date < '" . $format_date->format_datetime( $dt_set->max ) . "' ) and cm.user_id = ? "; my $statement1 = $select_statement . $where_statement; $sth = $dbh->prepare($statement1); my %by_family = (); foreach my $user ( sort keys %convert_name ) { #print "Processing user $user \n"; $sth->execute($user); $sth->bind_columns( \$family, \$family_release ); while ( $sth->fetch ) { $family = trim($family); ( undef, $family_release ) = $family_release =~ /(P|V)(\d+)*/; #print "$family\n"; SWITCH: for ($family) { /UNIGRAPHICS_NX/ && do { if ( $family_release eq "1" ) { $people{$user}{'NX1'}++; $people{$user}{TOTAL}++; } elsif ( $family_release eq "2" ) { $people{$user}{'NX2'}++; $people{$user}{TOTAL}++; } else { $people{$user}{'other'}++; $people{$user}{TOTAL}++; } last SWITCH; }; /\bNX\b/ && do { if ( $family_release eq "3" ) { $people{$user}{'NX3'}++; $people{$user}{TOTAL}++; } elsif ( $family_release eq "4" ) { $people{$user}{'NX4'}++; $people{$user}{TOTAL}++; } last SWITCH; }; /SOLID_EDGE/ && do { if ( $family_release eq "18" ) { $people{$user}{'SE18'}++; $people{$user}{TOTAL}++; } elsif ( $family_release eq "16" ) { $people{$user}{'SE16'}++; $people{$user}{TOTAL}++; } elsif ( $family_release eq "17" ) { $people{$user}{'SE17'}++; $people{$user}{TOTAL}++; } else { $people{$user}{'other'}++; $people{$user}{TOTAL}++; } last SWITCH; }; /WEBTOOLS/ && do { if ( defined $people{$user}{$family} ) { $people{$user}{$family}++; $people{$user}{TOTAL}++; } else { $people{$user}{$family} = 1; $people{$user}{TOTAL}++; } last SWITCH; }; /TC_ENGR-IMAN/ && do { if ( defined $people{$user}{'TC_ENG'} ) { $people{$user}{'TC_ENG'}++; $people{$user}{TOTAL}++; } else { $people{$user}{'TC_ENG'} = 1; $people{$user}{TOTAL}++; } last SWITCH; }; /TC_COMMUNITY/ && do { if ( defined $people{$user}{'TC_COM'} ) { $people{$user}{'TC_COM'}++; $people{$user}{TOTAL}++; } else { $people{$user}{'TC_COM'} = 1; $people{$user}{TOTAL}++; } last SWITCH; }; # DEFAULT if ( defined $people{$user}{other} ) { $people{$user}{other}++; $people{$user}{TOTAL}++; } else { $people{$user}{other} = 1; $people{$user}{TOTAL}++; } } # end for } #end while } $dbh->disconnect; #print Dumper( \%people ); while ( my ( $item, $record ) = each %people ) { no warnings 'uninitialized'; $by_family{$_} += $record->{$_} for @family; } my %percent; $percent{$_} = 100 * $by_family{$_} / $by_family{TOTAL} for @family; $_ = sprintf '%.0f', $_ for values %percent; while ( my ( $item, $record ) = each %people ) { $record->{'TOTAL'} = '0' unless ( defined $record->{'TOTAL'} ); } my $tb = Text::Table->new( { is_sep => 1, title => '|' }, { title => 'Name', align => 'left', align_title => 'center' }, { is_sep => 1, title => '|' }, { title => 'Total', align => 'center', align_title => 'center' }, { is_sep => 1, title => ' | ' }, @family[ 1 .. $#family ], { is_sep => 1, title => ' |' }, ); $tb->add( " $convert_name{$_} ", @{ $people{$_} }{@family} ) for sort +keys %convert_name; $tb->add( ' Total: ', @by_family{@family} ); $tb->add( ' Percent Total: ', '100.0', @percent{ @family[ 1 .. $#family ] } ); my $curr_row = 0; my $title1 = "SYSTEMS CLOSED CALLS BY FAMILY"; my $title2; $title2 = ( $dt_set->min->strftime("%D") ); $title2 .= (" through "); $title2 .= ( $dt_set->max->strftime("%D") ); my $num_spaces = ( $tb->width - length($title1) ) / 2; my $report = sprintf( ' ' x $num_spaces ); $report .= sprintf($title1); $report .= sprintf("\n"); $num_spaces = ( $tb->width - length($title2) ) / 2; $report .= sprintf( ' ' x $num_spaces ); $report .= sprintf($title2); $report .= sprintf("\n"); $report .= $tb->rule( '-', '+' ); $report .= $tb->title; $report .= $tb->rule( '-', '+' ); do { $report .= $tb->body($curr_row); $curr_row++; } until ( $curr_row >= ( $tb->body_height - 2 ) ); $report .= $tb->rule( '-', '+' ); $report .= $tb->body( $tb->body_height - 2 ); $report .= $tb->rule( '=', '+' ); $report .= $tb->body( $tb->body_height - 1 ); $report .= $tb->rule( '-', '+' ); #print $report; mail_report($report, $title2); sub trim { my @out = @_; for (@out) { s/^\s+//; s/\s+$//; } return wantarray ? @out : $out[0]; } sub mail_report { my ($message, $title2) = @_; my $mailer = new Mail::Mailer 'smtp', Server => 'cysmtp.ugs.com'; #my $mailer = new Mail::Mailer qw(sendmail); my %headers = ( 'To' => 'you@example.com', 'Cc' => 'me@example.com', 'Reply-To' => 'you@example.com', 'Subject' => "System Closed Calls By Family (from fsing0) - $ +title2" ); $mailer->open( \%headers ); print $mailer $message; $mailer->close; return; }
The issue is that wehenever I need to add a product I need to edit the script to add a new product. This involves adding/changing the switch statement. This is where I sometimes make a mistake and I end up adding to the wrong product or make a typo and the totals don't add up. I was looking for a way where I can add/delete/change a product without messing with the switch statement.

I hope this is clear.

Thanks :-)

Comment on Coding for maintainability
Download Code
Re: Coding for maintainability
by xorl (Deacon) on Feb 16, 2006 at 18:05 UTC
    Keep the products and the prices in either an array or hash. Then loop thru it, checking if the product matches what has been selected. If it does match then you add to the total and our email body. Bascially replace the entire switch with somethign like this untested code:
    my %products; $products{"Product1"}{"price"}=100; $products{"Product1"}{"description"}="A worthless widget"; foreach my $product (keys %products) { if ($product == $whatevertheuserselected) { # do something cool here $total =+ $products{$product}{"price"}; $email_body .= $products{$product}{"description"}; } }
Re: Coding for maintainability
by dragonchild (Archbishop) on Feb 16, 2006 at 18:07 UTC
    You need a modified dispatch table. A dispatch table is where you have (generally) a hash of names where the values are references to subroutines.
    my %dispatch = ( foo => sub { print "foo\n"; }, bar => \&bar, ); chomp( my $input = <> ); unless ( exists $dispatch{ $input } ) { die "I don't know what to do with '$input'\n"; } $dispatch{$input}->(); sub bar { print "bar\n"; }
    The modification needed is that you aren't matching on a simple string. There's a few ways to improve this. One is to pass $family to every function and let them determine if they want to handle it. Then, the function returns either true (I handled it) or false (I don't deal with this value). Errors would be propagated with die and caught with an eval-block.

    Then, whenever you add something, you're working with a much smaller piece of the puzzle because the engine and the parts are separated.


    My criteria for good software:
    1. Does it work?
    2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
        Hello, Currently I have used the code provided by jdporter instead of my switch statement. However, I will now look at the dispatch table option that you have recommended and see if that will make this script easier to maintain. Thanks for your reply
Re: Coding for maintainability
by jdporter (Canon) on Feb 16, 2006 at 18:23 UTC

    One thing I would definitely change is the following current practice:

    if ( defined $people{$user}{'TC_ENG'} ) { $people{$user}{'TC_ENG'}++; $people{$user}{TOTAL}++; } else { $people{$user}{'TC_ENG'} = 1; $people{$user}{TOTAL}++; }

    You should know that incrementing a variable containing an undefined value first treats the undef like a zero, which means it ends up with the value 1. And that doing this to a hash key which doesn't even exist yet makes it exist first. So the above can be replaced by

    $people{$user}{'TC_ENG'}++; $people{$user}{TOTAL}++;
    We're building the house of the future together.
Re: Coding for maintainability
by jdporter (Canon) on Feb 16, 2006 at 18:28 UTC

    Personally, I don't like how you're setting $where_statement, with all those additional appends. I'd prefer to use a HERE doc for multi-line chunks of embedded source code, e.g.

    my $dt_min = $format_date->format_datetime( $dt_set->min ); my $dt_max = $format_date->format_datetime( $dt_set->max ); my $where_statement = <<EOF; where ir.ir_id = cm.call_master_id and ir.closed_date is not NULL and (ir.closed_date >= '$dt_min' and ir.closed_date < '$dt_max' ) and cm.user_id = ? EOF

    JMHO, of course.

    We're building the house of the future together.
Re: Coding for maintainability
by merlyn (Sage) on Feb 16, 2006 at 19:18 UTC
    The first thing I'd do to make that more maintainable is refactor it all into a series of well-named minimized-coupling subroutines, no longer than 20-30 lines each, and ideally about 10 lines each. That'd also remove about 90% of the global variables, which are generally also a sign of fragile code.

    The second thing I'd do is take that middle switch out of there, and capture the regularities with code, and the irregularites with data. I bet you wrote a lot of it with cut and paste, and that should always be a clue.

    Let me repeat. Cut and paste is generally a clue that you're doing something wrong.

    On a longer-term basis, factoring out some of that code for re-use might be useful, which would also make testing easier. But unless you're also doing some similar tasks later, that might be an expense with no payback.

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

      Let me repeat. Cut and paste is generally a clue that you're doing something wrong
      or writing a throwaway
Re: Coding for maintainability
by trammell (Priest) on Feb 16, 2006 at 19:45 UTC
    I suppose this is a matter of style, but I find a few succinct comments add greatly to the maintainability of my code.
Re: Coding for maintainability
by jdporter (Canon) on Feb 16, 2006 at 19:57 UTC

    Just for fun, I converted your monster switch into a data-driven function. The data are "rules"; the function performs a generic matching operation on those rules. For compactness of representation, I've written the rule data as one specially formatted text block, which means there's a parsing function as well.

    { my @ruleset; sub define_rules { my $rules = shift; for my $rp ( split /\n\n/, $rules ) { my @rules = grep !/^#/, split /\n/, $rp; s/#.*// for @rules; s/^\s+// for @rules; s/\s+$// for @rules; my $fam_pat = shift @rules; my %rules = map { my( $when ) = $_->[0] =~ /(.*):/; # will be undef if n +o colon defined $when or $when = ''; ( $when => $_->[1] ) } map { /(.*)\bkey\s*=\s*(.*)/ ? [ $1, $2 ] : () } @rules; push @ruleset, [ $fam_pat, \%rules, ]; } } # $key = get_key_by_rules( $family, $family_release ); # if it matches a rule but the rule doesn't specify a key to retur +n, # this function returns its first argument (i.e. $family). # if no match occurs, it returns undef; but your ruleset should # probably have a catch-all condition at the end so this never hap +pens. sub get_key_by_rules { my( $major, $minor ) = @_; defined $minor or $minor = ''; for my $ruleset ( @ruleset ) { my( $maj_pat, $rules_hr, $default ) = @$ruleset; if ( $major =~ /$maj_pat/ ) { if ( exists $rules_hr->{$minor} ) { my $ret = $rules_hr->{$minor}; return $ret gt '' ? $ret : $major; } elsif ( exists $rules_hr->{''} ) { my $ret = $rules_hr->{''}; return $ret gt '' ? $ret : $major; } else { return(); } } } return(); } }
    So you'd call define_rules first, passing it the text string defining the rules in the compact notation:
    define_rules( <<'EOF' ); # careful - all whitespace is significant in this format. # use whole-line comments if you need spacers. UNIGRAPHICS_NX 1: key = NX1 2: key = NX2 key = other \bNX\b 3: key = NX3 4: key = NX4 SOLID_EDGE 18: key = SE18 16: key = SE16 17: key = SE17 key = other WEBTOOLS key = # use the default key, which is $family TC_ENGR-IMAN key = TC_ENG TC_COMMUNITY key = TC_COM # default. Unfortunately, this "comment" isn't optional. :-( key = other EOF
    Then you'd call it like so:
    $family = trim($family); ( undef, $family_release ) = $family_release =~ /(P|V)(\d+)*/; #print "$family\n"; my $key = get_key_by_rules( $family, $family_release ); $people{$user}{$key}++; $people{$user}{TOTAL}++;

    Yep, it's that simple. Although you'd actually want to test that $key isn't undef; that's the case when there is no rule that matches the given family/release.

    We're building the house of the future together.
      Wow, Thanks for taking the time to respond to my question.
Re: Coding for maintainability
by adrianh (Chancellor) on Feb 17, 2006 at 11:19 UTC
    I have a perl script that I maintain and need some advice as how to improve the code to make it easier to maintain

    And if you're spending your time doing lots of maintainence work I would thoroughly recommend getting copies of Perl Medic and Perl Best Practices.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://530713]
Approved by kutsu
Front-paged by xorl
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (9)
As of 2014-07-30 02:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (229 votes), past polls