package JSAN::Index::Release;
# See POD at end for docs
use 5.008005;
use strict;
use warnings;
use Carp ();
use File::Spec ();
use File::Spec::Unix ();
use File::Path ();
use Params::Util ();
use JSAN::Index::Distribution ();
use JSAN::Index::Author ();
our $VERSION = '0.29';
BEGIN {
# Optional prefork.pm support
eval "use prefork 'YAML'";
eval "use prefork 'Archive::Tar'";
eval "use prefork 'Archive::Zip'";
}
# Make the tar code read saner below
use constant COMPRESSED => 1;
sub distribution {
JSAN::Index::Distribution->retrieve(
name => $_[0]->{distribution},
);
}
sub author {
JSAN::Index::Author->retrieve(
login => $_[0]->{author},
);
}
sub retrieve {
my $class = shift;
my %params = @_;
my $sql = join " and ", map { "$_ = ?" } keys(%params);
my @result = $class->select( "where $sql", values(%params) );
if ( @result == 1 ) {
return $result[0];
}
if ( @result > 1 ) {
Carp::croak("Found more than one author record");
} else {
return undef;
}
}
sub search_like {
my $class = shift;
my %params = @_;
my $sql = join " and ", map { "$_ like ?" } keys(%params);
my @result = $class->select( "where $sql", values(%params) );
return @result
}
sub retrieve_all {
shift->select
}
sub file_path {
JSAN::Index->transport->file_location($_[0]->source)->path;
}
sub file_mirrored {
!! -f $_[0]->file_path;
}
sub mirror {
my $self = shift;
my $location = JSAN::Index->transport->file_mirror($self->source);
$location->path;
}
sub created_string {
scalar localtime( shift()->created );
}
sub requires {
my $self = shift;
# Get the raw dependency hash
my $meta = $self->meta_data;
unless ( UNIVERSAL::isa($meta, 'HASH') ) {
# If it has no META.yml at all, we assume that it
# has no dependencies.
return ();
}
my $requires = $meta->{requires} or return {};
if ( UNIVERSAL::isa($requires, 'HASH') ) {
# To be safe (mainly in case it's a dependency object of
# some sort) make sure it's a plain hash before returning.
my %hash = %$requires;
return \%hash;
}
# It could be an array of Requires objects
if ( UNIVERSAL::isa($requires, 'ARRAY') ) {
my %hash = ();
foreach my $dep ( @$requires ) {
unless ( Params::Util::_INSTANCE($dep, 'Module::META::Requires') ) {
Carp::croak("Unknown dependency structure in META.yml for "
. $self->source);
}
$hash{ $dep->{name} } = $dep->{version};
}
return \%hash;
}
Carp::croak("Unknown 'requires' dependency structure in META.yml for "
. $self->source);
}
sub build_requires {
my $self = shift;
# Get the raw dependency hash
my $meta = $self->meta_data;
unless ( UNIVERSAL::isa($meta, 'HASH') ) {
# If it has no META.yml at all, we assume that it
# has no dependencies.
return ();
}
my $requires = $meta->{build_requires} or return {};
if ( UNIVERSAL::isa($requires, 'HASH') ) {
# To be safe (mainly in case it's a dependency object of
# some sort) make sure it's a plain hash before returning.
my %hash = %$requires;
return \%hash;
}
# It could be an array of Requires objects
if ( UNIVERSAL::isa($requires, 'ARRAY') ) {
my %hash = ();
foreach my $dep ( @$requires ) {
unless ( Params::Util::_INSTANCE($dep, 'Module::META::Requires') ) {
Carp::croak("Unknown dependency structure in META.yml for "
. $self->source);
}
$hash{ $dep->{name} } = $dep->{version};
}
return \%hash;
}
Carp::croak("Unknown 'build_requires' dependency structure in META.yml for "
. $self->source);
}
sub requires_libraries {
my $self = shift;
my $requires = $self->requires;
# Find the library object for each key
my @libraries = ();
foreach my $name ( sort keys %$requires ) {
my $library = JSAN::Index::Library->retrieve( name => $name );
push @libraries, $library if $library;
}
@libraries;
}
sub build_requires_libraries {
my $self = shift;
my $requires = $self->build_requires;
# Find the library object for each key
my @libraries = ();
foreach my $name ( sort keys %$requires ) {
my $library = JSAN::Index::Library->retrieve( name => $name );
push @libraries, $library if $library;
}
@libraries;
}
sub requires_releases {
my $self = shift;
my @libraries = $self->requires_libraries;
# Derive a list of releases
my @releases = map { $_->release } @libraries;
return @releases;
}
sub build_requires_releases {
my $self = shift;
my @libraries = $self->build_requires_libraries;
# Derive a list of releases
my @releases = map { $_->release } @libraries;
return @releases;
}
sub meta_data {
my $self = shift;
require YAML;
my @structs = YAML::Load($self->meta);
unless ( defined $structs[0] ) {
Carp::croak("Failed to load META.yml struct for "
. $self->source );
}
$structs[0];
}
sub archive {
# Cache result of the real method
$_[0]->{archive} or
$_[0]->{archive} = $_[0]->_archive;
}
sub _archive {
my $self = shift;
# Load tarballs
if ( $self->source =~ /\.(tar\.gz|tgz)$/ ) {
require Archive::Tar;
my $tar = Archive::Tar->new;
my $path = $self->mirror;
unless ( $tar->read($path, COMPRESSED) ) {
Carp::croak("Failed to open tarball '$path'");
}
return $tar;
}
# Load zip files
if ( $self->source =~ /\.zip$/ ) {
require Archive::Zip;
my $zip = Archive::Zip->new;
my $path = $self->mirror;
unless ( $zip->read($path) == Archive::Zip::AZ_OK() ) {
Carp::croak("Failed to open zip file '$path'");
}
return $zip;
}
# We don't support anything else
Carp::croak('Failed to load unsupported archive type '
. $self->source);
}
sub extract_libs {
my $self = shift;
$self->extract_resource('lib', @_);
}
sub extract_static_files {
my $self = shift;
my $static_dir = $self->meta_data->{static_dir} || 'static';
$self->extract_resource($static_dir, @_, is_static => 1);
}
sub extract_tests {
my $self = shift;
$self->extract_resource('tests', @_);
}
sub extract_resource {
my $self = shift;
my $resource = shift
or Carp::croak("No resource name provided to extract_resource");
my %params = @_;
# Check the extraction destination
$params{to} ||= File::Spec->curdir;
unless ( -d $params{to} ) {
Carp::croak("Extraction directory '$params{to}' does not exist");
}
unless ( -w $params{to} ) {
Carp::croak("No permissions to write to extraction directory '$params{to}'");
}
# Split on archive type
if ( $self->archive->isa('Archive::Tar') ) {
return $self->_extract_resource_from_tar($resource, @_);
}
if ( $self->archive->isa('Archive::Zip') ) {
return $self->_extract_resource_from_zip($resource, @_);
}
Carp::croak("Unsupported archive type " . ref($self->archive));
}
#####################################################################
# Support Methods
sub _extract_resource_from_tar {
my ($self, $resource, %params) = @_;
my $tar = $self->archive;
my @files = $tar->get_files;
# Determine which files to extract, and to where
my $extracted_files = 0;
foreach my $item ( @files ) {
next unless $item->is_file;
# Split into parts and remove the top level dir
my ($vol, $dir, $file)
= File::Spec::Unix->splitpath($item->full_path);
my @dirs = File::Spec::Unix->splitdir($dir);
shift @dirs;
# Is this file in the resource directory
# Also skips all root-level files
my $res = shift(@dirs) or next;
next unless $res eq $resource;
# Static files are put into the library, so /static/all.css becomes /Dist/Name/static/all.css
@dirs = (split(/\./, $self->distribution->name), $res, @dirs) if $params{is_static};
# These are STILL relative, but we'll deal with that later.
my $write_dir = File::Spec->catfile($params{to}, @dirs);
# Write the file
$self->_write( $write_dir, $file, $item->get_content, $params{is_static} );
$extracted_files++;
}
# Return the number of files, or error if none
return $extracted_files if $extracted_files;
my $path = $self->source;
# Only resource 'static' is optional
Carp::croak("Tarball '$path' does not contain resource '$resource'") unless $params{is_static};
}
sub _extract_resource_from_zip {
Carp::croak("Zip support not yet completed");
}
sub _write {
my ($self, $dir, $file, $content, $is_static) = @_;
# Localise newlines in the files unless we are extracting the static file (which can be binary)
$content =~ s/(\015{1,2}\012|\015|\012)/\n/g unless $is_static;
# Create the save directory if needed
File::Path::mkpath( $dir, 0, 0755 ) unless -d $dir;
# Save it
my $path = File::Spec->catfile( $dir, $file );
unless ( open( LIBRARY, '>', $path ) ) {
Carp::croak( "Failed to open '$path' for writing: $!" );
}
unless ( print LIBRARY $content ) {
Carp::croak( "Failed to write to '$path'" );
}
unless ( close LIBRARY ) {
Carp::croak( "Failed to close '$path' after writing" );
}
1;
}
######################################################################
# Generated by ORLite 1.25 (Unused parts are commented out)
#sub base { 'JSAN::Index' }
#
#sub table { 'release' }
sub select {
my $class = shift;
my $sql = 'select "id", "distribution", "author", "checksum", "created", "doc", "meta", "latest", "source", "srcdir", "version" from release ';
$sql .= shift if @_;
my $rows = JSAN::Index->selectall_arrayref( $sql, { Slice => {} }, @_ );
bless( $_, 'JSAN::Index::Release' ) foreach @$rows;
wantarray ? @$rows : $rows;
}
#sub count {
# my $class = shift;
# my $sql = 'select count(*) from release ';
# $sql .= shift if @_;
# JSAN::Index->selectrow_array( $sql, {}, @_ );
#}
#
#sub iterate {
# my $class = shift;
# my $call = pop;
# my $sql = 'select "id", "distribution", "author", "checksum", "created", "doc", "meta", "latest", "source", "srcdir", "version" from release ';
# $sql .= shift if @_;
# my $sth = JSAN::Index->prepare( $sql );
# $sth->execute( @_ );
# while ( $_ = $sth->fetchrow_hashref ) {
# bless( $_, 'JSAN::Index::Release' );
# $call->() or last;
# }
# $sth->finish;
#}
sub id {
$_[0]->{id};
}
#sub distribution {
# $_[0]->{distribution};
#}
#sub author {
# $_[0]->{author};
#}
sub checksum {
$_[0]->{checksum};
}
sub created {
$_[0]->{created};
}
sub doc {
$_[0]->{doc};
}
sub meta {
$_[0]->{meta};
}
sub latest {
$_[0]->{latest};
}
sub source {
$_[0]->{source};
}
sub srcdir {
$_[0]->{srcdir};
}
sub version {
$_[0]->{version};
}
1;
__END__
=pod
=head1 NAME
JSAN::Index::Release - A JavaScript Archive Network (JSAN) Release
=head1 DESCRIPTION
This class provides objects for a single release of a distribution by an author
=head1 METHODS
In addition to the general methods provided by L<ORLite>, it has the
following methods
=head2 id
The C<id> accessor returns the unique identifier for the release (an integer)
=head2 source
The C<source> access returns the root-relative path within a JSAN mirror
that the package can be found at.
=head2 distribution
The C<distribution> method returns the L<JSAN::Index::Distribution> for
the distribution that this release is of.
=head2 author
The C<author> method returns the L<JSAN::Index::Author> for the JSAN author
that uploaded the release.
=head2 version
The C<version> accessor returns the version of the release.
=head2 created
The C<created> accessor returns the time that the release was received and
first indexed by the JSAN upload server.
Returns an integer in unix epoch time.
=head2 created_string
The C<created_string> method returns the time that the release was recieved
and first indexed by the JSAN upload server.
Is equivalent to C<scalar localtime $object-E<gt>created>.
Returns a time as a localtime string.
=head2 doc
The C<doc> accessor returns the root-relative location of the documentation
for this release on the L<http://openjsan.org/> website.
=head2 meta
The C<meta> accessor returns the actual content of the C<META.yml> file that
came with the distribution.
=head2 meta_data
The C<meta_data> method loads and deserialises the META.yml content
contained in the index (and returned by the C<meta> method above).
=head2 checksum
The C<checksum> accessor returns the MD5 checksum for the release tarball.
=head2 latest
The C<latest> accessor returns a boolean flag indicating if the release is
the most recent release of the distribution.
=head2 requires
The C<requires> method finds the set of run-time library dependencies for
this release, as identified in the META.yml data contained in the index.
Returns a reference to a HASH where the key is the name of a library as
a string, and the value is the version for the dependency (or zero if the
dependency is not for a specific version).
=head2 requires_libraries
The C<requires_libraries> method returns a list of the C<JSAN::Index::Library>
dependencies as identified by the META.yml file for the release.
=head2 requires_releases
The C<requires_releases> method returns a list of the C<JSAN::Index::Release>
dependencies based on the dependencies specified in the META.yml file for the
release.
=head2 build_requires
The C<build_requires> method finds the set of build-time library
dependencies for this release, as identified in the META.yml data contained
in the index.
Returns a reference to a HASH where the key is the name of a library as
a string, and the value is the version for the dependency (or zero if the
dependency is not for a specific version).
=head2 build_requires_libraries
The C<build_requires_libraries> method returns a list of the build-time
C<JSAN::Index::Library> dependencies as identified by the META.yml file
for the release.
=head2 build_requires_releases
The C<requires_releases> method returns a list of the C<JSAN::Index::Release>
build-time depedencies based on those specified in the META.yml file for the
release.
=head2 file_path
The C<file_path> method returns the location on the local disk where
the release tarball should be, if mirrored.
=head2 mirror
The C<mirror> method fetches the tarball from your JSAN currently configured
JSAN mirror as determined by L<JSAN::Transport> (if not already cached).
Returns a file path to the tarball on the local machine, or may emit an
exception thrown by the underlying L<JSAN::Transport> functions.
=head2 file_mirrored
The C<file_mirrored> method checks to see if the release tarball has previously
been downloaded to the local mirror.
Returns true if the file exists in the local mirror, or false if not.
=head2 archive
The C<archive> method returns the release as an in-memory archive.
Depending on the type, this should be either a L<Archive::Tar> or an
L<Archive::Zip> object.
=head1 SUPPORT
Bugs should be reported via the CPAN bug tracker at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=JSAN-Client>
For other issues, contact the author.
=head1 AUTHOR
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
=head1 SEE ALSO
L<JSAN::Index>, L<JSAN::Shell>, L<http://openjsan.org>
=head1 COPYRIGHT
Copyright 2005 - 2007 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
=head1 NAME
JSAN::Index::Release - JSAN::Index class for the release table
=head1 SYNOPSIS
TO BE COMPLETED
=head1 DESCRIPTION
TO BE COMPLETED
=head1 METHODS
=head2 select
# Get all objects in list context
my @list = JSAN::Index::Release->select;
# Get a subset of objects in scalar context
my $array_ref = JSAN::Index::Release->select(
'where id > ? order by id',
1000,
);
The C<select> method executes a typical SQL C<SELECT> query on the
release table.
It takes an optional argument of a SQL phrase to be added after the
C<FROM release> section of the query, followed by variables
to be bound to the placeholders in the SQL phrase. Any SQL that is
compatible with SQLite can be used in the parameter.
Returns a list of B<JSAN::Index::Release> objects when called in list context, or a
reference to an C<ARRAY> of B<JSAN::Index::Release> objects when called in scalar
context.
Throws an exception on error, typically directly from the L<DBI> layer.
=head2 count
# How many objects are in the table
my $rows = JSAN::Index::Release->count;
# How many objects
my $small = JSAN::Index::Release->count(
'where id > ?',
1000,
);
The C<count> method executes a C<SELECT COUNT(*)> query on the
release table.
It takes an optional argument of a SQL phrase to be added after the
C<FROM release> section of the query, followed by variables
to be bound to the placeholders in the SQL phrase. Any SQL that is
compatible with SQLite can be used in the parameter.
Returns the number of objects that match the condition.
Throws an exception on error, typically directly from the L<DBI> layer.
=head1 ACCESSORS
=head2 id
if ( $object->id ) {
print "Object has been inserted\n";
} else {
print "Object has not been inserted\n";
}
Returns true, or throws an exception on error.
REMAINING ACCESSORS TO BE COMPLETED
=head1 SQL
The release table was originally created with the
following SQL command.
CREATE TABLE release (
id INTEGER PRIMARY KEY NOT NULL,
distribution varchar (
100
)
NOT NULL,
author varchar (
100
)
NOT NULL,
checksum varchar (
100
)
NOT NULL,
created varchar (
100
)
NOT NULL,
doc varchar (
100
)
NOT NULL,
meta text,
latest int (
11
)
NOT NULL,
source varchar (
100
)
NOT NULL,
srcdir varchar (
100
)
NOT NULL,
version varchar (
100
)
)
=head1 SUPPORT
JSAN::Index::Release is part of the L<JSAN::Index> API.
See the documentation for L<JSAN::Index> for more information.
=head1 COPYRIGHT
Copyright 2009 - 2010 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.