comment on

This will show a user on http://www.local.site/ a list of files that are buried in http://www.remote.dk/~user/files, including file size and file type.

I needed to do this because one of the developers on a project I'm working with deposits his beta builds on a server in Denmark, but only has http available at his disposal. Since the main project website is in the US, maintained by me, I needed a way to get those beta builds accessible from the website when he created them.

Previously, I would keep hitting his directory in .dk every few days/weeks and just copy the files over the the US server, write up a quick HTML blurb describing the files, and make that live on the site.

With this code, I don't have to ever do anything with mirroring of the files. When his new files appear in .dk, this listing is updated automagically on the US site when the user selects this page.

TODO

Need to add error checking when/if the remote server is down
Add file date/timestamps to the listing (LWP::Simple has this field, IIRC)
Add smarts to this to just grab these files and mirror them locally from this code (wget/pavuk/etc. is not sufficient for this task)

use strict;
use diagnostics;
use warnings;

use LWP::UserAgent;
use LWP::Simple;
use HTML::LinkExtor;
use URI::URL;

my $url         = "http://www.remote.dk/~user/beta/";
my $ua          = LWP::UserAgent->new;
my @links       = ();

sub callback {
        my($tag, %attr) = @_;
        return if $tag eq 'href';
        push(@links, values %attr);
        return (@links);
}
 
my $p           = HTML::LinkExtor->new(\&callback);
my $res         = $ua->request(HTTP::Request->new(GET => $url),
                       sub {$p->parse($_[0])});
my $base        = $res->base;
@links          = map {$_ = url($_, $base)->abs;} @links;
my @betas       = grep(/tar/, @links);

foreach my $beta (@betas) {
        my @remote_files = head($beta);
        my $length = $remote_files[1]; 

        my $bprecise    = sprintf "%.0f", $length;
        my $bsize       = insert_commas($bprecise);

        my $kprecise    = sprintf "%.0f", ($length/1024);
        my $ksize       = insert_commas($kprecise);

        my $archtype;   # tarball? or bzip2? or zip?
        my $betahref    = substr($beta, 40, 70);
        if ($beta =~ /tar.gz/) {
                $archtype = "(tarball)";
        } elsif ($beta =~ /bz2/) {
                $archtype = "(bzip)";
        } else {
                $archtype = "(zip)";
        }
        print a({-href=>"$beta"}, "$betahref"), 
              " $archtype<br />${ksize}kb, $bsize bytes", br,br;
} 

#################################################
#
# Insert commas in numeric lengths, so the number
# 1234567 would be 1,234,567
#
#################################################
sub insert_commas {
   local($_) = @_;
   1 while s/(\d+)(\d\d\d)/$1,$2/;  
   $_;
}
[download]

In reply to Presenting a local listing of remote files over HTTP by hacker

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.