asked on

Constructive critisim

I am not new to Perl, but I still consider myself a beginner at it. I am the only Perl programmer in my company so I have no one to turn to for guidance. I am turning to the experts on this site to help me out a bit. Could you guys help out and look over my code. I am looking for some advice and guidance to produce a stable and reliable code.

Here is the script:

#!/usr/bin/perl -w

##############################################################################
#      $Source: /opt/automize/test.pl $
#     $Date: 2011-08-26 16:34:46 -0500 (Fri, 26 August 2011) $
#   $Author: Leonardo Cruz $
# $Revision: 100 $
##############################################################################

use strict;
use warnings;
use File::Basename;
use Carp;
our $VERSION = '2.0';

my $num_args = $#ARGV + 1;
my $message = q{};

if ( $num_args != 1 ) { print "\n" . 'Usage: ftp.pl file.xml' . "\n" or croak; exit; }

my $config = $ARGV[0];

if( !-e $config ){ print "\n $config file does not exist.\n\n" or croak; exit; }

my ( $files, $job, $type, $host, $user, $pass, $local, $server, $history, $log, $date, $del, $new_name ) = process_xml( $config );

foreach my $t ( @{ $files } ){
    #print $t . "\n" or croak;

    if( lc( $type ) eq 'upload' ){

	if( file_stats( $t ) == 1 ){
	    print 'File: ' . $t . ' was updated.' . "\n" or croak;
	    my $result = ftp_file( $t, $new_name );
	    $message .= $result;
	}
    }
}

if ( $message ne q{} ){
    print 'Job completed with following errors.' or croak;
    print "\n" . 'Error(s): ' . $message . "\n" or croak;
    exit;
}

sub process_xml{

    my ($xmlfile) = @_;

    use XML::Simple qw(:strict);

    my $xml = XMLin($xmlfile, ForceArray=>0, KeyAttr=>[]);

    my @f = ();
    my $j = 'undef';
    my $t = 'undef';
    my $h = 'undef';
    my $u = 'undef';
    my $p = 'undef';
    my $l = 'undef';
    my $s = 'undef';
    my $ar = 'undef';
    my $f = 'undef';
    my $d = 'undef';
    my $r = 'undef';
    my $name = 'undef';

    #print 'Files: ' . @f . 'Job: ' . $j . 'Type: ' . $t . 'Host: ' .  $h . 'User: ' . $u . 'Password: ' . $p .  'Local: ' . $l . 'Server: ' . $s . 'History: ' . $ar . 'Log: ' . $f . 'Date: ' . $d . 'Delete: ' . $r . "\n" or croak;

    if( exists $xml->{job} ){ $j = $xml->{job}; }
    if( exists $xml->{type} ){ $t = $xml->{type}; }
    if( exists $xml->{host} ) { $h = $xml->{host}; }
    if( exists $xml->{user} ) { $u = $xml->{user}; }
    if( exists $xml->{password} ) { $p = $xml->{password}; }
    if( exists $xml->{localpath} ) { $l = $xml->{localpath}; }
    if( exists $xml->{serverpath} ) { $s = $xml->{serverpath}; }
    if( exists $xml->{historypath} ) { $ar = $xml->{historypath}; }
    if( exists $xml->{logfile} ) { $f = $xml->{logfile}; }
    if( exists $xml->{date} ) { $d = $xml->{date}; }
    if( exists $xml->{del} ) { $r = $xml->{del}; }
    if( exists $xml->{name} ) { $name = $xml->{name} }

    if( exists $xml->{files}->{file} ){

	if( ref($xml->{files}->{file} ) eq q{} ){

	    push @f, $xml->{files}->{file};
	}

	if( ref( $xml->{files}->{file} ) eq 'ARRAY' ){

	    foreach my $file ( @{ $xml->{files}->{file} } ){

	        push  @f, $file;
	    }
	}
    }

    elsif( exists $xml->{files}->{regex} && lc( $t ) eq 'upload' ){

        my @glob = glob "$l/$xml->{files}->{regex}";

	foreach my $glob ( @glob ){

	    ( my $n, my $p, my $s ) = fileparse( $glob );

	    push @f, $n;
	}
    }

    elsif( exists $xml->{files}->{regex} && lc( $t ) eq 'download' ){

        push @f, $xml->{files}->{regex};
    }

    else{

	@f = undef;
    }

    return ( \@f, $j, $t, $h, $u, $p, $l, $s, $ar, $f, $d, $r, $name );

}


