Archive-Any-Lite-0.07/0000755000076500007650000000000012140222553014611 5ustar ishigakiishigakiArchive-Any-Lite-0.07/t/0000755000076500007650000000000012140222552015053 5ustar ishigakiishigakiArchive-Any-Lite-0.07/t/impolite.tar.gz0000644000076500007650000000244311767640423020046 0ustar ishigakiishigaki#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 s 'this test requires Parallel::ForkManager'; } plan 'no_plan'; use Archive::Any::Lite; use File::Temp qw/tempdir/; use File::Path; my $pm = Parallel::ForkManager->new(5); my ($pass, $fail); $pm->run_on_finish(sub { my ($pid, $exit, $ident, $signal, $dump, $data) = @_; if (ref $data eq ref []) { $pass += $data->[0]; $fail += $data->[1]; } else { $fail++; } }); my $tmp = "$FindBin::Bin/tmp"; mkpath $tmp; for my $i (1..100) { $pm->start and next; my $dir = tempdir(DIR => $tmp, CLEANUP => 1); my $type = qw(lib)[int(rand(1))]; my $ext = qw(tar.gz tar.bz2 tgz zip)[int(rand(4))]; my ($ok, $not_ok) = (0, 0); if (my $archive = Archive::Any::Lite->new("$FindBin::Bin/$type.$ext")) { note "extracting $dir/$type.$ext"; $archive->extract($dir); my @files = $archive->files; for (@files) { my $file = File::Spec->catfile($dir, $_); if (-e $file) { $ok++; } else { $not_ok++; diag "[$i] $type: $file does not exist"; } } } else { $not_ok = 1; } $pm->finish($not_ok, [$ok, $not_ok]); } $pm->wait_all_children; ok !$fail, "pass: $pass fail: $fail"; rmtree $tmp;Archive-Any-Lite-0.07/t/lib.tar.bz20000644000076500007650000000411211767640423017042 0ustar ishigakiishigakiBZh91AY&SYBV}ؒ|`<R@Ui *4ɠS aAyM='=@ 4 CFM4ii@MHxzި=&z 1iCFM4ii@D&MOSFS)jIdejz2z`{7|`)$`VHb B߬GßR257"ۇݵDDX_GB4#{ETT bZ!HKm#hmD bł;h$БK%i#%O) =ӷN8 6Ѯ{֓;4Yfqia7( %9D\hׇRρ%8鯱P(p A|nT@AEG5Y -x\5Q8T kw/V )Y4~#"]#7L+xik0[aVL'VKScP"`MU_6(sMCD%yŃa1S-mGAƠI*D8NM w?&6Ld |ayסB2 MX>47ĂДwTKDT`" ^%[ .*YI:~ڔ/疑6D yA!TnoCR<QHf8iT}j6\ SI2"DC D &t):&uԗ;8"VW! ËKKU gSY pH%0 K#$J1Ju%.oҰCߨ^vڬ!aM1F%{~uB/heUhwӺF{=31/Yκ^ll}E9M*~Ap.Vt4tWP` ̆/3==DrAUל&|>4vc=9;^1gmbWrqD~+\Kԅv3T7G;E1iL`s'dd$,+2$H,EwuwM9[Zg} 9ڙ#HX0Aw5ȕ67ES۰D m:2iV\ ˍ{OH#C7CslAwk k1 qol+[8L6q60髥Zr$* *w|-dBa9,4 M l:pw4&G aHdMMzMĺ,=1.hRZ@TElɩcR!|Pj_?4s z$l`!1Vzu ׶t YҚʴi#%39A}󥎇)]+Ǘ-JMD n ChRkd''rH&3)ZĮÅh8b :$zQ `4fZ\/(X'!li6Xe)}qm*3dAP2 ro1c/ !7x|N* {2ϔ-0!6i}5D] i;TmF {|- /+-Z?e6ݙ|BH56VݣF X3XΐX-o1Ie A&!.*m7nҖXs"9͠qaە>b@ܑN$wArchive-Any-Lite-0.07/t/00_load.t0000644000076500007650000000011511767640423016472 0ustar ishigakiishigakiuse strict; use warnings; use Test::UseAllModules; BEGIN { all_uses_ok(); } Archive-Any-Lite-0.07/t/lib.tgz0000644000076500007650000000424611767640423016374 0ustar ishigakiishigakiFDlib.taras__cƢc0`3ئvln 雾q!#;IH2&y w{{{{sCaѠսF%7jܫTJsRV h<`PX`Þ>gw7 .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-Lite-0.07/t/naughty.tar0000644000076500007650000005000011767640423017254 0ustar ishigakiishigaki/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-Lite-0.07/t/Any.t0000644000076500007650000000562211767640423016013 0ustar ishigakiishigaki# this test is borrowed from Archive::Any to secure compatibility use strict; use warnings; use Test::More 'no_plan'; use Archive::Any::Lite; use File::Spec::Functions qw(updir); my %tests = ( 't/lib.zip' => { impolite=> 0, naughty => 0, handler => 'Archive::Any::Lite::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::Lite::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::Lite::Tar', type => 'tar', files => [qw( type.t Any.t 00compile.t fail.t )], }, 't/naughty.tar' => { impolite => 0, naughty => 1, handler => 'Archive::Any::Lite::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::Lite->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::Lite'), " 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-Lite-0.07/t/fail.t0000644000076500007650000000031011767640423016164 0ustar ishigakiishigaki# this test is borrowed from Archive::Any to secure compatibility use strict; use warnings; use Archive::Any::Lite; use Test::More tests => 1; ok( !Archive::Any::Lite->new("im_not_really_a.zip") ); Archive-Any-Lite-0.07/t/99_podcoverage.t0000644000076500007650000000035711767640423020103 0ustar ishigakiishigakiuse strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; all_pod_coverage_ok(); Archive-Any-Lite-0.07/t/99_pod.t0000644000076500007650000000032711767640423016364 0ustar ishigakiishigakiuse strict; use warnings; use Test::More; eval "use Test::Pod 1.18"; plan skip_all => 'Test::Pod 1.18 required' if $@; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; all_pod_files_ok(); Archive-Any-Lite-0.07/t/lib.tar.gz0000644000076500007650000000374411767760455017007 0ustar ishigakiishigakiKOXms9T?\pyql b6>Lv]xw @Ѭ$bzA`$[܇Ee3LtVTxyrbZWͽ{ӗ'/j/j^KT*"1gc0Q\ȯaW\~1|~ONvÏy2"h2)ZNUjAwb?%=SpבfAϦaofD$,KwELSh.8B\9@Bg@< %8!D'`%(Xb6@vvCO&Qa% F| },,?wr2dbsAQCaf 6>(Ӏ 4d4@S. "! z|DTݣsrW#?>~0x8*~xPo4-oD|`,'Kq!nHG+\UClfZׁq5’i~2OH>CB\d *F#9dbZ~|tæ[dO W2W`f#0jlF6+VqW8:+8ta#[9bBuWߍ%v󈟦2EPxEƂ|SKvVDVՐ=յ&d:Zd+s:!~ ZwJwe}YbeUyݛ=G[Ofr^fL32M?WfVG9QW),=lFx-oi5 _yK KJ^yʰp^vv`Gj3 %b_t1^ů7ՋVH>12-&_}* *. (>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-Lite-0.07/Makefile.PL0000644000076500007650000000133011767640423016576 0ustar ishigakiishigakiuse strict; use warnings; use ExtUtils::MakeMaker; my %params = ( NAME => 'Archive::Any::Lite', AUTHOR => 'Kenichi Ishigaki ', VERSION_FROM => 'lib/Archive/Any/Lite.pm', ABSTRACT_FROM => 'lib/Archive/Any/Lite.pm', LICENSE => 'perl', PREREQ_PM => { 'Archive::Tar' => 0, 'Archive::Zip' => 0, 'File::Spec' => 0, 'IO::Uncompress::Bunzip2' => 0, 'IO::Zlib' => 0, 'Test::More' => '0.47', 'Test::UseAllModules' => '0.10', }, ); my $eumm = $ExtUtils::MakeMaker::VERSION; delete $params{LICENSE} if $eumm < 6.31; WriteMakefile(%params); Archive-Any-Lite-0.07/META.json0000664000076500007650000000210712140222553016234 0ustar ishigakiishigaki{ "abstract" : "simple CPAN package extractor\r", "author" : [ "Kenichi Ishigaki " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Archive-Any-Lite", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "Archive::Tar" : 0, "Archive::Zip" : 0, "File::Spec" : 0, "IO::Uncompress::Bunzip2" : 0, "IO::Zlib" : 0, "Test::More" : "0.47", "Test::UseAllModules" : "0.10" } } }, "release_status" : "stable", "version" : "0.07" } Archive-Any-Lite-0.07/META.yml0000664000076500007650000000116112140222553016063 0ustar ishigakiishigaki--- abstract: "simple CPAN package extractor\r" author: - 'Kenichi Ishigaki ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Archive-Any-Lite no_index: directory: - t - inc requires: Archive::Tar: 0 Archive::Zip: 0 File::Spec: 0 IO::Uncompress::Bunzip2: 0 IO::Zlib: 0 Test::More: 0.47 Test::UseAllModules: 0.10 version: 0.07 Archive-Any-Lite-0.07/README0000644000076500007650000000047511767640423015515 0ustar ishigakiishigakiArchive-Any-Lite INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install COPYRIGHT AND LICENSE Copyright (C) 2012 Kenichi Ishigaki This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Archive-Any-Lite-0.07/Changes0000644000076500007650000000072212140222531016101 0ustar ishigakiishigakiRevision history for Archive-Any-Lite 0.07 2013/05/01 - ignore hardlinks if $IGNORE_SYMLINK is set 0.06 2013/03/19 - added $IGNORE_SYMLINK to ignore symlinks 0.05 2013/01/13 - check a directory earlier for efficiency 0.04 2012/11/24 - warn and stop processing if no data could be taken from a broken tarball 0.03 2012/07/15 - error handling so that extract returns false 0.02 2012/06/19 - fixed tar.gz handling 0.01 2012/06/18 - initial release Archive-Any-Lite-0.07/lib/0000755000076500007650000000000012140222552015356 5ustar ishigakiishigakiArchive-Any-Lite-0.07/lib/Archive/0000755000076500007650000000000012140222552016737 5ustar ishigakiishigakiArchive-Any-Lite-0.07/lib/Archive/Any/0000755000076500007650000000000012140222552017466 5ustar ishigakiishigakiArchive-Any-Lite-0.07/lib/Archive/Any/Lite.pm0000644000076500007650000001315712140222531020725 0ustar ishigakiishigakipackage Archive::Any::Lite; use strict; use warnings; use File::Spec; our $VERSION = '0.07'; our $IGNORE_SYMLINK; sub new { my ($class, $file) = @_; $file = File::Spec->rel2abs($file); unless (-f $file) { warn "$file not found\n"; return; } # XXX: trust file extensions until I manage to make File::MMagic # more reliable while fork()ing or I happen to find a decent # and portable alternative to File::MMagic. my $handler = $file =~ /\.(?:tar|tar\.(?:gz|bz2)|gtar|tgz)$/ ? 'Archive::Any::Lite::Tar' : $file =~ /\.(?:zip)$/ ? 'Archive::Any::Lite::Zip' : undef; unless ($handler) { warn "No handler available for $file\n"; return; } bless { file => $file, handler => $handler, }, $class; } sub extract { my ($self, $dir) = @_; $self->{handler}->extract($self->{file}, $dir); } sub files { my $self = shift; $self->{handler}->files($self->{file}); } sub is_impolite { my $self = shift; my @files = $self->files; my $first_file = $files[0]; my ($first_dir) = File::Spec->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 type { my $self = shift; my ($type) = lc $self->{handler} =~ /::(\w+)$/; return $type; } package Archive::Any::Lite::Tar; use Archive::Tar; sub files { my ($self, $file) = @_; Archive::Tar->list_archive($file); } sub extract { my ($self, $file, $dir) = @_; $dir = '.' unless defined $dir; my $tar = Archive::Tar->new; my $fh; if ($file =~ /\.(tgz|tar\.gz)$/) { require IO::Zlib; $fh = IO::Zlib->new($file, "rb") or do { warn "$file: $!"; return }; } elsif ($file =~ /\.tar.bz2$/) { require IO::Uncompress::Bunzip2; $fh = IO::Uncompress::Bunzip2->new($file) or do { warn "$file: $!"; return }; } else { open $fh, '<', $file or do { warn "$file: $!"; return }; binmode $fh; } # Archive::Tar is too noisy when an archive has minor glitches. # Note also that $file can't hold the last error. local $Archive::Tar::WARN; my %errors; my $has_extracted; until (eof $fh) { my @files = $tar->read($fh, undef, {limit => 1}); if (my $error = $tar->error) { warn $error unless $errors{$error}++; } if (!@files && !$has_extracted) { warn "No data could be read from $file"; return; } for my $file (@files) { next if $IGNORE_SYMLINK && ($file->is_symlink or $file->is_hardlink); my $path = File::Spec->catfile($dir, $file->prefix, $file->name); $tar->extract_file($file, File::Spec->canonpath($path)) or do { if (my $error = $tar->error) { warn $error unless $errors{$error}++; } }; } $has_extracted += @files; } return if %errors; return 1; } sub type { 'tar' } package Archive::Any::Lite::Zip; use Archive::Zip qw/:ERROR_CODES/; sub files { my ($self, $file) = @_; my $zip = Archive::Zip->new($file) or return; $zip->memberNames; } sub extract { my ($self, $file, $dir) = @_; my $zip = Archive::Zip->new($file) or return; $dir = '.' unless defined $dir; my $error = 0; for my $member ($zip->members) { next if $IGNORE_SYMLINK && $member->isSymbolicLink; my $path = File::Spec->catfile($dir, $member->fileName); my $ret = $member->extractToFileNamed(File::Spec->canonpath($path)); $error++ if $ret != AZ_OK; } return if $error; return 1; } sub type { 'zip' } 1; __END__ =head1 NAME Archive::Any::Lite - simple CPAN package extractor =head1 SYNOPSIS use strict; use warnings; use Archive::Any::Lite; local $Archive::Any::Lite::IGNORE_SYMLINK = 1; # for safety my $tarball = 'foo.tar.gz'; my $archive = Archive::Any::Lite->new($tarball); $archive->extract('into/some/directory/'); =head1 DESCRIPTION This is a fork of L by Michael Schwern and Clint Moore. The main difference is this works properly even when you fork(), and may require less memory to extract a tarball. On the other hand, this isn't pluggable (this only supports file formats used in the CPAN toolchains), and this doesn't check mime types (at least as of this writing). =head1 METHODS =head2 new my $archive = Archive::Any->new($archive_file); Creates an object. =head2 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. =head2 files my @file = $archive->files; A list of files in the archive. =head2 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. =head2 is_naughty my $is_naughty = $archive->is_naughty; Checks to see if this archive is going to unpack outside the current directory. =head2 type Deprecated. For backward compatibility only. =head1 GLOBAL VARIABLE =head2 $IGNORE_SYMLINK If set to true, symlinks (and hardlinks for tarball) will be ignored. =head1 SEE ALSO L, L =head1 AUTHOR L is written by Michael G Schwern and Clint Moore. Kenichi Ishigaki, Eishigaki@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2012 by Kenichi Ishigaki. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Archive-Any-Lite-0.07/MANIFEST0000644000076500007650000000061712140222553015746 0ustar ishigakiishigakiChanges lib/Archive/Any/Lite.pm Makefile.PL MANIFEST This list of files README t/00_load.t t/30_fork.t t/99_pod.t t/99_podcoverage.t t/Any.t t/fail.t t/impolite.tar.gz t/lib.tar.bz2 t/lib.tar.gz t/lib.tgz t/lib.zip t/naughty.tar META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker)