——————package
JSAN::URI;
=pod
=head1 NAME
JSAN::URI - A JavaScript Archive Network (JSAN) Validating Mirror URI
=head1 SYNOPSIS
my $url = 'http://www.jsan.de';
# Create the mirror handle
my $mirror = JSAN::URI->new( $url );
# Check the mirror
if ( ! $mirror->valid ) {
die "The mirror does not exist";
}
if ( $mirror->age > (3600 * 48) ) {
die "The mirror is too old";
}
=head1 DESCRIPTION
The JavaScript Archive Network (JSAN) uses a mirror synchronisation
method originally invented for the Comprehensive Perl Archive Network
(CPAN) which involved created a tiny specially named file in the root
of the filesystem that contains a timestamp, updated whenever the index
is regenerated.
By retrieving and examining this file, it is possible to validate if a
given URL actually represents a JSAN mirror, and how up to date that
mirror is, compared to the master site.
This module implements the logic required to do this in a reusable form
=head1 METHODS
=cut
use
5.008005;
use
strict;
use
warnings;
use
URI ();
use
LWP::Simple ();
use
Config::Tiny ();
use
File::Spec::Unix ();
our
$VERSION
=
'0.21'
;
#####################################################################
# Constructor and Accessors
=pod
=head2 new $uri
The C<new> constructor takes a path to the base of a JSAN mirror and
creates a handle object for it.
Returns a C<JSAN::URI> object, or C<undef> if not passed
a valid url path.
=cut
sub
new {
my
$class
=
ref
$_
[0] ?
ref
shift
:
shift
;
my
$URI
= URI->new(
shift
) or
return
undef
;
# Create the object
my
$self
=
bless
{
URI
=>
$URI
->canonical,
config
=>
undef
,
master
=>
undef
,
},
$class
;
$self
;
}
=pod
=head2 URI
The C<URI> accessor returns a L<URI> object for the location of the mirror.
=cut
sub
URI {
$_
[0]->{URI} }
=pod
=head2 uri
The C<uri> accessor returns a string of the location of the mirror.
=cut
sub
uri {
$_
[0]->{URI}->as_string }
sub
as_string {
$_
[0]->uri }
#####################################################################
# JSAN::URI Methods
=pod
=head2 valid
The C<valid> method check to see if the mirror exists, that is has
the mirror.conf file, and that matches the expected content.
Returns true if the mirror is valid, or false otherwise.
=cut
sub
valid {
my
$self
=
shift
;
my
$config
=
$self
->_config or
return
''
;
!! (
defined
$config
->{_}->{mirror} and
$config
->{_}->{mirror} eq
'jsan'
);
}
#####################################################################
# Support Methods
# Get the Config::Tiny object for the mirror
sub
_config {
my
$self
=
shift
;
$self
->{config} or
$self
->{config} =
$self
->_get(
$self
->uri );
}
# Get the Config::Tiny object for the master
sub
_master {
my
$self
=
shift
;
$self
->{master} or
$self
->{master} =
$self
->_get( JSAN_MASTER );
}
# Takes a URI and returns a Config::Tiny object for it
sub
_get {
my
(
$self
,
$uri
) =
@_
;
$uri
=~ s{/?$}{/mirror.conf}s;
my
$content
= LWP::Simple::get(
$uri
);
return
undef
unless
defined
$content
;
Config::Tiny->read_string(
$content
);
}
1;
=pod
=head1 TO DO
- Add verbose support
- Finish this when the mirrors have mirror.conf files
=head1 SUPPORT
Bugs should be reported via the CPAN bug tracker at
For other issues, contact the author.
=head1 AUTHOR
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright 2005 - 2009 Adam Kennedy.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=cut