sub file_stats{

    my ( $fi ) = @_;
    my $dev = 'NULL';
    my $ino = 'NULL';
    my $mode = 'NULL';
    my $nlink = 'NULL';
    my $uid = 'NULL';
    my $gid = 'NULL';
    my $rdev = 'NULL';
    my $size = 'NULL';
    my $atime = 'NULL';
    my $mtime = 'NULL';
    my $ctime = 'NULL';
    my $blksize = 'NULL';
    my $blocks = 'NULL';
    my $n = 'NULL';
    my $p = 'NULL';
    my $s = 'NULL';

    if( -e "$local/$fi" ){

	( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks )= stat "$local/$fi";

	( $n, $p, $s ) = fileparse( $fi, qr/[.][^.]*/xms );

        db_update( $job, $fi, $size, $mtime, $ctime, 1, $new_name );
	return '1';
    }
    else{

	db_update( $job, $fi, $size, $mtime, $ctime, 0, $new_name );
	return '1';
    }

    return '0';
}

sub db_update{

    my ( $j, $fn, $fs, $fmtime, $fctime, $found, $n_name ) = @_;

    use DBI;

    my $dbh = DBI->connect( 'DBI:mysql:automize:localhost', 'automize', 'green97', {RaiseError => 1, AutoCommit => 1} );

    my $sql = " SELECT cron_id FROM cron WHERE job = \"$j\" ";
    my $sth = $dbh->prepare( $sql ) or croak "failed: $sql\n ";
    my $rv = $sth->execute;
    my @data = $sth->fetchrow_array();
    $sth->finish;

    $sql = " SELECT * FROM files WHERE filename=\"$fn\" ";
    $sth = $dbh->prepare( $sql );
    $rv = $sth->execute;
    my @update = $sth->fetchrow_array();
    $sth->finish;

    if( scalar( @update ) > 0 ){

        $sql = " UPDATE files SET size=\"$fs\", cDate=\"$fctime\", lModified=\"$fmtime\", found=\"$found\" WHERE filename=\"$fn\" ";
        $sth = $dbh->prepare($sql) or croak "failed: $sql\n";
        $rv = $sth->execute;
        $sth->finish;
    }
    elsif( scalar( @update ) == 0 ){

        $sql = "INSERT INTO files VALUES ( 'default', $data[0], \"$fn\", \"$n_name\", \"$fs\", \"$fctime\", \"$fmtime\", \"$found\" )" ;
        $sth = $dbh->prepare($sql) or croak "failed: $sql\n";
        $rv = $sth->execute;
        $sth->finish;
    }

    $dbh->disconnect;
    return;
}


sub ftp_file{

    my ( $ftp_file, $u_name ) = @_;
    #print $upload . "\n" or croak;
    #print $name . "\n" or croak;

    use Net::FTP::File;

    my $ftp;

    $ftp = Net::FTP->new( $host ) or return $@;
    $ftp->login( $user, $pass ) or return $ftp->message . "\n";
    $ftp->cwd( $server ) or return $ftp->message . "\n";

    if( $type eq 'upload' ){

	if( $u_name eq 'undef' ){
	    $ftp->put( "$local/$ftp_file" ) or return $ftp->message . "\n";
	}
	else{
	    $ftp->put( "$local/$ftp_file", $u_name ) or return $ftp->message . "\n";
	}
    }

    $ftp->close or return $ftp->message . "\n";

    return 'true';
}

Open in new window

Here is the XML sample:

<?xml version="1.0" encoding="ISO-8859-1"?>
<site>
	<job>job_name</job>
	<type>upload or download only</type>
	<host>ftp.host.com</host>
	<ip>1.0.1.1</ip>
	<user>user</user>
	<password>password</password>
	<localpath>/local/path</localpath>
	<serverpath>/server/path</serverpath>
	<files>
	    <file>file_to_upload.txt</file>
	</files>
	<historypath>/path/to/history/folder</historypath>
	<logfile>/temp/log.txt</logfile>
	<date>0</date>
	<del>0</del>
</site>

Open in new window

I want to make sure I am on the right path. Thanks in advance for your support.

FishMonger

There are numerous issues with the script but since I'm at work, I don't have time to go into a lot of details, however, here are a few things.

Putting use statements inside subroutines doesn't make sense. Put them all at the beginning of the script.

Your error handling is pretty odd. Just do a simple croak.

This:

my $num_args = $#ARGV + 1;
if ( $num_args != 1 ) { print "\n" . 'Usage: ftp.pl file.xml' . "\n" or croak; exit; }

Open in new window

is better written as:

@ARGV == 1 or croak "Usage: $0 file.xml\n\n";

Open in new window

With very few exceptions, you should not use single character var names and none of those exceptions exist in your code.

IMO, the vast majority of the code in your process_xml sub is simply unnecessary.

Why initialize all of those vars to a string of 'undef'?

In stead of returning a long list of vars, you should return a single hash reference.

Line lengths should be kept below 80 characters and only go longer if absolutely needed and keep that excess as short as possible.

leegin

ASKER

Thank you for the suggestions and they are all well taken. I probably should have mentioned that I am still working on it. There will be an email function that should send me an email as soon as there is an error. The error messages should be in plain English so as non technical people can read and understand what went wrong. I am initializing the variables with undef because I am feeding that info into the next function and I don't want the script to send me warnings that the variable is not initialized. Can you provide me with some more samples I really appreciate your comments.

FishMonger

I'm not going to rewrite your entire script, but here's a head start on how I'd approach it.

#!/usr/bin/perl

=pod comment

Source:    /opt/automize/test.pl
Date:      2011-08-26 16:34:46 -0500 (Fri, 26 August 2011)
Author:    Leonardo Cruz
Revision:  100

=cut

##############################################################################

use strict;
use warnings;
use Carp;
use DBI;
use File::Basename;
use XML::Simple qw(:strict);
use Data::Dumper;

@ARGV == 1 or croak "Usage: $0 file.xml\n\n";

my $xml_file = $ARGV[0];
if ( not -e $xml_file ) {
    croak "$xml_file file does not exist.\n\n";
}

my $config = process_xml( $xml_file );

foreach my $file ( @{ $config->{files}{file} } ) {
    ...
    ...
}


sub process_xml {

    my ($xmlfile) = @_;
    my $xml = XMLin($xmlfile, ForceArray => 0, KeyAttr => []);
    
    if ( exists $xml->{files}{file} and ref $xml->{files}{file} ne 'ARRAY' ) {
        $xml->{files}{file} = [ $xml->{files}{file} ];
    }
    
    # add the tests and related code for the upload/download regex stuff
    
    # if you need to assign defaults for possibly missing fields,
    # you could do something like this:
    my @required_keys = (qw(job type host user password localpath serverpath));
    foreach my $key ( @required_keys ) {
        $xml->{$key} = 'undef' unless length $xml->{$key};
    }
    
    print Dumper $xml;
    return $xml;
}

Open in new window

There are also a number of problems with your db_update() sub. For example, you should use placeholders for the values in the statements and pass those vars in the execute statement. Like this:

         $sql = 'INSERT INTO files VALUES (?,?,?,?,?,?,?)';
         $sth = $dbh->prepare($sql) or croak "failed: $sql\n";
         $rv  = $sth->execute($data[0], $fn, $n_name, $fs, $fctime, $fmtime, $found);

