Archive-Any-0.0932/0000755000076600007660000000000011003772201013254 5ustar cmoorecmooreArchive-Any-0.0932/Build.PL0000644000076600007660000000164310477440447014576 0ustar cmoorecmoore 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(); Archive-Any-0.0932/Changes0000644000076600007660000000405611003701140014546 0ustar cmoorecmoore0.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. Archive-Any-0.0932/lib/0000755000076600007660000000000010500171730014023 5ustar cmoorecmooreArchive-Any-0.0932/lib/Archive/0000755000076600007660000000000011003771161015407 5ustar cmoorecmooreArchive-Any-0.0932/lib/Archive/Any/0000755000076600007660000000000010500171730016133 5ustar cmoorecmooreArchive-Any-0.0932/lib/Archive/Any/Plugin/0000755000076600007660000000000010500171730017371 5ustar cmoorecmooreArchive-Any-0.0932/lib/Archive/Any/Plugin/Tar.pm0000644000076600007660000000135710477440447020504 0ustar cmoorecmoorepackage 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; Archive-Any-0.0932/lib/Archive/Any/Plugin/Zip.pm0000644000076600007660000000156010477440447020514 0ustar cmoorecmoorepackage 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 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; Archive-Any-0.0932/lib/Archive/Any/Plugin.pm0000644000076600007660000000305310477440447017751 0ustar cmoorecmoorepackage 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 use base 'Archive::Any::Plugin'; =item B 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 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 This method should extract the contents of $file to the current directory. L handles negotiating directories for you. sub extract { my ( $self, $file ) = @_; my $t = Archive::Tar->new( $file ); return $t->extract; } =back =head1 AUTHOR Clint Moore Ecmoore@cpan.orgE =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; Archive-Any-0.0932/lib/Archive/Any.pm0000644000076600007660000001113411003771161016474 0ustar cmoorecmoore =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 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 $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 my @file = $archive->files; A list of files in the archive. =item B my $mime_type = $archive->mime_type(); Returns the mime type of the archive. =item B 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 my $is_naughty = $archive->is_naughty; Checks to see if this archive is going to unpack B the current directory. =back =head1 DEPRECATED =over 4 =item B 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 in favor of C. =back =head1 PLUGINS For detailed information on writing plugins to work with Archive::Any, please see the pod documentation for L. =head1 AUTHOR Clint Moore Ecmoore@cpan.orgE =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 =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =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 =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; Archive-Any-0.0932/Makefile.PL0000644000076600007660000000321711003720321015225 0ustar cmoorecmoore# 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; } } Archive-Any-0.0932/MANIFEST0000644000076600007660000000050711003771744014422 0ustar cmoorecmooreChanges 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 Archive-Any-0.0932/META.yml0000644000076600007660000000126111003771415014533 0ustar cmoorecmoore--- #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 Archive-Any-0.0932/README0000644000076600007660000000512710477440447014163 0ustar cmoorecmooreNAME 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 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 * CPAN Ratings * RT: CPAN's request tracker * Search CPAN LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See Archive-Any-0.0932/t/0000755000076600007660000000000011003772165013530 5ustar cmoorecmooreArchive-Any-0.0932/t/00compile.t0000644000076600007660000000026110477440447015515 0ustar cmoorecmoore#!/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'); Archive-Any-0.0932/t/Any.t0000644000076600007660000000547710477440447014472 0ustar cmoorecmoore#!/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); } Archive-Any-0.0932/t/fail.t0000644000076600007660000000017610477440447014645 0ustar cmoorecmoore#!/usr/bin/perl -w use Archive::Any; use Test::More tests => 1; chdir 't'; ok( !Archive::Any->new("im_not_really_a.zip") ); Archive-Any-0.0932/t/garbage.foo0000644000076600007660000000004310477440447015633 0ustar cmoorecmooreDON'T YOU HURT THAT LLAMA, MIKEY!! Archive-Any-0.0932/t/impolite.tar.gz0000644000076600007660000000244310477440447016515 0ustar cmoorecmoore#tDXmo6W\ [$Y>4]-l-1T$}Gu`Sݑ<iYQSl uxۭ̿m[;ujڱFV48$q}!Bnz.ԮRQt.p`pƑrM8 L;3>2*G=?o[ۍFn?ôse@N낸q]l|zù6ͫWZ%peG}*;$+q(qYNS0 L'\@xo`@5Q*/BLsPC_ÐD sgw7 .c-{2?xw+:ڿmh?ny]oj՜w5<6|7`cf p~cSZP\'Z6ÀY.1N uٷ\7Lu9{5 i Mv'7P fKmxz踬/9_!.Km9"c-F&`E4[$]GLn³ v'g?. 7vB)) a^iC`Z'a 3O@@%2@/6 \.ɔ2|?ȇMi @+J3As)DS!Lߠpse1gh߱GV"spf FޕY~wf ,,}6 jm>-u7bԎ# ܙr,~&eJ"'3xP^ɶB=EhEx$"[l귈۰lZqi^:!*o@^^;NÊA0p8* y#A87CyM9 #΄f>NDLj~3|Ĕ{JdjJСZz l Xw&Xp2f2bKAi8N-5p,-O*veRZh(/2|}бCg$[-c>"&Uťat\7tq:hQwe۟tF䯇TJJJKBrg!ae1uɕC+hӭV7`vԳ)5BM,V2#(;nІ>`9GȄB}oJt%<03lxC( ՂL=q&Z? E&fABY&X.Av˽\,inE]?ᯜebђT#Ve֔H̀i0[佹Z=MYиqpDH0QJmxn.3%INq3M&U;j)$5]QX(ЅCk8vbizQ"Zc %}]uI]akMb֛F,Mf緫k:;۱@EЂJz_q,g[Sr9L濙߷vWwWeEf9}s_O.KǣWfEڿ KgJ,#swOOf $&LXlXd<;8v //N_e_ XUW_s&U+RJˢ"JI{ [Hul ɝw)o+ǯA%8*7FaRH_QZU Jm$^GD'emy˖ Q5L'3g$GL9=B~YnbɅPvzDMD*+"m'^V"otE"yז~U8_'X{o֚_kX |ްwiѪVcq1=>>h~A><}lhdfS ] {߳Isk%EwK΄`2 K DPM,!.JAI}ן"V?=VWs7M~]5H舃5tX1mc`VFVN<_ D0,[>.7|_ Twn2_ pҪ#aZ^vR#2-ʶcߧd']$}L2 V֚{սWTx`-J#nEE, * _tCC^'^V=8S(_XQ A_Џ>OS?ԏ>S\3.sYP3FJ?!Z&-ԞĂ>bIk_4hРA 4hРA 4hzpPArchive-Any-0.0932/t/lib.zip0000644000076600007660000001260510477440447015037 0ustar cmoorecmoorePK 5lib/UT FD-GDUxPK  5 lib/Archive/UT 0D-GDUxPK  5À lib/Archive/Any.pmUT 0DFDUxVmo6[k `;0샓vˇ$] 5%"*I<ݑzE{cװ^Pq'p3DGxD3!!- 8X1g,MoQ`2ei~0@i8l=||GI kc"2ޭMeРG3j&]|Ljlyy2aQ'\ʻ.>_}* *. (>hҐ3)2c$K UUrf²G+F .JMf #_UZX]B`ʢPJd099W\Ïh ־Ѣ"/4gSw# x9+yHO[CGXXqV@Ta,C,dX&OGшJĢD|=C?8Q wVGhȄLeXm~ð *MOi؏EO |خ #*ީ2X( J?]>e05d =3Dqmk4Avb,.R=p Ոr?e/`A3hbGn @lإMZJ۹VG}{mDGnP8ۻ QxaK%L2;2c\=[PG װlDAwZP;3>mz7m لZ98O;pVh8|Wʈv< 9-uvO,]E؟\0]`ْhhM9\pFzA!t ʷt3?pQ3#1OhxJE}Q͜ƳMõqiV7 9]ceLZs8oJ*gQG + "E0mD0 "\"ؐy|E\YނDMp ྔ=T`P2Z2Z$9W@HkY0se8I5oQ G.Ƚȹh/Ctct>own7DGۉW|s˅һluQKʴU¾y%BZV & p.+r͚\f,k=z19ܬF'L9[dm|.(F,;pMfԹʧxg2KVB_Fa?㿣څ?PKN 5q,lib/Archive/Any/Zip.pmUT $1DFDUx]o08RavPD * d!54}ii|e󼯏OAOrdgfYNvI2Jp3~ {0wCgd|6;fUU?.%G pQu2߁1Bq@D~=>yc}.}6! a/7+ K7h4Ch#I9-/1ҏD !=T'<퀒ll0xEId& 5-(g.[Sq :J&%08tew =qсnƳ5F2,1ᑔZa/JޕB{.*5Zǭ.?5Ln4h)ZMUo zAk6zWGx h)M:mO4 jgD~КӘBH\,jaxx_-VDHӿ)y T*Rޢa.z3NF'ٱvUʢjBGxj BJx4MA%<3lc -u.TZ2sT5 Ez;ݳ)P p*s@㵁 ]U{횣D P5@zq#nzց6/Ɂ+LeK)gjTQ [O F lza ATiCu+UӵMܞSFɲ P_N{\ #Bc~a,-QYI?azýOc~y謁PKH 5<lib/Archive/Any/Tar.pm~UT (DFDUx]o0+E%Xk$  iB14lM9m|> ;&n6D8 f#c_ mՑW"$X_:3Vd]Ht +w- vR EYԁT/@da`|0x.mdzT329fk1%!`BR!$PmE)L"zu6H9%ه0VD؃h~¾|NL/o=$K};:m,% ;Fg4RmkaG%U .V鿭0ewajɔ4Tm{f"^e2ѓ!pnH|: BQS B[?rSbnd͵ڮoN96)]V6q;Ʈerϰҍ93qQ#^!OؿPK 5 Alib/UTFDUxPK  5 A7lib/Archive/UT0DUxPK  5À  vlib/Archive/Any.pmUT0DUxPK N 5 ADlib/Archive/Any/UT$1DUxPK 5:=s lib/Archive/Any/Tar.pmUT$,DUxPKN 5q, ulib/Archive/Any/Zip.pmUT$1DUxPK 5ʜa  lib/Archive/Any/Zip.pm~UTFDUxPKH 5<  lib/Archive/Any/Tar.pm~UT(DUxPKb 5s  lib/Archive/Any.pm~UT*DUxPK Archive-Any-0.0932/t/naughty.hominawoof0000644000076600007660000005000010477440447017303 0ustar cmoorecmoore/tmp/lib/0000755000076500000000000000000010467261037011653 5ustar cmoorewheel/tmp/lib/Archive/0000755000076500000000000000000010467261263013235 5ustar cmoorewheel/tmp/lib/Archive/Any/0000755000076500000000000000000010467261243013762 5ustar cmoorewheel/tmp/lib/Archive/Any/Tar.pm0000644000076500000000000000153510467261037015053 0ustar cmoorewheelpackage Archive::Any::Tar; use strict; use Archive::Tar; use Cwd; =head1 NAME Archive::Any::Tar - Archive::Any wrapper around Archive::Tar =head1 SYNOPSIS B Use Archive::Any instead. =head1 DESCRIPTION Wrapper around Archive::Tar for Archive::Any. =cut sub can_handle { return ( [ 'tar','tar.gz','tgz' ] ); } sub files { my( $self, $file ) = @_; my $t = Archive::Tar->new( $file ); $t->list_files; } sub extract { my ( $self, $file, $dir ) = @_; my $t = Archive::Tar->new( $file ); my $orig_dir; if ($dir) { $orig_dir = getcwd; chdir $dir; } my $success = $t->extract; if ($dir) { chdir $orig_dir; } return $success; } =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =head1 SEE ALSO Archive::Any, Archive::Tar =cut 1; /tmp/lib/Archive/Any/Zip.pm0000644000076500000000000000163210467261037015065 0ustar cmoorewheel package Archive::Any::Zip; use strict; use vars qw($VERSION @ISA); $VERSION = 0.03; use Archive::Zip qw(:ERROR_CODES); use Cwd; =head1 NAME Archive::Any::Zip - Archive::Any wrapper around Archive::Zip =head1 SYNOPSIS B Use Archive::Any instead. =head1 DESCRIPTION Wrapper around Archive::Zip for Archive::Any. =cut sub can_handle { return( [ 'zip','pk3','jar' ] ); } sub files { my( $self, $file ) = shift; my $z = Archive::Zip->new( $file ); $z->memberNames; } sub extract { my($self, $file, $dir) = @_; my $z = Archive::Zip->new( $file ); my $orig_dir; if( $dir ) { $orig_dir = getcwd; chdir $dir; } warn( "in $dir" ); $z->extractTree; if( $dir) { chdir $orig_dir; } return 1; } =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =head1 SEE ALSO Archive::Any, Archive::Zip =cut 1; /tmp/lib/Archive/Any.pm0000644000076500000000000001106710467262704014330 0ustar cmoorewheel =head1 NAME Archive::Any - Single interface to deal with zips and tarballs =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... Currently only tar (with or without gzip) and zip are supported. Currently only supports unpacking. =over 4 =item B ` my $archive = Archive::Any->new($archive_file); my $archive = Archive::Any->new($archive_file, $type); Creates an Archive::Any object representing $file, but don't do anything with it yet. $type is optional. It lets you force the file type in-case Archive::Any can't figure it out. 'tar' or 'zip' is currently accepted. =item B my $type = $archive->type; Returns the type of archive this is. Currently 'zip' or 'tar'. =item B 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 my $is_naughty = $archive->is_naughty; Checks to see if this archive is going to unpack B the current directory. =back =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =cut package Archive::Any; use Carp::Always; use strict; use warnings; use vars qw($VERSION @ISA); $VERSION = 0.06; use File::Spec::Functions qw(rel2abs splitpath splitdir); use File::Type; use MIME::Types; use Module::Find; use Data::Dumper; # my $a = Archive::Any->new( '/tmp/file.zip', 'zip' ); # # Pick a plugin. # sub new { my ( $proto, $file, $type ) = @_; return undef unless -f $file; my $available; my @plugins = findsubmod Archive::Any; foreach my $plugin ( @plugins ) { eval "require $plugin"; next if $@; my $a = $plugin->can_handle(); if ( ref($a) eq 'ARRAY' ) { foreach my $h ( @{$a} ) { next if exists( $available->{$h} ); $available->{$h} = $plugin; } } else { $available->{$a} = $plugin; } } my $handler; if ( $type ) { my $mime_type = MIME::Types->new()->mimeTypeOf( $type ); do { die( "No handler available for type $type" ); } unless exists( $available->{$type} ); $handler = $available->{$type}; } else { my $mime_type = File::Type->new()->checktype_filename( $file ); # MIME::Types has a funky interface. # it's not immediately apparent until you try it in the debugger. my $mo = new MIME::Types; my MIME::Types $lol_wtf = $mo->type( $mime_type ); print Dumper( $lol_wtf->extensions() ); my @x = $lol_wtf->extensions(); print Dumper( @x ); my $extension = $x[0]; do { die( "Can't determine the file extension for mime type: $mime_type" ); } unless $extension; do { warn( Dumper( $available ) ); die( "No handler available for type extension '$extension'" ); } unless exists( $available->{$extension} ); $handler = $available->{$extension}; } return bless { file => $file, handler => $handler, }, $proto; } =item B $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. =cut sub extract { my $self = shift; my $dir = shift; if ( defined( $self->{forced} ) ) { print( "Forced\n" ); } else { print( "Not forced.\n" ); } if ( exists( $self->{mime} ) ) { print( "Mime looks good.\n" ); } my $plugin = $self->{available}->{$self->{mime}}; defined( $dir ) ? return $plugin->extract( $self->{file}, $dir ) : $plugin->extract( $self->{file} ); } =item B my @file = $archive->files; A list of files in the archive. =cut sub files { my( $self, $file ) = @_; return undef unless $self->{mime}; 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 handler { my $self = shift; return $self->{handler}; } 1; Archive-Any-0.0932/t/naughty.tar0000644000076600007660000005000010477440447015723 0ustar cmoorecmoore/tmp/lib/0000755000076500000000000000000010467261037011653 5ustar cmoorewheel/tmp/lib/Archive/0000755000076500000000000000000010467261263013235 5ustar cmoorewheel/tmp/lib/Archive/Any/0000755000076500000000000000000010467261243013762 5ustar cmoorewheel/tmp/lib/Archive/Any/Tar.pm0000644000076500000000000000153510467261037015053 0ustar cmoorewheelpackage Archive::Any::Tar; use strict; use Archive::Tar; use Cwd; =head1 NAME Archive::Any::Tar - Archive::Any wrapper around Archive::Tar =head1 SYNOPSIS B Use Archive::Any instead. =head1 DESCRIPTION Wrapper around Archive::Tar for Archive::Any. =cut sub can_handle { return ( [ 'tar','tar.gz','tgz' ] ); } sub files { my( $self, $file ) = @_; my $t = Archive::Tar->new( $file ); $t->list_files; } sub extract { my ( $self, $file, $dir ) = @_; my $t = Archive::Tar->new( $file ); my $orig_dir; if ($dir) { $orig_dir = getcwd; chdir $dir; } my $success = $t->extract; if ($dir) { chdir $orig_dir; } return $success; } =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =head1 SEE ALSO Archive::Any, Archive::Tar =cut 1; /tmp/lib/Archive/Any/Zip.pm0000644000076500000000000000163210467261037015065 0ustar cmoorewheel package Archive::Any::Zip; use strict; use vars qw($VERSION @ISA); $VERSION = 0.03; use Archive::Zip qw(:ERROR_CODES); use Cwd; =head1 NAME Archive::Any::Zip - Archive::Any wrapper around Archive::Zip =head1 SYNOPSIS B Use Archive::Any instead. =head1 DESCRIPTION Wrapper around Archive::Zip for Archive::Any. =cut sub can_handle { return( [ 'zip','pk3','jar' ] ); } sub files { my( $self, $file ) = shift; my $z = Archive::Zip->new( $file ); $z->memberNames; } sub extract { my($self, $file, $dir) = @_; my $z = Archive::Zip->new( $file ); my $orig_dir; if( $dir ) { $orig_dir = getcwd; chdir $dir; } warn( "in $dir" ); $z->extractTree; if( $dir) { chdir $orig_dir; } return 1; } =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =head1 SEE ALSO Archive::Any, Archive::Zip =cut 1; /tmp/lib/Archive/Any.pm0000644000076500000000000001106710467262704014330 0ustar cmoorewheel =head1 NAME Archive::Any - Single interface to deal with zips and tarballs =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... Currently only tar (with or without gzip) and zip are supported. Currently only supports unpacking. =over 4 =item B ` my $archive = Archive::Any->new($archive_file); my $archive = Archive::Any->new($archive_file, $type); Creates an Archive::Any object representing $file, but don't do anything with it yet. $type is optional. It lets you force the file type in-case Archive::Any can't figure it out. 'tar' or 'zip' is currently accepted. =item B my $type = $archive->type; Returns the type of archive this is. Currently 'zip' or 'tar'. =item B 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 my $is_naughty = $archive->is_naughty; Checks to see if this archive is going to unpack B the current directory. =back =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =cut package Archive::Any; use Carp::Always; use strict; use warnings; use vars qw($VERSION @ISA); $VERSION = 0.06; use File::Spec::Functions qw(rel2abs splitpath splitdir); use File::Type; use MIME::Types; use Module::Find; use Data::Dumper; # my $a = Archive::Any->new( '/tmp/file.zip', 'zip' ); # # Pick a plugin. # sub new { my ( $proto, $file, $type ) = @_; return undef unless -f $file; my $available; my @plugins = findsubmod Archive::Any; foreach my $plugin ( @plugins ) { eval "require $plugin"; next if $@; my $a = $plugin->can_handle(); if ( ref($a) eq 'ARRAY' ) { foreach my $h ( @{$a} ) { next if exists( $available->{$h} ); $available->{$h} = $plugin; } } else { $available->{$a} = $plugin; } } my $handler; if ( $type ) { my $mime_type = MIME::Types->new()->mimeTypeOf( $type ); do { die( "No handler available for type $type" ); } unless exists( $available->{$type} ); $handler = $available->{$type}; } else { my $mime_type = File::Type->new()->checktype_filename( $file ); # MIME::Types has a funky interface. # it's not immediately apparent until you try it in the debugger. my $mo = new MIME::Types; my MIME::Types $lol_wtf = $mo->type( $mime_type ); print Dumper( $lol_wtf->extensions() ); my @x = $lol_wtf->extensions(); print Dumper( @x ); my $extension = $x[0]; do { die( "Can't determine the file extension for mime type: $mime_type" ); } unless $extension; do { warn( Dumper( $available ) ); die( "No handler available for type extension '$extension'" ); } unless exists( $available->{$extension} ); $handler = $available->{$extension}; } return bless { file => $file, handler => $handler, }, $proto; } =item B $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. =cut sub extract { my $self = shift; my $dir = shift; if ( defined( $self->{forced} ) ) { print( "Forced\n" ); } else { print( "Not forced.\n" ); } if ( exists( $self->{mime} ) ) { print( "Mime looks good.\n" ); } my $plugin = $self->{available}->{$self->{mime}}; defined( $dir ) ? return $plugin->extract( $self->{file}, $dir ) : $plugin->extract( $self->{file} ); } =item B my @file = $archive->files; A list of files in the archive. =cut sub files { my( $self, $file ) = @_; return undef unless $self->{mime}; 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 handler { my $self = shift; return $self->{handler}; } 1; Archive-Any-0.0932/t/not_a_zip.zip0000644000076600007660000000017610477440447016253 0ustar cmoorecmoore#!/usr/bin/perl -w use Archive::Any; use Test::More tests => 1; chdir 't'; ok( !Archive::Any->new("im_not_really_a.zip") ); Archive-Any-0.0932/t/pod-coverage.t0000644000076600007660000000043011003700611016250 0ustar cmoorecmoore 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" ); Archive-Any-0.0932/t/pod.t0000644000076600007660000000020410477440447014504 0ustar cmoorecmoore 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(); Archive-Any-0.0932/t/type.t0000644000076600007660000000107010477440447014705 0ustar cmoorecmoore#!/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";