#!/usr/bin/perl
# Basic test for JSAN::Index
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use Test::More;
use Params::Util qw{ _HASH _HASHLIKE };
use File::Remove 'remove';
use LWP::Online 'online';
BEGIN { remove( \1, 'temp' ) if -e 'temp'; }
END { remove( \1, 'temp' ) if -e 'temp'; }
use JSAN::Index;
JSAN::Index->init({
mirror_local => 'temp',
prune => 1
});
if ( online() ) {
plan( tests => 52 );
} else {
plan( skip_all => "Skipping online tests" );
exit(0);
}
#####################################################################
# Testing ::Author
# Test a known-good author
SCOPE: {
my $adamk = JSAN::Index::Author->retrieve( login => 'adamk' );
isa_ok( $adamk, 'JSAN::Index::Author' );
is( $adamk->login, 'adamk', 'Author->login returns as expected' );
is( $adamk->name, 'Adam Kennedy', 'Author->name returns as expected' );
like( $adamk->doc, qr{^/}, 'Author->doc returns a root-relative path' );
like( $adamk->email, qr{^[\w.-]+\@[\w-]+(?:\.[\w-]+)*$}, 'Author->email returns an email address' );
like( $adamk->url, qr{^http://}, 'Author->url returns a URI' );
my @releases = @{$adamk->releases};
ok( scalar(@releases), '->releases works' );
isa_ok( $releases[0], 'JSAN::Index::Release');
}
#####################################################################
# Testing ::Distribution
# Test a known-good distribution
SCOPE: {
my $swapdist = JSAN::Index::Distribution->retrieve( name => 'Display.Swap' );
isa_ok( $swapdist, 'JSAN::Index::Distribution' );
is( $swapdist->name, 'Display.Swap', 'Distribution->name matches expected' );
like( $swapdist->doc, qr{^/}, 'Distribution->doc returns a root-relative path' );
my @releases = @{$swapdist->releases};
ok( scalar(@releases), '->releases works' );
isa_ok( $releases[0], 'JSAN::Index::Release');
isa_ok( $swapdist->latest_release, 'JSAN::Index::Release' );
# Is extractable
can_ok( $swapdist, 'extract_libs', 'extract_tests', 'extract_resource' );
}
#####################################################################
# Testing ::Release
#####################################################################
# Find a known release
my $swaprel = JSAN::Index::Release->retrieve(
source => '/dist/a/ad/adamk/Display.Swap-0.01.tar.gz',
);
isa_ok( $swaprel, 'JSAN::Index::Release' );
isa_ok( $swaprel->distribution, 'JSAN::Index::Distribution' );
isa_ok( $swaprel->author, 'JSAN::Index::Author' );
ok( $swaprel->source, '::Release has a ->source' );
#####################################################################
# Clear out any existing file
my $swaprel_file = $swaprel->file_path;
ok( $swaprel_file, '::Release->file_path returns a value' );
SKIP: {
skip( "Don't need to predelete file", 2 ) unless -f $swaprel_file;
ok(
scalar(remove( \1, $swaprel_file )),
"Removing existing release file $swaprel_file",
);
ok( ! -f $swaprel_file, 'File was removed' );
}
is( $swaprel->file_mirrored, '', '::Release->file_mirrored returns false when no file' );
#####################################################################
# Attempt to mirror the file twice. This should exercise both the normal
# and shortcut logic.
is( $swaprel->mirror, $swaprel_file, '->mirror returns the file path' );
ok( -f $swaprel_file, "->mirror actually fetched file" );
ok( $swaprel->file_mirrored, '::Release->file_mirrored returns true when file exists' );
is( $swaprel->mirror, $swaprel_file, '->mirror return the file path on the second (shortcut) call' );
#####################################################################
# Get the archive object directly
isa_ok( $swaprel->archive, 'Archive::Tar' );
#####################################################################
# Load the META.yaml data for the release
my $meta = $swaprel->meta_data;
ok( _HASHLIKE($meta), '::Release->meta_data returns a HASH' );
#####################################################################
# Is it extractable
can_ok( $swaprel, 'extract_libs', 'extract_tests', 'extract_resource' );
#####################################################################
# Can we find its dependencies
is_deeply( scalar($swaprel->requires), {}, '::Release->requires returns an empty hash for known-null deps' );
is_deeply(
[ $swaprel->requires_libraries ], [ ],
'::Release->requires_libraries for known no-deps returns null list',
);
is_deeply(
[ $swaprel->requires_releases ], [ ],
'::Release->requires_releases for known no-deps returns null list',
);
#####################################################################
# Repeat for something we know has deps
my $hasdeps = JSAN::Index::Release->retrieve( source => '/dist/a/ad/adamk/Display.Swap-0.09.tar.gz' );
my $display = JSAN::Index::Library->retrieve( name => 'Display' );
my $jsan = JSAN::Index::Library->retrieve( name => 'JSAN' );
isa_ok( $hasdeps, 'JSAN::Index::Release' );
isa_ok( $display, 'JSAN::Index::Library' );
isa_ok( $jsan, 'JSAN::Index::Library' );
my $deps = $hasdeps->requires;
is( ref($deps), 'HASH', '::Release returns a HASH for known deps release' );
ok( defined($deps->{Display}), 'Display.Swap depends on Display as expected' );
ok( defined($deps->{JSAN}), 'Display.Swap depends on JSAN as expected' );
is_deeply(
[ $hasdeps->requires_libraries ], [ $display, $jsan ],
'::Release->requires_libraries returns as expected for known-deps release',
);
my @hasdeps_releases = $hasdeps->requires_releases;
is(
scalar(@hasdeps_releases), 2,
'::Release->requires_releases returns 2 items for known-deps release',
);
isa_ok( $hasdeps_releases[0], 'JSAN::Index::Release' );
isa_ok( $hasdeps_releases[1], 'JSAN::Index::Release' );
#####################################################################
# Testing ::Library
# Find a known library
my $swaplib = JSAN::Index::Library->retrieve( name => 'Display.Swap' );
isa_ok( $swaplib, 'JSAN::Index::Library' );
isa_ok( $swaplib->distribution, 'JSAN::Index::Distribution' );
isa_ok( $swaplib->release, 'JSAN::Index::Release' );
ok( $swaplib->version, 'Library->version returns true' );
like( $swaplib->doc, qr{^/}, 'Library->doc returns a root-relative path' );
is_deeply(
$swaplib->distribution, $swaplib->release->distribution,
'->release->distribution matches ->distribution',
);
# Is extractable
can_ok( $swaplib, 'extract_libs', 'extract_tests', 'extract_resource' );
#####################################################################
# More Interesting Tests
my $file = $swaplib->release->mirror;
ok( $file, 'Library->release->mirror returns true' );
ok( -f $file, 'Library->release->mirror exists' );