r20548 - in /branches/upstream/libarchive-any-perl: ./ current/ current/lib/ current/lib/Archive/ current/lib/Archive/Any/ current/lib/Archive/Any/Plugin/ current/t/
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Fri May 30 15:59:59 UTC 2008
Author: emhn-guest
Date: Fri May 30 15:59:59 2008
New Revision: 20548
URL: http://svn.debian.org/wsvn/?sc=1&rev=20548
Log:
[svn-inject] Installing original source of libarchive-any-perl
Added:
branches/upstream/libarchive-any-perl/
branches/upstream/libarchive-any-perl/current/
branches/upstream/libarchive-any-perl/current/Build.PL
branches/upstream/libarchive-any-perl/current/Changes
branches/upstream/libarchive-any-perl/current/MANIFEST
branches/upstream/libarchive-any-perl/current/META.yml
branches/upstream/libarchive-any-perl/current/Makefile.PL
branches/upstream/libarchive-any-perl/current/README
branches/upstream/libarchive-any-perl/current/lib/
branches/upstream/libarchive-any-perl/current/lib/Archive/
branches/upstream/libarchive-any-perl/current/lib/Archive/Any/
branches/upstream/libarchive-any-perl/current/lib/Archive/Any.pm
branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/
branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin.pm
branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Tar.pm
branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Zip.pm
branches/upstream/libarchive-any-perl/current/t/
branches/upstream/libarchive-any-perl/current/t/00compile.t
branches/upstream/libarchive-any-perl/current/t/Any.t
branches/upstream/libarchive-any-perl/current/t/fail.t
branches/upstream/libarchive-any-perl/current/t/garbage.foo
branches/upstream/libarchive-any-perl/current/t/impolite.tar.gz (with props)
branches/upstream/libarchive-any-perl/current/t/lib.tgz (with props)
branches/upstream/libarchive-any-perl/current/t/lib.zip (with props)
branches/upstream/libarchive-any-perl/current/t/naughty.hominawoof (with props)
branches/upstream/libarchive-any-perl/current/t/naughty.tar (with props)
branches/upstream/libarchive-any-perl/current/t/not_a_zip.zip
branches/upstream/libarchive-any-perl/current/t/pod-coverage.t
branches/upstream/libarchive-any-perl/current/t/pod.t
branches/upstream/libarchive-any-perl/current/t/type.t
Added: branches/upstream/libarchive-any-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/Build.PL?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/Build.PL (added)
+++ branches/upstream/libarchive-any-perl/current/Build.PL Fri May 30 15:59:59 2008
@@ -1,0 +1,18 @@
+
+use Module::Build;
+my $build = Module::Build->new(
+ module_name => "Archive::Any",
+ license => 'perl',
+ requires => {
+ Archive::Tar => 0.22,
+ Archive::Zip => 1.07,
+ Cwd => 0,
+ Module::Find => 0.05,
+ MIME::Types => 1.16,
+ File::MMagic => 1.27,
+ File::Spec::Functions => 0,
+ Test::More => 0.40,
+ Test::Warn => 0,
+ },
+ );
+$build->create_build_script();
Added: branches/upstream/libarchive-any-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/Changes?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/Changes (added)
+++ branches/upstream/libarchive-any-perl/current/Changes Fri May 30 15:59:59 2008
@@ -1,0 +1,53 @@
+0.931
+ - Resisted the urge to make large sweeping changes. Fixed a problem with
+ the tests and called it good.
+0.93
+ - DESTROY ALL TABS! [schwern]
+ - The example for Plugin->can_handle showed the wrong return value.
+ [schwern]
+
+0.92 Sat Aug 26 17:09:21 PDT 2006
+ - Added pod tests and a README for kwalitee. Not exactly a critical
+ update!
+
+0.91 Mon Aug 14 10:35:24 PDT 2006
+ - type() is there now. I'm not in the business of breaking other
+ people's scripts.
+ - Fixed several issues with the pod.
+ - type() is going AWAY AWAY AWAY - use mime_type instead. It
+ actually has useful information.
+ - Added a test for the backwardsness.
+
+0.09 Sun Aug 13 23:25:13 PDT 2006
+ - Complete rework of the module.
+ - Supports simple plugins for adding support for archive formats.
+
+0.06 Wed Oct 29 14:39:15 PST 2003
+ - Updating to Archive::Zip 1.07 which fixes extractTree().
+ * Forgot to include *.tar in the "what is a tarball" logic!
+ [Thanks Kevin Pease]
+ - Minor doc improvements.
+
+0.05 Mon Oct 20 04:28:31 PDT 2003
+ * Archive::Any->new($file, $type) wasn't working (thanks to Simon Wistow
+ for catching this).
+
+0.04 Mon Oct 20 01:53:27 PDT 2003
+ * Removing unzip binary hack around Archive::Zip->extractMember bug.
+ - Working around new extractTree() bug which can cause directories to
+ be unzipped with permissions set to 0000.
+ - Fixing is_impolite() and is_naughty() so they return true or false
+ instead of the scalar result of a grep.
+ - Failing gracefully should Archive::Tar/Zip->new() fail.
+ * Fixing list_archive() and extract_archive() misuse so we work with
+ modern Archive::Tar.
+ - Class::Virtually::Abstract now has a version # on CPAN.
+ * is_naughty() would screw up if the first file in the archive wasn't
+ a lone directory
+
+0.03 Mon Sep 3 22:18:28 EDT 2001
+ * It is now safe to chdir() after creating an Archive::Any object
+
+0.01 Sun Aug 26 02:09:51 EDT 2001
+ * First working version
+ * Archive::Zip is broken. Using unzip binary to extract.
Added: branches/upstream/libarchive-any-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/MANIFEST?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/MANIFEST (added)
+++ branches/upstream/libarchive-any-perl/current/MANIFEST Fri May 30 15:59:59 2008
@@ -1,0 +1,23 @@
+Changes
+lib/Archive/Any.pm
+lib/Archive/Any/Plugin.pm
+lib/Archive/Any/Plugin/Tar.pm
+lib/Archive/Any/Plugin/Zip.pm
+Makefile.PL
+MANIFEST
+META.yml
+t/00compile.t
+t/Any.t
+t/fail.t
+t/garbage.foo
+t/impolite.tar.gz
+t/lib.tgz
+t/lib.zip
+t/naughty.hominawoof
+t/naughty.tar
+t/not_a_zip.zip
+t/type.t
+t/pod.t
+t/pod-coverage.t
+Build.PL
+README
Added: branches/upstream/libarchive-any-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/META.yml?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/META.yml (added)
+++ branches/upstream/libarchive-any-perl/current/META.yml Fri May 30 15:59:59 2008
@@ -1,0 +1,21 @@
+--- #YAML:1.0
+name: Archive-Any
+version: 0.0932
+abstract: ~
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.30_03
+author: ~
+distribution_type: module
+requires:
+ Archive::Tar: 0.22
+ Archive::Zip: 1.07
+ Cwd: 0
+ File::MMagic: 1.27
+ File::Spec::Functions: 0
+ MIME::Types: 1.16
+ Module::Find: 0.05
+ Test::More: 0.4
+ Test::Warn: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-new.html
+ version: 1.1
Added: branches/upstream/libarchive-any-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/Makefile.PL?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/Makefile.PL (added)
+++ branches/upstream/libarchive-any-perl/current/Makefile.PL Fri May 30 15:59:59 2008
@@ -1,0 +1,66 @@
+# A template for Makefile.PL.
+# - Set the $PACKAGE variable to the name of your module.
+# - Set $LAST_API_CHANGE to reflect the last version you changed the API
+# of your module.
+# - Fill in your dependencies in PREREQ_PM
+# Alternatively, you can say the hell with this and use h2xs.
+
+use ExtUtils::MakeMaker;
+
+$PACKAGE = 'Archive::Any';
+($PACKAGE_FILE = $PACKAGE) =~ s|::|/|g;
+$LAST_API_CHANGE = 0;
+
+eval "require $PACKAGE";
+
+unless ($@) { # Make sure we did find the module.
+ print <<"CHANGE_WARN" if ${$PACKAGE.'::VERSION'} < $LAST_API_CHANGE;
+
+NOTE: There have been API changes between this version and any older
+than version $LAST_API_CHANGE! Please read the Changes file if you
+are upgrading from a version older than $LAST_API_CHANGE.
+
+CHANGE_WARN
+}
+
+WriteMakefile(
+ NAME => $PACKAGE,
+ VERSION_FROM => "lib/$PACKAGE_FILE.pm", # finds $VERSION
+ PREREQ_PM => {
+ Archive::Tar => 0.22,
+ Archive::Zip => 1.07,
+ Cwd => 0,
+ Module::Find => 0.05,
+ MIME::Types => 1.16,
+ File::MMagic => 1.27,
+ File::Spec::Functions => 0,
+ Test::More => 0.40,
+ Test::Warn => 0,
+ },
+ 'dist' => {
+ COMPRESS => 'gzip -9',
+ SUFFIX => '.gz',
+ DIST_DEFAULT => 'all tardist',
+ },
+);
+
+
+{
+ package MY;
+
+ sub test_via_harness {
+ my($self, $orig_perl, $tests) = @_;
+
+ my @perls = ($orig_perl);
+ push @perls, qw(bleadperl perl5.005_03 perl5.004_05 perl5.004_04
+ perl5.004)
+ if $ENV{PERL_TEST_ALL};
+
+ my $out;
+ foreach my $perl (@perls) {
+ $out .= $self->SUPER::test_via_harness($perl, $tests);
+ }
+
+ return $out;
+ }
+}
Added: branches/upstream/libarchive-any-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/README?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/README (added)
+++ branches/upstream/libarchive-any-perl/current/README Fri May 30 15:59:59 2008
@@ -1,0 +1,107 @@
+NAME
+ Archive::Any - Single interface to deal with file archives.
+
+SYNOPSIS
+ use Archive::Any;
+
+ my $archive = Archive::Any->new($archive_file);
+
+ my @files = $archive->files;
+
+ $archive->extract;
+
+ my $type = $archive->type;
+
+ $archive->is_impolite;
+ $archive->is_naughty;
+
+DESCRIPTION
+ This module is a single interface for manipulating different archive
+ formats. Tarballs, zip files, etc.
+
+ new
+ my $archive = Archive::Any->new($archive_file);
+ my $archive = Archive::Any->new($archive_file, $type);
+
+ $type is optional. It lets you force the file type in-case
+ Archive::Any can't figure it out.
+
+ extract
+ $archive->extract;
+ $archive->extract($directory);
+
+ Extracts the files in the archive to the given $directory. If no
+ $directory is given, it will go into the current working directory.
+
+ files
+ my @file = $archive->files;
+
+ A list of files in the archive.
+
+ mime_type
+ my $mime_type = $archive->mime_type();
+
+ Returns the mime type of the archive.
+
+ is_impolite
+ my $is_impolite = $archive->is_impolite;
+
+ Checks to see if this archive is going to unpack into the current
+ directory rather than create its own.
+
+ is_naughty
+ my $is_naughty = $archive->is_naughty;
+
+ Checks to see if this archive is going to unpack outside the current
+ directory.
+
+DEPRECATED
+ type
+ my $type = $archive->type;
+
+ Returns the type of archive. This method is provided for backwards
+ compatibility in the Tar and Zip plugins and will be going away soon
+ in favor of "mime_type".
+
+PLUGINS
+ For detailed information on writing plugins to work with Archive::Any,
+ please see the pod documentation for Archive::Any::Plugin.
+
+AUTHOR
+ Clint Moore <cmoore at cpan.org>
+
+AUTHOR EMERITUS
+ Michael G Schwern
+
+SEE ALSO
+ Archive::Any::Plugin
+
+SUPPORT
+ You can find documentation for this module with the perldoc command.
+
+ perldoc Archive::Any
+
+ You can also look for information at:
+
+ * AnnoCPAN: Annotated CPAN documentation
+
+ <http://annocpan.org/dist/Archive-Any>
+
+ * CPAN Ratings
+
+ <http://cpanratings.perl.org/d/Archive-Any>
+
+ * RT: CPAN's request tracker
+
+ <http://rt.cpan.org/NoAuth/Bugs.html?Dist=Archive-Any>
+
+ * Search CPAN
+
+ <http://search.cpan.org/dist/Archive-Any>
+
+LICENSE
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+ See <http://www.perl.com/perl/misc/Artistic.html>
+
Added: branches/upstream/libarchive-any-perl/current/lib/Archive/Any.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/lib/Archive/Any.pm?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/lib/Archive/Any.pm (added)
+++ branches/upstream/libarchive-any-perl/current/lib/Archive/Any.pm Fri May 30 15:59:59 2008
@@ -1,0 +1,233 @@
+
+=head1 NAME
+
+Archive::Any - Single interface to deal with file archives.
+
+=head1 SYNOPSIS
+
+ use Archive::Any;
+
+ my $archive = Archive::Any->new($archive_file);
+
+ my @files = $archive->files;
+
+ $archive->extract;
+
+ my $type = $archive->type;
+
+ $archive->is_impolite;
+ $archive->is_naughty;
+
+=head1 DESCRIPTION
+
+This module is a single interface for manipulating different archive formats. Tarballs, zip files, etc.
+
+=over 4
+
+=item B<new>
+
+ my $archive = Archive::Any->new($archive_file);
+ my $archive = Archive::Any->new($archive_file, $type);
+
+$type is optional. It lets you force the file type in-case Archive::Any can't figure it out.
+
+=item B<extract>
+
+ $archive->extract;
+ $archive->extract($directory);
+
+Extracts the files in the archive to the given $directory. If no $directory is given, it will go into the current working directory.
+
+=item B<files>
+
+ my @file = $archive->files;
+
+A list of files in the archive.
+
+=item B<mime_type>
+
+ my $mime_type = $archive->mime_type();
+
+Returns the mime type of the archive.
+
+=item B<is_impolite>
+
+ my $is_impolite = $archive->is_impolite;
+
+Checks to see if this archive is going to unpack into the current directory rather than create its own.
+
+=item B<is_naughty>
+
+ my $is_naughty = $archive->is_naughty;
+
+Checks to see if this archive is going to unpack B<outside> the current directory.
+
+=back
+
+=head1 DEPRECATED
+
+=over 4
+
+=item B<type>
+
+ my $type = $archive->type;
+
+Returns the type of archive. This method is provided for backwards compatibility in the Tar and Zip plugins and will be going away B<soon> in favor of C<mime_type>.
+
+=back
+
+=head1 PLUGINS
+
+For detailed information on writing plugins to work with Archive::Any, please see the pod documentation for L<Archive::Any::Plugin>.
+
+=head1 AUTHOR
+
+Clint Moore E<lt>cmoore at cpan.orgE<gt>
+
+=head1 AUTHOR EMERITUS
+
+Michael G Schwern
+
+=head1 SEE ALSO
+
+Archive::Any::Plugin
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Archive::Any
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Archive-Any>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Archive-Any>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Archive-Any>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Archive-Any>
+
+=back
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+package Archive::Any;
+use strict;
+use warnings;
+
+use vars qw($VERSION);
+$VERSION = 0.0932;
+
+use Archive::Any::Plugin;
+use File::Spec::Functions qw( rel2abs splitdir );
+use File::MMagic;
+use MIME::Types qw(by_suffix);
+
+sub new {
+ my ( $class, $file, $type ) = @_;
+
+ $file = rel2abs($file);
+ return unless -f $file;
+
+ my %available;
+
+ my @plugins = Archive::Any::Plugin->findsubmod;
+ foreach my $plugin (@plugins) {
+ eval "require $plugin";
+ next if $@;
+
+ my @types = $plugin->can_handle();
+ foreach my $type ( @types ) {
+ next if exists( $available{$type} );
+ $available{$type} = $plugin;
+ }
+ }
+
+ my $mime_type;
+
+ if ($type) {
+ # The user forced the type.
+ ($mime_type) = by_suffix($type);
+ unless( $mime_type ) {
+ warn "No mime type found for type '$type'";
+ return;
+ }
+ } else {
+ # Autodetect the type.
+ $mime_type = File::MMagic->new()->checktype_filename($file);
+ }
+
+ my $handler = $available{$mime_type};
+ if( ! $handler ) {
+ warn "No handler available for type '$mime_type'";
+ return;
+ }
+
+ return bless {
+ file => $file,
+ handler => $handler,
+ type => $mime_type,
+ }, $class;
+}
+
+sub extract {
+ my $self = shift;
+ my $dir = shift;
+
+ return defined($dir)
+ ? $self->{handler}->_extract( $self->{file}, $dir )
+ : $self->{handler}->_extract( $self->{file} );
+}
+
+sub files {
+ my $self = shift;
+ return $self->{handler}->files( $self->{file} );
+}
+
+sub is_impolite {
+ my $self = shift;
+
+ my @files = $self->files;
+ my $first_file = $files[0];
+ my ($first_dir) = splitdir($first_file);
+
+ return grep( !/^\Q$first_dir\E/, @files ) ? 1 : 0;
+}
+
+sub is_naughty {
+ my ($self) = shift;
+ return ( grep { m{^(?:/|(?:\./)*\.\./)} } $self->files ) ? 1 : 0;
+}
+
+sub mime_type {
+ my $self = shift;
+ return $self->{type};
+}
+
+#
+# This is not really here. You are not seeing this.
+#
+sub type {
+ my $self = shift;
+ return $self->{handler}->type();
+}
+# End of what you are not seeing.
+
+1;
Added: branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin.pm?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin.pm (added)
+++ branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin.pm Fri May 30 15:59:59 2008
@@ -1,0 +1,91 @@
+package Archive::Any::Plugin;
+
+use strict;
+use warnings;
+
+use Module::Find;
+use Cwd;
+
+=head1 NAME
+
+Archive::Any::Plugin - Anatomy of an Archive::Any plugin.
+
+=head1 SYNOPSIS
+
+Explains what is required for a working plugin to Archive::Any.
+
+=head1 PLUGINS
+
+Archive::Any requires that your plugin define three methods, all of which are passed the absolute filename of the file. This module uses the source of Archive::Any::Plugin::Tar as an example.
+
+=over 4
+
+=item B<Subclass Archive::Any::Plugin>
+
+ use base 'Archive::Any::Plugin';
+
+=item B<can_handle>
+
+This returns an array of mime types that the plugin can handle.
+
+ sub can_handle {
+ return(
+ 'application/x-tar',
+ 'application/x-gtar',
+ 'application/x-gzip',
+ );
+ }
+
+=item B<files>
+
+Return a list of items inside the archive.
+
+ sub files {
+ my( $self, $file ) = @_;
+ my $t = Archive::Tar->new( $file );
+ return $t->list_files;
+ }
+
+=item B<extract>
+
+This method should extract the contents of $file to the current directory. L<Archive::Any::Plugin> handles negotiating directories for you.
+
+ sub extract {
+ my ( $self, $file ) = @_;
+
+ my $t = Archive::Tar->new( $file );
+ return $t->extract;
+ }
+
+=back
+
+=head1 AUTHOR
+
+Clint Moore E<lt>cmoore at cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+Archive::Any
+
+=cut
+
+
+sub _extract {
+ my($self, $file, $dir) = @_;
+
+ my $orig_dir;
+ if( defined $dir ) {
+ $orig_dir = getcwd;
+ chdir $dir;
+ }
+
+ my $success = $self->extract( $file );
+
+ if( defined $dir) {
+ chdir $orig_dir;
+ }
+
+ return 1;
+}
+
+1;
Added: branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Tar.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Tar.pm?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Tar.pm (added)
+++ branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Tar.pm Fri May 30 15:59:59 2008
@@ -1,0 +1,50 @@
+package Archive::Any::Plugin::Tar;
+use strict;
+use base 'Archive::Any::Plugin';
+
+use Archive::Tar;
+use Cwd;
+
+=head1 NAME
+
+Archive::Any::Plugin::Tar - Archive::Any wrapper around Archive::Tar
+
+=head1 SYNOPSIS
+
+Do not use this module directly. Instead, use Archive::Any.
+
+=cut
+
+sub can_handle {
+ return(
+ 'application/x-tar',
+ 'application/x-gtar',
+ 'application/x-gzip',
+ );
+}
+
+sub files {
+ my( $self, $file ) = @_;
+ my $t = Archive::Tar->new( $file );
+ return $t->list_files;
+}
+
+sub extract {
+ my ( $self, $file ) = @_;
+
+ my $t = Archive::Tar->new( $file );
+ return $t->extract;
+}
+
+sub type {
+ my $self = shift;
+ return 'tar';
+}
+
+=head1 SEE ALSO
+
+Archive::Any, Archive::Tar
+
+=cut
+
+1;
Added: branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Zip.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Zip.pm?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Zip.pm (added)
+++ branches/upstream/libarchive-any-perl/current/lib/Archive/Any/Plugin/Zip.pm Fri May 30 15:59:59 2008
@@ -1,0 +1,64 @@
+package Archive::Any::Plugin::Zip;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = 0.03;
+
+use base qw(Archive::Any::Plugin);
+
+use Archive::Zip qw(:ERROR_CODES);
+
+=head1 NAME
+
+Archive::Any::Plugin::Zip - Archive::Any wrapper around Archive::Zip
+
+=head1 SYNOPSIS
+
+B<DO NOT USE THIS MODULE DIRECTLY>
+
+Use Archive::Any instead.
+
+=head1 DESCRIPTION
+
+Wrapper around Archive::Zip for Archive::Any.
+
+=cut
+
+sub can_handle {
+ return(
+ 'application/x-zip',
+ 'application/x-jar',
+ 'application/zip',
+ );
+}
+
+sub files {
+ my( $self, $file ) = @_;
+
+ my $z = Archive::Zip->new( $file );
+ return $z->memberNames;
+}
+
+
+sub extract {
+ my($self, $file) = @_;
+
+ my $z = Archive::Zip->new( $file );
+ $z->extractTree;
+
+ return 1;
+}
+
+sub type {
+ my $self = shift;
+ return 'zip';
+}
+
+
+=head1 SEE ALSO
+
+Archive::Any, Archive::Zip
+
+=cut
+
+1;
Added: branches/upstream/libarchive-any-perl/current/t/00compile.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/00compile.t?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/00compile.t (added)
+++ branches/upstream/libarchive-any-perl/current/t/00compile.t Fri May 30 15:59:59 2008
@@ -1,0 +1,8 @@
+#!/usr/bin/perl -w
+
+use Test::More 'no_plan';
+
+use_ok('Archive::Any');
+use_ok('Archive::Any::Plugin');
+use_ok('Archive::Any::Plugin::Zip');
+use_ok('Archive::Any::Plugin::Tar');
Added: branches/upstream/libarchive-any-perl/current/t/Any.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/Any.t?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/Any.t (added)
+++ branches/upstream/libarchive-any-perl/current/t/Any.t Fri May 30 15:59:59 2008
@@ -1,0 +1,109 @@
+#!/usr/bin/perl -w
+
+use Test::More 'no_plan';
+
+use Archive::Any;
+use File::Spec::Functions qw(updir);
+
+my %tests = (
+ 't/lib.zip' => {
+ impolite=> 0,
+ naughty => 0,
+ handler => 'Archive::Any::Plugin::Zip',
+ type => 'zip',
+ files => [qw(
+ lib/
+ lib/Archive/
+ lib/Archive/Any.pm
+ lib/Archive/Any/
+ lib/Archive/Any/Tar.pm
+ lib/Archive/Any/Zip.pm
+ lib/Archive/Any/Zip.pm~
+ lib/Archive/Any/Tar.pm~
+ lib/Archive/Any.pm~
+ )],
+ },
+ 't/lib.tgz' => {
+ impolite => 0,
+ naughty => 0,
+ handler => 'Archive::Any::Plugin::Tar',
+ type => 'tar',
+ files => [qw(
+ lib/
+ lib/Archive/
+ lib/Archive/Any.pm
+ lib/Archive/Any/
+ lib/Archive/Any/Tar.pm
+ lib/Archive/Any/Zip.pm
+ lib/Archive/Any/Zip.pm~
+ lib/Archive/Any/Tar.pm~
+ lib/Archive/Any.pm~
+ )],
+ },
+ 't/impolite.tar.gz' => {
+ impolite => 1,
+ naughty => 0,
+ handler => 'Archive::Any::Plugin::Tar',
+ type => 'tar',
+ files => [qw(
+ type.t
+ Any.t
+ 00compile.t
+ fail.t
+ )],
+ },
+ 't/naughty.tar' => {
+ impolite => 0,
+ naughty => 1,
+ handler => 'Archive::Any::Plugin::Tar',
+ type => 'tar',
+ files => [qw(
+ /tmp/lib/
+ /tmp/lib/Archive/
+ /tmp/lib/Archive/Any/
+ /tmp/lib/Archive/Any/Tar.pm
+ /tmp/lib/Archive/Any/Zip.pm
+ /tmp/lib/Archive/Any.pm
+ )],
+ },
+);
+
+
+while( my($file, $expect) = each %tests ) {
+ # Test it once with type auto-discover and once with the type
+ # forced. Forced typing was broken until 0.05.
+ test_archive($file, $expect);
+ test_archive($file, $expect, $expect->{type});
+}
+
+sub test_archive {
+ my($file, $expect, $type) = @_;
+
+ my $archive = Archive::Any->new($file, $type);
+
+ # And now we chdir out from under it. This causes serious problems
+ # if we're not careful to use absolute paths internally.
+ chdir('t');
+
+ ok( defined $archive, "new($file)" );
+ ok( $archive->isa('Archive::Any'), " it's an object" );
+
+ ok( eq_set([$archive->files], $expect->{files}),
+ ' lists the right files' );
+ ok( $archive->type(), "backwards compatibility" );
+
+# is( $archive->handler, $expect->{handler}, ' right handler' );
+
+ is( $archive->is_impolite, $expect->{impolite}, " impolite?" );
+ is( $archive->is_naughty, $expect->{naughty}, " naughty?" );
+
+ unless( $archive->is_impolite || $archive->is_naughty ) {
+ ok($archive->extract(), "extract($file)");
+ foreach my $file (reverse $archive->files) {
+ ok( -e $file, " $file" );
+ -d $file ? rmdir $file : unlink $file;
+ }
+ }
+
+ chdir(updir);
+}
Added: branches/upstream/libarchive-any-perl/current/t/fail.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/fail.t?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/fail.t (added)
+++ branches/upstream/libarchive-any-perl/current/t/fail.t Fri May 30 15:59:59 2008
@@ -1,0 +1,7 @@
+#!/usr/bin/perl -w
+
+use Archive::Any;
+use Test::More tests => 1;
+
+chdir 't';
+ok( !Archive::Any->new("im_not_really_a.zip") );
Added: branches/upstream/libarchive-any-perl/current/t/garbage.foo
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/garbage.foo?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/garbage.foo (added)
+++ branches/upstream/libarchive-any-perl/current/t/garbage.foo Fri May 30 15:59:59 2008
@@ -1,0 +1,1 @@
+DON'T YOU HURT THAT LLAMA, MIKEY!!
Added: branches/upstream/libarchive-any-perl/current/t/impolite.tar.gz
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/impolite.tar.gz?rev=20548&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libarchive-any-perl/current/t/impolite.tar.gz
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libarchive-any-perl/current/t/lib.tgz
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/lib.tgz?rev=20548&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libarchive-any-perl/current/t/lib.tgz
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libarchive-any-perl/current/t/lib.zip
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/lib.zip?rev=20548&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libarchive-any-perl/current/t/lib.zip
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libarchive-any-perl/current/t/naughty.hominawoof
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/naughty.hominawoof?rev=20548&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libarchive-any-perl/current/t/naughty.hominawoof
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libarchive-any-perl/current/t/naughty.tar
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/naughty.tar?rev=20548&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libarchive-any-perl/current/t/naughty.tar
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libarchive-any-perl/current/t/not_a_zip.zip
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/not_a_zip.zip?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/not_a_zip.zip (added)
+++ branches/upstream/libarchive-any-perl/current/t/not_a_zip.zip Fri May 30 15:59:59 2008
@@ -1,0 +1,7 @@
+#!/usr/bin/perl -w
+
+use Archive::Any;
+use Test::More tests => 1;
+
+chdir 't';
+ok( !Archive::Any->new("im_not_really_a.zip") );
Added: branches/upstream/libarchive-any-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/pod-coverage.t?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libarchive-any-perl/current/t/pod-coverage.t Fri May 30 15:59:59 2008
@@ -1,0 +1,9 @@
+
+use Test::More;
+
+eval "use Test::Pod::Coverage";
+plan skip_all => "Test::Pod::Coverage required for testing POD" if $@;
+
+plan tests => 2;
+pod_coverage_ok( "Archive::Any", "Pod documentation coverage" );
+pod_coverage_ok( "Archive::Any::Plugin", "Plugin documentation coverage" );
Added: branches/upstream/libarchive-any-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/pod.t?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/pod.t (added)
+++ branches/upstream/libarchive-any-perl/current/t/pod.t Fri May 30 15:59:59 2008
@@ -1,0 +1,7 @@
+
+use Test::More;
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+
Added: branches/upstream/libarchive-any-perl/current/t/type.t
URL: http://svn.debian.org/wsvn/branches/upstream/libarchive-any-perl/current/t/type.t?rev=20548&op=file
==============================================================================
--- branches/upstream/libarchive-any-perl/current/t/type.t (added)
+++ branches/upstream/libarchive-any-perl/current/t/type.t Fri May 30 15:59:59 2008
@@ -1,0 +1,19 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 7;
+use Test::Warn;
+
+use_ok 'Archive::Any';
+
+isa_ok( Archive::Any->new('t/naughty.tar', 'tar'), 'Archive::Any' );
+
+# Recognizes tar files with weird extensions
+isa_ok( Archive::Any->new('t/naughty.hominawoof'), 'Archive::Any' );
+
+warning_like {
+ ok( !Archive::Any->new('t/naughty.tar', 'hominawoof') );
+} qr{No mime type found for type 'hominawoof'}, "right warning, unknown type";
+
+warning_like {
+ ok( !Archive::Any->new('t/garbage.foo' ) );
+} qr{No handler available for type 'text/plain'}, "right warning, no type";
More information about the Pkg-perl-cvs-commits
mailing list