1#!/usr/bin/perl -w 2 3BEGIN { 4 if( $ENV{PERL_CORE} ) { 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7 } 8 else { 9 unshift @INC, 't/lib'; 10 } 11} 12chdir 't'; 13 14use Test::More tests => 34; 15 16use_ok( 'ExtUtils::Packlist' ); 17 18is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' ); 19 20# new calls tie() 21my $pl = ExtUtils::Packlist->new(); 22isa_ok( $pl, 'ExtUtils::Packlist' ); 23is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' ); 24 25 26$pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' ); 27is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' ); 28is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' ); 29 30 31ExtUtils::Packlist::STORE($pl, 'key', 'value'); 32is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' ); 33 34 35$pl->{data}{foo} = 'bar'; 36is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' ); 37 38 39# test FIRSTKEY and NEXTKEY 40SKIP: { 41 $pl->{data}{bar} = 'baz'; 42 skip('not enough keys to test FIRSTKEY', 2) 43 unless keys %{ $pl->{data} } > 2; 44 45 # get the first and second key 46 my ($first, $second) = keys %{ $pl->{data} }; 47 48 # now get a couple of extra keys, to mess with the hash iterator 49 my $i = 0; 50 for (keys %{ $pl->{data} } ) { 51 last if $i++; 52 } 53 54 # finally, see if it really can get the first key again 55 is( ExtUtils::Packlist::FIRSTKEY($pl), $first, 56 'FIRSTKEY() should be consistent' ); 57 58 is( ExtUtils::Packlist::NEXTKEY($pl), $second, 59 'and NEXTKEY() should also be consistent' ); 60} 61 62 63ok( ExtUtils::Packlist::EXISTS($pl, 'bar'), 'EXISTS() should find keys' ); 64 65 66ExtUtils::Packlist::DELETE($pl, 'bar'); 67ok( !(exists $pl->{data}{bar}), 'DELETE() should delete cleanly' ); 68 69 70ExtUtils::Packlist::CLEAR($pl); 71is( keys %{ $pl->{data} }, 0, 'CLEAR() should wipe out data' ); 72 73 74# DESTROY does nothing... 75can_ok( 'ExtUtils::Packlist', 'DESTROY' ); 76 77 78# write is a little more complicated 79eval { ExtUtils::Packlist::write({}) }; 80like( $@, qr/No packlist filename/, 'write() should croak without packfile' ); 81 82eval { ExtUtils::Packlist::write({}, 'eplist') }; 83my $file_is_ready = $@ ? 0 : 1; 84ok( $file_is_ready, 'write() can write a file' ); 85 86local *IN; 87 88SKIP: { 89 skip('cannot write files, some tests difficult', 3) unless $file_is_ready; 90 91 # set this file to read-only 92 chmod 0444, 'eplist'; 93 94 SKIP: { 95 skip("cannot write readonly files", 1) if -w 'eplist'; 96 97 eval { ExtUtils::Packlist::write({}, 'eplist') }; 98 like( $@, qr/Can't open file/, 'write() should croak on open failure' ); 99 } 100 101 #'now set it back (tick here fixes vim syntax highlighting ;) 102 chmod 0777, 'eplist'; 103 104 # and some test data to be read 105 $pl->{data} = { 106 single => 1, 107 hash => { 108 foo => 'bar', 109 baz => 'bup', 110 }, 111 '/./abc' => '', 112 }; 113 eval { ExtUtils::Packlist::write($pl, 'eplist') }; 114 is( $@, '', 'write() should normally succeed' ); 115 is( $pl->{packfile}, 'eplist', 'write() should set packfile name' ); 116 117 $file_is_ready = open(IN, 'eplist'); 118} 119 120 121eval { ExtUtils::Packlist::read({}) }; 122like( $@, qr/^No packlist filename/, 'read() should croak without packfile' ); 123 124 125eval { ExtUtils::Packlist::read({}, 'abadfilename') }; 126like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' ); 127#'open packfile for reading 128 129 130# and more read() tests 131SKIP: { 132 skip("cannot open file for reading: $!", 5) unless $file_is_ready; 133 my $file = do { local $/ = <IN> }; 134 135 like( $file, qr/single\n/, 'key with value should be available' ); 136 like( $file, qr!/\./abc\n!, 'key with no value should also be present' ); 137 like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' ); 138 like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear'); 139 close IN; 140 141 eval{ ExtUtils::Packlist::read($pl, 'eplist') }; 142 is( $@, '', 'read() should normally succeed' ); 143 is( $pl->{data}{single}, undef, 'single keys should have undef value' ); 144 is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes'); 145 146 is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' ); 147 ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' ); 148 149 # give validate a valid and an invalid file to find 150 $pl->{data} = { 151 eplist => 1, 152 fake => undef, 153 }; 154 155 is( ExtUtils::Packlist::validate($pl), 1, 156 'validate() should find missing files' ); 157 ExtUtils::Packlist::validate($pl, 1); 158 ok( !exists $pl->{data}{fake}, 159 'validate() should remove missing files when prompted' ); 160 161 # one more new() test, to see if it calls read() successfully 162 $pl = ExtUtils::Packlist->new('eplist'); 163} 164 165 166# packlist_file, $pl should be set from write test 167is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl', 168 'packlist_file() should fetch packlist from passed hash' ); 169is( ExtUtils::Packlist::packlist_file($pl), 'eplist', 170 'packlist_file() should fetch packlist from ExtUtils::Packlist object' ); 171 172END { 173 1 while unlink qw( eplist ); 174} 175