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

[download]
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 :-)

In reply to Coding for maintainability by monsterzero

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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, details, 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, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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.