JSAN::Transport - JavaScript Archive Network Transport and Resources

  # Create a transport
  my $transport = JSAN::Transport->new(
      verbose       => 1,
      mirror_remote => 'http://openjsan.org/',
      mirror_local  => '~/.jsan',
  );

  # Retrieve a file
  $transport->file_get( 'index.sqlite' );

  # Mirror a file
  $transport->mirror( '/dist/a/ad/adamk/Display.Swap-0.01.tar.gz' );

package JSAN::Transport;

use 5.008005;
use strict;
use Carp           ();
use Digest::MD5    ();
use File::Spec     ();
use File::Path     ();
use File::HomeDir  ();
use File::Basename ();
use URI::ToDisk    ();
use LWP::Simple    ();

our $VERSION = '0.29';


# The path to the index
my $SQLITE_INDEX = 'index.sqlite';





#####################################################################
# Constructor

sub new {
    my $class  = shift;
    my $params = { @_ };

    # Create the empty object
    my $self = bless {
        verbose => !! $params->{verbose},
        mirror  => undef,
        }, $class;

    # Apply defaults
    my $uri  = $params->{mirror_remote} || 'http://openjsan.org';
    my $path = $params->{mirror_local}
        ||
        File::Spec->catdir(
            File::HomeDir::home(), '.jsan'
        );

    # Strip superfluous trailing slashes
    $path =~ s/\/+$//;
    $uri  =~ s/\/+$//;

    # To ensure we don't overwrite cache, hash the uri
    my $digest = Digest::MD5::md5_hex("$uri");
    $path = File::Spec->catdir( $path, $digest );

    # Create the mirror_local path if needed
    -e $path or File::Path::mkpath($path);
    -d $path or Carp::croak("mirror_local: Path '$path' is not a directory");
    -w $path or Carp::croak("mirror_local: No write permissions to path '$path'");

    # Create the location object
    $self->{mirror} = URI::ToDisk->new( $path => $uri )
        or Carp::croak("Unexpected error creating URI::ToDisk object");

    return $self;
}

sub mirror_location { shift->{mirror} }

sub mirror_remote { shift->{mirror}->uri }

sub mirror_local { shift->{mirror}->path }

sub verbose { shift->{verbose} }




#####################################################################
# JSAN::Transport Methods

sub file_location {
    my $self = shift;
    my $path = $self->_path(shift);

    # Strip any leading slash
    $path =~ s/^\///;

    # Split into parts and find the location for it.
    my @parts    = split /\//, $path;
    my $mirror   = $self->mirror_location;
    $mirror->catfile( @parts );
}

sub file_get {
    my $self     = shift;
    my $location = $self->file_location(shift);

    # Check local dir exists
    my $dir = File::Basename::dirname($location->path);
    -d $dir or File::Path::mkpath($dir);

    # Fetch the file from the server
    my $rc = LWP::Simple::getstore( $location->uri, $location->path );
    if ( LWP::Simple::is_success($rc) ) {
        return $location;
    } elsif ( $rc == LWP::Simple::RC_NOT_FOUND ) {
        return '';
    } else {
        Carp::croak("$rc error retriving file " . $location->uri);
    }
}

sub file_mirror {
    my $self     = shift;
    my $path     = $self->_path(shift);
    my $location = $self->file_location($path);

    # If any only if a path is "stable" and the file already exists,
    # it is guarenteed not to change, and we don't have to do the
    # mirroring operation.
    if ( $self->_path_stable($path) and -f $location->path ) {
        return $location;
    }

    # Check local dir exists
    my $dir = File::Basename::dirname($location->path);
    -d $dir or File::Path::mkpath($dir);

    # Fetch the file from the server
    my $rc = LWP::Simple::mirror( $location->uri, $location->path );
    if ( LWP::Simple::is_success($rc) ) {
        return $location;
    } elsif ( $rc == LWP::Simple::RC_NOT_MODIFIED ) {
        return $location;
    } elsif ( $rc == LWP::Simple::RC_NOT_FOUND ) {
        return '';
    } else {
        Carp::croak("HTTP error $rc while syncing file " . $location->uri);
    }
}

sub index_file {
    shift->_index_synced->path;
}



#####################################################################
# Support Methods

# Validate a JSAN file path
sub _path {
    my $self = shift;
    my $path = shift or Carp::croak("No JSAN file path provided");

    # Strip any leading slash
    $path =~ s(^\/)();

    $path;
}

# Is a path considered "stable" (does not change over time)
sub _path_stable {
    my $self = shift;
    my $path = $self->_path(shift);

    # Paths under the "dist" path are stable
    if ( $path =~ m{^dist/} ) {
        return 1;
    }

    '';
}

# Returns the location of the SQLite index, syncronising it if needed
sub _index_synced {
    my $self = shift;
    if ( $self->{index_synced} ) {
        return $self->file_location($SQLITE_INDEX);
    }
    my $location = $self->file_mirror($SQLITE_INDEX);
    $self->{index_synced}++;
    $location;
}


1;