Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Constructive critisim

Posted on 2011-09-09
10
Medium Priority
?
220 Views
Last Modified: 2013-11-05
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.
0
Comment
Question by:leegin
  • 5
  • 4
10 Comments
 
LVL 28

Expert Comment

by:FishMonger
ID: 36513489
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.
0
 
LVL 1

Author Comment

by:leegin
ID: 36513725
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.
0
 
LVL 28

Expert Comment

by:FishMonger
ID: 36514620
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

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 28

Accepted Solution

by:
FishMonger earned 2000 total points
ID: 36514671
After looking back at the code, I'd probably make at least one small change.
#!/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} } ) {
    ...
    ...
}


sub process_xml {

    my ($xmlfile) = @_;
    my $xml = XMLin($xmlfile, ForceArray=>0, KeyAttr=>[]);
    
    if ( exists $xml->{files}{file} ) {
        $xml->{files} = [ $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(test 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

0
 
LVL 1

Author Comment

by:leegin
ID: 36524130
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.
0
 
LVL 1

Author Comment

by:leegin
ID: 36570314
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
0
 
LVL 1

Author Comment

by:leegin
ID: 36570365
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?
0
 
LVL 28

Expert Comment

by:FishMonger
ID: 36571079
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

0
 
LVL 1

Author Comment

by:leegin
ID: 36574295
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.

0

Featured Post

Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
The SignAloud Glove is capable of translating American Sign Language signs into text and audio.
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …
Loops Section Overview

886 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question