Open in new window

ASKER CERTIFIED SOLUTION

FishMonger

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

leegin

ASKER

I am looking at the following line in your suggestion:

my $config = process_xml( $xml_file );

foreach my $file ( @{ $config->{files}{file} } ) {
    ...
    ...
}

Open in new window

I have some upload jobs that look in a folder and upload anything that is there, the name of the files are never the same, so I use a <regex> tag in my XML file. This tells the script whether to build a list of files based on what is provided in the XML file or from a glob of a directory. How would I do that in your example if do the foreach loop before testing for a file list or a regex in the XML file? This is the most complicated script I have had to build thus far so I guess I am in some respects still a beginner. Thank you for your help on this.

leegin

ASKER

Hello Fish monger I am having trouble accessing the a list of files when I use the code you suggested. I know I am missing something.

When in the xml file I provide a list of files I am not able to access those files themselves I get an ARRAY(0x15a94e50) when going through the loop. Can you please help me with this. I want to be able to use an array list for the files or a hash reference is ok too. I just can see how to build it.

thanks

leegin

ASKER

Here is a sample of the dumper info of the $config->{files} variable.

$VAR1 = [
          [
            'weblocator.txt',
            'weblocator1.txt',
            'weblocator2.txt',
            'weblocator3.txt',
            'weblocator4.txt',
            'weblocator5.txt'
          ]
        ];
ARRAY(0xbd39d98)

Open in new window

How do I get the file names using a foreach loop?

FishMonger

That's an AoA (Array of Arrays). To access a single value you'd do this:

print $config->{files}[0][0];

Open in new window

To loop over it you could do this:

foreach my $file ( @{$config->{files}[0]} ) {
    print "$file\n";
}

Open in new window

leegin

ASKER

FishMonger thank you for your reply. Your previous suggestion worked great for single file uploads, however when I supplied a list of files to upload I would get the above mentioned problem. Please see below and let me know what you think of my solution to this problem.

#!/usr/bin/perl

=pod comment

Source:    /opt/automize/test.pl
Date:      2011-08-26 16:34:46 -0500 (Fri, 26 August 2011)
Author:    Leonardo Cruz
Revision:  100

=cut

##############################################################################

use DBI;
use Carp;
use strict;
use warnings;
use File::Basename;
use XML::Simple qw(:strict);
use Mail::Sender::Easy qw(email);
use Data::Dumper;

our $VERSION = '2.0';

@ARGV == 1 or croak "Usage: $0 file.xml\n\n";

my $xml_file = $ARGV[0];

if( !-e $xml_file ){ email_error("Error - $xml_file file not found", "Could not find $xml_file file.\n"); exit; }

my $config = process_xml( $xml_file );

foreach my $file ( @{ $config->{files} } ){

    print $file . "\n" or croak;
}

sub process_xml{

    my ($xmlfile) = @_;

    my $xml = XMLin($xmlfile, ForceArray=>0, KeyAttr=>[]);

    my @required_keys = (qw(job type host ip user password localpath serverpath name historypath logfile date del));

    foreach my $key ( @required_keys ) {

	$xml->{$key} = 'undef' unless length $xml->{$key};

    }

    if( lc $xml->{type} eq 'upload')
    {
	if( exists $xml->{files}->{file} and ref $xml->{files}->{file} eq 'ARRAY'){
	    $xml->{files} = [ @{ $xml->{files}->{file} } ];
	}
	elsif( exists $xml->{files}->{file} and ref $xml->{files}->{file} ne 'ARRAY'){
	    $xml->{files} = [ $xml->{files}->{file} ];
	}
	elsif( exists $xml->{files}->{regex} ){
	    my @glob = glob "$xml->{localpath}/$xml->{files}->{regex}";
	    $xml->{files} = \@glob;
	}
    }
    else{

    }
    return $xml;
}

Open in new window

The above code works for a list of files a single file and a glob.