8
\$\begingroup\$

I have some code that I wrote for a personal project which takes, as arguments, a directory and a URL. It then processes the files in the named directory, archives them, and uploads the archive to the specified URL.

I have heard that there are many ways to do this(TIMTOWTDI), particularly, with globs. I am hesitant to change working code, but I am interested in possible optimizations that may be possible with "globbing".

What can I do to make my code more idiomatic?

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper qw(Dumper);
use File::Spec qw(catfile rel2abs);
use Digest::SHA qw(sha256_hex);
use Archive::Tar;
use JSON;
use HTTP::Request::Common;
use LWP::UserAgent;

my $dir = $ARGV[0];
my $url = $ARGV[1];
my $fullpath;
my $fullsize;
my $fullid;
my @AoH;
my @checksumfiles;
my $archive = "archive.tar.gz";

opendir DIR, $dir or die "cannot open dir $dir: $!\n";
chdir $dir or die "cannot navigate to dir $dir: $!\n";

while(my $file = readdir DIR) {
    next unless(-f File::Spec->catfile($dir, $file));
    next if($file =~ m/^\./);

    $fullpath = File::Spec->rel2abs($file);
    $fullsize = -s File::Spec->catfile($dir, $file);
    $fullid   = sha256_hex($fullpath);

    my %hash = (
        path    =>  $fullpath,
        size    =>  $fullsize,
        id      =>  $fullid,
    );

    push(@AoH, \%hash);
}
my @array;
for my $i(0..$#AoH) {
    no warnings 'uninitialized';
    my ($ext) = $AoH[$i]{path} =~ (/(\.[^.]+)$/);
    my $idext = $AoH[$i]{id} . $ext;
    push(@checksumfiles, $idext);
    push(@array, $AoH[$i]{path});
}

my $manifest = JSON->new->pretty->encode(\@AoH);

my $filename = "manifest.json";
open my $fh, '>', $filename or die "could not open file $filename: $!\n";
print $fh $manifest;
close $fh;

my $tar = Archive::Tar->new;
$tar->add_files(@array);
$tar->write($archive);
my @file_objs = $tar->read($archive);

for my $i(0..$#file_objs) {
    $file_objs[$i]->rename($checksumfiles[$i]);
}

$tar->add_files($manifest);
$tar->write($archive, COMPRESS_GZIP);

my $browser = LWP::UserAgent->new;
my $useragent = LWP::UserAgent->new(
    env_proxy   => 1,
    keep_alive  => 1,
    timeout     => 120,
    agent       => 'Mozilla/5.0',
);

my $req = POST $url,
    Content_Type    => 'form-data',
    Content         => [ pageAction => 'upload', file => [$archive] ];

$useragent->request($req);

#print Dumper sort \@array;
#print Dumper sort \@checksumfiles;
#print Dumper sort \@AoH;
\$\endgroup\$
  • \$\begingroup\$ Are you using version control? You say you don't want to change working code. That's where git or another SCM tool comes in. \$\endgroup\$ – simbabque Dec 16 '17 at 16:16
  • \$\begingroup\$ I have some ideas for you that I'll post tomorrow. In the mean time I think $tar->add_files($manifest) should be $tar->add_files($filename) \$\endgroup\$ – Borodin Jan 23 '18 at 22:18
3
\$\begingroup\$

Your code is already pretty good, you have to tighten a scope of lexical (my) variables. Also as non-perl related, always get rid of unnecessary loops.

use strict;
use warnings;
use Data::Dumper qw(Dumper);
use File::Spec qw(catfile rel2abs);
use Digest::SHA qw(sha256_hex);
use Archive::Tar;
use JSON;
use HTTP::Request::Common;
use LWP::UserAgent;

my ($dir, $url) = @ARGV;
my $archive = "archive.tar.gz";

my @AoH;
my @checksumfiles;
my @array;
# same as glob("$dir/*")
while (my $file = <$dir/*>) {
    -f $file or next;

    my $fullpath = File::Spec->rel2abs($file);
    my %h = (
        path    =>  $fullpath,
        size    =>  -s $file,
        id      =>  sha256_hex($fullpath),
    );
    push @AoH, \%h;

    my ($ext) = $h{path} =~ /(\.[^.]+)$/;
    # defined or
    my $idext = $h{id} . $ext // ''; # fix codereview coloring */
    push @checksumfiles, $idext;
    push @array, $h{path};
}

# my @array;
# for my $i (0..$#AoH) {
    # no warnings 'uninitialized';
    # my ($ext) = $AoH[$i]{path} =~ (/(\.[^.]+)$/);
    # my $idext = $AoH[$i]{id} . $ext;
    # push(@checksumfiles, $idext);
    # push(@array, $AoH[$i]{path});
# }
\$\endgroup\$

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.