3
\$\begingroup\$

Please review the Perl script on the link below for any bad practice which could potentially blow up in my face. The code itself works, but take note that I removed the real API endpoint hostname, so it won't work for you if you run it, as the API URL isn't valid anymore. As I'm still learning Perl, if possible please also provide suggestions how to make the code more robust where necessary.

#!/usr/bin/env perl

use strict;
use warnings;

use Fcntl                       qw/ :flock /;
use LWP::UserAgent;
use POSIX                       qw/ strftime /;
use IO::Compress::Gzip          qw/ gzip $GzipError /;
use Log::Log4perl               qw/ get_logger /;
use Text::CSV;
use LWP::Simple                 qw/ getstore /;
use File::Spec::Functions       qw/ catdir splitdir /;
use File::Basename              qw/ fileparse dirname /;
#use File::Path                 qw/ make_path /;

#use Data::Dumper               qw/ Dumper /;

use constant BASE_TEST_DIR  => '/home/test/';


# https://stackoverflow.com/questions/455911/whats-the-best-way-to-make-sure-only-one-instance-of-a-perl-program-is-running
open( my $self, '<', $0 ) or die "Couldn't open self: $!";
flock( $self, LOCK_EX | LOCK_NB ) or die "This script is already running";

my $conf = q(
log4perl.category.Bar.Twix                          = WARN, Logfile
log4perl.appender.Logfile                           = Log::Log4perl::Appender::File
log4perl.appender.Logfile.filename                  = log_download_API_access_script_ops.log
log4perl.appender.Logfile.layout                    = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Logfile.layout.ConversionPattern  = %d %F{1} %L> %m %n
);

Log::Log4perl::init(\$conf);

my $logger = get_logger("Bar::Twix");

# define a datetime_stamp
my $datetime_stamp = strftime "%Y-%m-%d_%Hh%Mm%Ss", localtime();

#### perldoc LWP for documentation
# Create a user agent object
my $ua = LWP::UserAgent->new;
$ua->agent( "Secret Agent" );

# Create a request
my $api_endpoint_url = 'http://XYZ.com/api/download/';
my $req = HTTP::Request->new( GET => $api_endpoint_url );

# Pass request to the user agent and get a response back
my $res = $ua->request( $req );
$logger->error("GET request to API endpoint: $api_endpoint_url");


my %hash_from_csv;

# Check the outcome of the response
if ( $res->is_success ) {
    # print $res->content;
    $logger->error("Response from API is a success, specific response was: " . $res->status_line);

    my $download_list_filename = "download_list_${datetime_stamp}.gz";
    my $z = IO::Compress::Gzip->new( $download_list_filename )
        or die "Could not write to $download_list_filename: $GzipError";
    print { $z } $res->content;
    $logger->error($download_list_filename . " created");

    # API response consisting of a single 0 means the download list is empty 
    # code below, dealing with 0 is untested, as until now API always sends a list with CSV
    my $content_csv = $res->content;
    if ( $content_csv eq 0 ) {
        $logger->error("Response from API was 0, which means there are no files to be downloaded, exiting.");
        die q{Response from API was 0, which means there are no files to be downloaded, exiting.};
    }
    elsif ( $content_csv eq "0\n") {
        $logger->error("Response from API was 0, which means there are no files to be downloaded, exiting.");
        die q{Response from API was 0, which means there are no files to be downloaded, exiting.};
    }

    # watch out the encoding!
    open(my $fh, '<:utf8', \$content_csv) or die "Can't open $content_csv: $!";

  # https://stackoverflow.com/questions/15294807/perl-csv-to-hash
    my $csv = Text::CSV->new( { binary => 1, allow_whitespace => 1 } ) or die "Text::CSV error: " . Text::CSV->error_diag;
    while (my $row = $csv->getline($fh)) {
        $hash_from_csv{$row->[0]} = {source_url => $row->[1], rel_dest_path => $row->[2]};
    }
    $csv->eof or $csv->error_diag;
    close $fh;

    # print Dumper \%hash_from_csv;
}
else {
    print $res->status_line, "\n";
    $logger->error("Response from API is a failure, specific response was: " . $res->status_line);
}

my $user = 'nobody';
my ($login,$pass,$uid,$gid) = getpwnam( $user ) or die "$user not in passwd file";

for my $key ( sort keys %hash_from_csv ) {
    print "$key, $hash_from_csv{$key}{source_url}, $hash_from_csv{$key}{rel_dest_path}\n";

    my $rel_directory_path = dirname( $hash_from_csv{$key}{rel_dest_path} );
    print "rel_dirs: $rel_directory_path\n";

    my @split_rel_directories = splitdir( $rel_directory_path );
    print "split_rel_dirs: @split_rel_directories\n";

    my $abs_dest_path = catdir( BASE_TEST_DIR, $hash_from_csv{$key}{rel_dest_path} );
    print "abs_dest_path: $abs_dest_path\n";

    my( $filename, $abs_directory_path ) = fileparse( $abs_dest_path );
    print "dir+filename: $abs_directory_path, $filename\n";

    unless ( -e $abs_dest_path ) {
        $logger->error("Path doesn't exist on storage: $abs_dest_path");
        unless ( -e $abs_directory_path and -d _ ) {
            # make_path( $abs_directory_path );
            my $build_dir_path_base_dir = BASE_TEST_DIR;
            for my $rel_dir ( @split_rel_directories ) {
                my $new_dir = catdir( $build_dir_path_base_dir, $rel_dir );
                unless ( -e $new_dir and -d _ ) {
                    mkdir $new_dir or die "Could not create $new_dir";
                    $logger->error("Directory created: $new_dir");
                    chown $uid, $gid, $new_dir;
                }
                $build_dir_path_base_dir = $new_dir;
            }
        }
        my $http_response_code = getstore( $hash_from_csv{$key}{source_url}, $abs_dest_path );
        $logger->error("HTTP response while downloading $hash_from_csv{$key}{source_url} to $abs_dest_path was $http_response_code");
        print $http_response_code, "\n";

        chown $uid, $gid, $abs_dest_path;
    }
}
\$\endgroup\$
2
\$\begingroup\$

Some useful feedback I got from #perl channel on freenode.

(1)

x: is $res isn't a success, the script continues?
y: thx, i missed that

(2)

x: handle failure first, don't put a big block of success code only to "or exit" many lines away, you'll also save a level of indentation
y: i see, if i handle failure first, script dies, no need to have success in an if/else block

(3)

x: suggest not doing "unless ( … ) { … }"
x: "next unless -e $abs_dest_path;" and save another big block of indentation
x: if it's to be a block clause, consider "if not" instead
y: i see, thx, didn't think of using "next", will do, also will replace unless
z: his example still used unless
z: it just didn't use unless in the form you did
z: x unless y z: is much more readable than: unless (y) { x }

| improve this answer | |
\$\endgroup\$
  • 2
    \$\begingroup\$ There is nothing wrong with unless ( expression ) { ... } instead of if ( not (expression) ) { ... } and it can often be clearer. Some people may dislike it because it is an uncommon language word, but unfamiliarity is a poor reason to reject it. However, I strongly recommend avoiding unless if there is to be an else clause. unless ( expression ) { ... } else { ... } will get the best people scratching their heads! \$\endgroup\$ – Borodin Aug 16 '17 at 21:28
  • \$\begingroup\$ It is scaring me that I can recognize the people you named x and z here from their advice. You don't have to mask their names, by the way. Proper attribution is always a good thing, and typically IRC is considered the public domain. \$\endgroup\$ – simbabque Oct 27 '17 at 10:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.