ext/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm

   1 package CompTestUtils;
   2
   3 package main ;
   4
   5 use strict ;
   6 use warnings;
   7 use bytes;
   8
   9 #use lib qw(t t/compress);
  10
  11 use Carp ;
  12 #use Test::More ;
  13
  14
  15
  16 sub title
  17 {
  18     #diag "" ;
  19     ok 1, $_[0] ;
  20     #diag "" ;
  21 }
  22
  23 sub like_eval
  24 {
  25     like $@, @_ ;
  26 }
  27
  28 {
  29     package LexFile ;
  30
  31     our ($index);
  32     $index = '00000';
  33
  34     sub new
  35     {
  36         my $self = shift ;
  37         foreach (@_)
  38         {
  39             # autogenerate the name unless if none supplied
  40             $_ = "tst" . $index ++ . ".tmp"
  41                 unless defined $_;
  42         }
  43         chmod 0777, @_;
  44         for (@_) { 1 while unlink $_ } ;
  45         bless [ @_ ], $self ;
  46     }
  47
  48     sub DESTROY
  49     {
  50         my $self = shift ;
  51         chmod 0777, @{ $self } ;
  52         for (@$self) { 1 while unlink $_ } ;
  53     }
  54
  55 }
  56
  57 {
  58     package LexDir ;
  59
  60     use File::Path;
  61     sub new
  62     {
  63         my $self = shift ;
  64         foreach (@_) { rmtree $_ }
  65         bless [ @_ ], $self ;
  66     }
  67
  68     sub DESTROY
  69     {
  70         my $self = shift ;
  71         foreach (@$self) { rmtree $_ }
  72     }
  73 }
  74 sub readFile
  75 {
  76     my $f = shift ;
  77
  78     my @strings ;
  79
  80     if (IO::Compress::Base::Common::isaFilehandle($f))
  81     {
  82         my $pos = tell($f);
  83         seek($f, 0,0);
  84         @strings = <$f> ;
  85         seek($f, 0, $pos);
  86     }
  87     else
  88     {
  89         open (F, "<$f")
  90             or croak "Cannot open $f: $!\n" ;
  91         binmode F;
  92         @strings = <F> ;
  93         close F ;
  94     }
  95
  96     return @strings if wantarray ;
  97     return join "", @strings ;
  98 }
  99
 100 sub touch
 101 {
 102     foreach (@_) { writeFile($_, '') }
 103 }
 104
 105 sub writeFile
 106 {
 107     my($filename, @strings) = @_ ;
 108     1 while unlink $filename ;
 109     open (F, ">$filename")
 110         or croak "Cannot open $filename: $!\n" ;
 111     binmode F;
 112     foreach (@strings) {
 113         no warnings ;
 114         print F $_ ;
 115     }
 116     close F ;
 117 }
 118
 119 sub GZreadFile
 120 {
 121     my ($filename) = shift ;
 122
 123     my ($uncomp) = "" ;
 124     my $line = "" ;
 125     my $fil = gzopen($filename, "rb")
 126         or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ;
 127
 128     $uncomp .= $line
 129         while $fil->gzread($line) > 0;
 130
 131     $fil->gzclose ;
 132     return $uncomp ;
 133 }
 134
 135 sub hexDump
 136 {
 137     my $d = shift ;
 138
 139     if (IO::Compress::Base::Common::isaFilehandle($d))
 140     {
 141         $d = readFile($d);
 142     }
 143     elsif (IO::Compress::Base::Common::isaFilename($d))
 144     {
 145         $d = readFile($d);
 146     }
 147     else
 148     {
 149         $d = $$d ;
 150     }
 151
 152     my $offset = 0 ;
 153
 154     $d = '' unless defined $d ;
 155     #while (read(STDIN, $data, 16)) {
 156     while (my $data = substr($d, 0, 16)) {
 157         substr($d, 0, 16) = '' ;
 158         printf "# %8.8lx    ", $offset;
 159         $offset += 16;
 160
 161         my @array = unpack('C*', $data);
 162         foreach (@array) {
 163             printf('%2.2x ', $_);
 164         }
 165         print "   " x (16 - @array)
 166             if @array < 16 ;
 167         $data =~ tr/\0-\37\177-\377/./;
 168         print "  $data\n";
 169     }
 170
 171 }
 172
 173 sub readHeaderInfo
 174 {
 175     my $name = shift ;
 176     my %opts = @_ ;
 177
 178     my $string = <<EOM;
 179 some text
 180 EOM
 181
 182     ok my $x = new IO::Compress::Gzip $name, %opts
 183         or diag "GzipError is $IO::Compress::Gzip::GzipError" ;
 184     ok $x->write($string) ;
 185     ok $x->close ;
 186
 187     #is GZreadFile($name), $string ;
 188
 189     ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0
 190         or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
 191     ok my $hdr = $gunz->getHeaderInfo();
 192     my $uncomp ;
 193     ok $gunz->read($uncomp) ;
 194     ok $uncomp eq $string;
 195     ok $gunz->close ;
 196
 197     return $hdr ;
 198 }
 199
 200 sub cmpFile
 201 {
 202     my ($filename, $uue) = @_ ;
 203     return readFile($filename) eq unpack("u", $uue) ;
 204 }
 205
 206 sub isRawFormat
 207 {
 208     my $class = shift;
 209     my %raw = map { $_ => 1 } qw( RawDeflate );
 210
 211     return defined $raw{$class};
 212 }
 213
 214 sub uncompressBuffer
 215 {
 216     my $compWith = shift ;
 217     my $buffer = shift ;
 218
 219     my %mapping = ( 'IO::Compress::Gzip'                     => 'IO::Uncompress::Gunzip',
 220                     'IO::Compress::Gzip::gzip'               => 'IO::Uncompress::Gunzip',
 221                     'IO::Compress::Deflate'                  => 'IO::Uncompress::Inflate',
 222                     'IO::Compress::Deflate::deflate'         => 'IO::Uncompress::Inflate',
 223                     'IO::Compress::RawDeflate'               => 'IO::Uncompress::RawInflate',
 224                     'IO::Compress::RawDeflate::rawdeflate'   => 'IO::Uncompress::RawInflate',
 225                     'IO::Compress::Bzip2'                    => 'IO::Uncompress::Bunzip2',
 226                     'IO::Compress::Bzip2::bzip2'             => 'IO::Uncompress::Bunzip2',
 227                     'IO::Compress::Zip'                      => 'IO::Uncompress::Unzip',
 228                     'IO::Compress::Zip::zip'                 => 'IO::Uncompress::Unzip',
 229                     'IO::Compress::Lzop'                     => 'IO::Uncompress::UnLzop',
 230                     'IO::Compress::Lzop::lzop'               => 'IO::Uncompress::UnLzop',
 231                     'IO::Compress::Lzf'                      => 'IO::Uncompress::UnLzf' ,
 232                     'IO::Compress::Lzf::lzf'                 => 'IO::Uncompress::UnLzf',
 233                     'IO::Compress::PPMd'                     => 'IO::Uncompress::UnPPMd' ,
 234                     'IO::Compress::PPMd::ppmd'               => 'IO::Uncompress::UnPPMd',
 235                     'IO::Compress::DummyComp'                => 'IO::Uncompress::DummyUncomp',
 236                     'IO::Compress::DummyComp::dummycomp'     => 'IO::Uncompress::DummyUncomp',
 237                 );
 238
 239     my $out ;
 240     my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1);
 241     1 while $obj->read($out) > 0 ;
 242     return $out ;
 243
 244 }
 245
 246 my %ErrorMap = (    'IO::Compress::Gzip'                => \$IO::Compress::Gzip::GzipError,
 247                     'IO::Compress::Gzip::gzip'          => \$IO::Compress::Gzip::GzipError,
 248                     'IO::Uncompress::Gunzip'            => \$IO::Uncompress::Gunzip::GunzipError,
 249                     'IO::Uncompress::Gunzip::gunzip'    => \$IO::Uncompress::Gunzip::GunzipError,
 250                     'IO::Uncompress::Inflate'           => \$IO::Uncompress::Inflate::InflateError,
 251                     'IO::Uncompress::Inflate::inflate'  => \$IO::Uncompress::Inflate::InflateError,
 252                     'IO::Compress::Deflate'             => \$IO::Compress::Deflate::DeflateError,
 253                     'IO::Compress::Deflate::deflate'    => \$IO::Compress::Deflate::DeflateError,
 254                     'IO::Uncompress::RawInflate'        => \$IO::Uncompress::RawInflate::RawInflateError,
 255                     'IO::Uncompress::RawInflate::rawinflate'  => \$IO::Uncompress::RawInflate::RawInflateError,
 256                     'IO::Uncompress::AnyInflate'        => \$IO::Uncompress::AnyInflate::AnyInflateError,
 257                     'IO::Uncompress::AnyInflate::anyinflate'  => \$IO::Uncompress::AnyInflate::AnyInflateError,
 258                     'IO::Uncompress::AnyUncompress'        => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
 259                     'IO::Uncompress::AnyUncompress::anyUncompress'  => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
 260                     'IO::Compress::RawDeflate'          => \$IO::Compress::RawDeflate::RawDeflateError,
 261                     'IO::Compress::RawDeflate::rawdeflate'  => \$IO::Compress::RawDeflate::RawDeflateError,
 262                     'IO::Compress::Bzip2'               => \$IO::Compress::Bzip2::Bzip2Error,
 263                     'IO::Compress::Bzip2::bzip2'        => \$IO::Compress::Bzip2::Bzip2Error,
 264                     'IO::Uncompress::Bunzip2'           => \$IO::Uncompress::Bunzip2::Bunzip2Error,
 265                     'IO::Uncompress::Bunzip2::bunzip2'  => \$IO::Uncompress::Bunzip2::Bunzip2Error,
 266                     'IO::Compress::Zip'                 => \$IO::Compress::Zip::ZipError,
 267                     'IO::Compress::Zip::zip'            => \$IO::Compress::Zip::ZipError,
 268                     'IO::Uncompress::Unzip'             => \$IO::Uncompress::Unzip::UnzipError,
 269                     'IO::Uncompress::Unzip::unzip'      => \$IO::Uncompress::Unzip::UnzipError,
 270                     'IO::Compress::Lzop'                => \$IO::Compress::Lzop::LzopError,
 271                     'IO::Compress::Lzop::lzop'          => \$IO::Compress::Lzop::LzopError,
 272                     'IO::Uncompress::UnLzop'            => \$IO::Uncompress::UnLzop::UnLzopError,
 273                     'IO::Uncompress::UnLzop::unlzop'    => \$IO::Uncompress::UnLzop::UnLzopError,
 274                     'IO::Compress::Lzf'                 => \$IO::Compress::Lzf::LzfError,
 275                     'IO::Compress::Lzf::lzf'            => \$IO::Compress::Lzf::LzfError,
 276                     'IO::Uncompress::UnLzf'             => \$IO::Uncompress::UnLzf::UnLzfError,
 277                     'IO::Uncompress::UnLzf::unlzf'      => \$IO::Uncompress::UnLzf::UnLzfError,
 278                     'IO::Compress::PPMd'                 => \$IO::Compress::PPMd::PPMdError,
 279                     'IO::Compress::PPMd::ppmd'            => \$IO::Compress::PPMd::PPMdError,
 280                     'IO::Uncompress::UnPPMd'             => \$IO::Uncompress::UnPPMd::UnPPMdError,
 281                     'IO::Uncompress::UnPPMd::unppmd'      => \$IO::Uncompress::UnPPMd::UnPPMdError,
 282
 283                     'IO::Compress::DummyComp'           => \$IO::Compress::DummyComp::DummyCompError,
 284                     'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError,
 285                     'IO::Uncompress::DummyUncomp'       => \$IO::Uncompress::DummyUncomp::DummyUncompError,
 286                     'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError,
 287                );
 288
 289 my %TopFuncMap = (  'IO::Compress::Gzip'          => 'IO::Compress::Gzip::gzip',
 290                     'IO::Uncompress::Gunzip'      => 'IO::Uncompress::Gunzip::gunzip',
 291
 292                     'IO::Compress::Deflate'       => 'IO::Compress::Deflate::deflate',
 293                     'IO::Uncompress::Inflate'     => 'IO::Uncompress::Inflate::inflate',
 294
 295                     'IO::Compress::RawDeflate'    => 'IO::Compress::RawDeflate::rawdeflate',
 296                     'IO::Uncompress::RawInflate'  => 'IO::Uncompress::RawInflate::rawinflate',
 297
 298                     'IO::Uncompress::AnyInflate'  => 'IO::Uncompress::AnyInflate::anyinflate',
 299                     'IO::Uncompress::AnyUncompress'  => 'IO::Uncompress::AnyUncompress::anyuncompress',
 300
 301                     'IO::Compress::Bzip2'         => 'IO::Compress::Bzip2::bzip2',
 302                     'IO::Uncompress::Bunzip2'     => 'IO::Uncompress::Bunzip2::bunzip2',
 303
 304                     'IO::Compress::Zip'           => 'IO::Compress::Zip::zip',
 305                     'IO::Uncompress::Unzip'       => 'IO::Uncompress::Unzip::unzip',
 306                     'IO::Compress::Lzop'          => 'IO::Compress::Lzop::lzop',
 307                     'IO::Uncompress::UnLzop'      => 'IO::Uncompress::UnLzop::unlzop',
 308                     'IO::Compress::Lzf'           => 'IO::Compress::Lzf::lzf',
 309                     'IO::Uncompress::UnLzf'       => 'IO::Uncompress::UnLzf::unlzf',
 310                     'IO::Compress::PPMd'           => 'IO::Compress::PPMd::ppmd',
 311                     'IO::Uncompress::UnPPMd'       => 'IO::Uncompress::UnPPMd::unppmd',
 312                     'IO::Compress::DummyComp'     => 'IO::Compress::DummyComp::dummyuncomp',
 313                     'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp',
 314                  );
 315
 316    %TopFuncMap = map { ($_              => $TopFuncMap{$_},
 317                         $TopFuncMap{$_} => $TopFuncMap{$_}) }
 318                  keys %TopFuncMap ;
 319
 320  #%TopFuncMap = map { ($_              => \&{ $TopFuncMap{$_} ) }
 321                  #keys %TopFuncMap ;
 322
 323
 324 my %inverse  = ( 'IO::Compress::Gzip'                    => 'IO::Uncompress::Gunzip',
 325                  'IO::Compress::Gzip::gzip'              => 'IO::Uncompress::Gunzip::gunzip',
 326                  'IO::Compress::Deflate'                 => 'IO::Uncompress::Inflate',
 327                  'IO::Compress::Deflate::deflate'        => 'IO::Uncompress::Inflate::inflate',
 328                  'IO::Compress::RawDeflate'              => 'IO::Uncompress::RawInflate',
 329                  'IO::Compress::RawDeflate::rawdeflate'  => 'IO::Uncompress::RawInflate::rawinflate',
 330                  'IO::Compress::Bzip2::bzip2'            => 'IO::Uncompress::Bunzip2::bunzip2',
 331                  'IO::Compress::Bzip2'                   => 'IO::Uncompress::Bunzip2',
 332                  'IO::Compress::Zip::zip'                => 'IO::Uncompress::Unzip::unzip',
 333                  'IO::Compress::Zip'                     => 'IO::Uncompress::Unzip',
 334                  'IO::Compress::Lzop::lzop'              => 'IO::Uncompress::UnLzop::unlzop',
 335                  'IO::Compress::Lzop'                    => 'IO::Uncompress::UnLzop',
 336                  'IO::Compress::Lzf::lzf'                => 'IO::Uncompress::UnLzf::unlzf',
 337                  'IO::Compress::Lzf'                     => 'IO::Uncompress::UnLzf',
 338                  'IO::Compress::PPMd::ppmd'              => 'IO::Uncompress::UnPPMd::unppmd',
 339                  'IO::Compress::PPMd'                    => 'IO::Uncompress::UnPPMd',
 340                  'IO::Compress::DummyComp::dummycomp'    => 'IO::Uncompress::DummyUncomp::dummyuncomp',
 341                  'IO::Compress::DummyComp'               => 'IO::Uncompress::DummyUncomp',
 342              );
 343
 344 %inverse  = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse;
 345
 346 sub getInverse
 347 {
 348     my $class = shift ;
 349
 350     return $inverse{$class} ;
 351 }
 352
 353 sub getErrorRef
 354 {
 355     my $class = shift ;
 356
 357     return $ErrorMap{$class} ;
 358 }
 359
 360 sub getTopFuncRef
 361 {
 362     my $class = shift ;
 363
 364     return \&{ $TopFuncMap{$class} } ;
 365 }
 366
 367 sub getTopFuncName
 368 {
 369     my $class = shift ;
 370
 371     return $TopFuncMap{$class}  ;
 372 }
 373
 374 sub compressBuffer
 375 {
 376     my $compWith = shift ;
 377     my $buffer = shift ;
 378
 379     my %mapping = ( 'IO::Uncompress::Gunzip'                  => 'IO::Compress::Gzip',
 380                     'IO::Uncompress::Gunzip::gunzip'          => 'IO::Compress::Gzip',
 381                     'IO::Uncompress::Inflate'                 => 'IO::Compress::Deflate',
 382                     'IO::Uncompress::Inflate::inflate'        => 'IO::Compress::Deflate',
 383                     'IO::Uncompress::RawInflate'              => 'IO::Compress::RawDeflate',
 384                     'IO::Uncompress::RawInflate::rawinflate'  => 'IO::Compress::RawDeflate',
 385                     'IO::Uncompress::Bunzip2'                 => 'IO::Compress::Bzip2',
 386                     'IO::Uncompress::Bunzip2::bunzip2'        => 'IO::Compress::Bzip2',
 387                     'IO::Uncompress::Unzip'                   => 'IO::Compress::Zip',
 388                     'IO::Uncompress::Unzip::unzip'            => 'IO::Compress::Zip',
 389                     'IO::Uncompress::UnLzop'                  => 'IO::Compress::Lzop',
 390                     'IO::Uncompress::UnLzop::unlzop'          => 'IO::Compress::Lzop',
 391                     'IO::Uncompress::UnLzp'                   => 'IO::Compress::Lzf',
 392                     'IO::Uncompress::UnLzf::unlzf'            => 'IO::Compress::Lzf',
 393                     'IO::Uncompress::UnPPMd'                  => 'IO::Compress::PPMd',
 394                     'IO::Uncompress::UnPPMd::unppmd'          => 'IO::Compress::PPMd',
 395                     'IO::Uncompress::AnyInflate'              => 'IO::Compress::Gzip',
 396                     'IO::Uncompress::AnyInflate::anyinflate'  => 'IO::Compress::Gzip',
 397                     'IO::Uncompress::AnyUncompress'           => 'IO::Compress::Gzip',
 398                     'IO::Uncompress::AnyUncompress::anyuncompress'  => 'IO::Compress::Gzip',
 399                     'IO::Uncompress::DummyUncomp'             => 'IO::Compress::DummyComp',
 400                     'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp',
 401                 );
 402
 403     my $out ;
 404     my $obj = $mapping{$compWith}->new( \$out);
 405     $obj->write($buffer) ;
 406     $obj->close();
 407     return $out ;
 408 }
 409
 410 our ($AnyUncompressError);
 411 BEGIN
 412 {
 413     eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); ';
 414 }
 415
 416 sub anyUncompress
 417 {
 418     my $buffer = shift ;
 419     my $already = shift;
 420
 421     my @opts = ();
 422     if (ref $buffer && ref $buffer eq 'ARRAY')
 423     {
 424         @opts = @$buffer;
 425         $buffer = shift @opts;
 426     }
 427
 428     if (ref $buffer)
 429     {
 430         croak "buffer is undef" unless defined $$buffer;
 431         croak "buffer is empty" unless length $$buffer;
 432
 433     }
 434
 435
 436     my $data ;
 437     if (IO::Compress::Base::Common::isaFilehandle($buffer))
 438     {
 439         $data = readFile($buffer);
 440     }
 441     elsif (IO::Compress::Base::Common::isaFilename($buffer))
 442     {
 443         $data = readFile($buffer);
 444     }
 445     else
 446     {
 447         $data = $$buffer ;
 448     }
 449
 450     if (defined $already && length $already)
 451     {
 452
 453         my $got = substr($data, 0, length($already));
 454         substr($data, 0, length($already)) = '';
 455
 456         is $got, $already, '  Already OK' ;
 457     }
 458
 459     my $out = '';
 460     my $o = new IO::Uncompress::AnyUncompress \$data,
 461                     Append => 1,
 462                     Transparent => 0,
 463                     RawInflate => 1,
 464                     @opts
 465         or croak "Cannot open buffer/file: $AnyUncompressError" ;
 466
 467     1 while $o->read($out) > 0 ;
 468
 469     croak "Error uncompressing -- " . $o->error()
 470         if $o->error() ;
 471
 472     return $out ;
 473
 474 }
 475
 476 sub getHeaders
 477 {
 478     my $buffer = shift ;
 479     my $already = shift;
 480
 481     my @opts = ();
 482     if (ref $buffer && ref $buffer eq 'ARRAY')
 483     {
 484         @opts = @$buffer;
 485         $buffer = shift @opts;
 486     }
 487
 488     if (ref $buffer)
 489     {
 490         croak "buffer is undef" unless defined $$buffer;
 491         croak "buffer is empty" unless length $$buffer;
 492
 493     }
 494
 495
 496     my $data ;
 497     if (IO::Compress::Base::Common::isaFilehandle($buffer))
 498     {
 499         $data = readFile($buffer);
 500     }
 501     elsif (IO::Compress::Base::Common::isaFilename($buffer))
 502     {
 503         $data = readFile($buffer);
 504     }
 505     else
 506     {
 507         $data = $$buffer ;
 508     }
 509
 510     if (defined $already && length $already)
 511     {
 512
 513         my $got = substr($data, 0, length($already));
 514         substr($data, 0, length($already)) = '';
 515
 516         is $got, $already, '  Already OK' ;
 517     }
 518
 519     my $out = '';
 520     my $o = new IO::Uncompress::AnyUncompress \$data,
 521                 MultiStream => 1,
 522                 Append => 1,
 523                 Transparent => 0,
 524                 RawInflate => 1,
 525                 @opts
 526         or croak "Cannot open buffer/file: $AnyUncompressError" ;
 527
 528     1 while $o->read($out) > 0 ;
 529
 530     croak "Error uncompressing -- " . $o->error()
 531         if $o->error() ;
 532
 533     return ($o->getHeaderInfo()) ;
 534
 535 }
 536
 537 sub mkComplete
 538 {
 539     my $class = shift ;
 540     my $data = shift;
 541     my $Error = getErrorRef($class);
 542
 543     my $buffer ;
 544     my %params = ();
 545
 546     if ($class eq 'IO::Compress::Gzip') {
 547         %params = (
 548             Name       => "My name",
 549             Comment    => "a comment",
 550             ExtraField => ['ab' => "extra"],
 551             HeaderCRC  => 1);
 552     }
 553     elsif ($class eq 'IO::Compress::Zip'){
 554         %params = (
 555             Name              => "My name",
 556             Comment           => "a comment",
 557             ZipComment        => "last comment",
 558             exTime            => [100, 200, 300],
 559             ExtraFieldLocal   => ["ab" => "extra1"],
 560             ExtraFieldCentral => ["cd" => "extra2"],
 561         );
 562     }
 563
 564     my $z = new $class( \$buffer, %params)
 565         or croak "Cannot create $class object: $$Error";
 566     $z->write($data);
 567     $z->close();
 568
 569     my $unc = getInverse($class);
 570     anyUncompress(\$buffer) eq $data
 571         or die "bad bad bad";
 572     my $u = new $unc( \$buffer);
 573     my $info = $u->getHeaderInfo() ;
 574
 575
 576     return wantarray ? ($info, $buffer) : $buffer ;
 577 }
 578
 579 sub mkErr
 580 {
 581     my $string = shift ;
 582     my ($dummy, $file, $line) = caller ;
 583     -- $line ;
 584
 585     $file = quotemeta($file);
 586
 587     return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
 588     return "/$string\\s+at /" ;
 589 }
 590
 591 sub mkEvalErr
 592 {
 593     my $string = shift ;
 594
 595     return "/$string\\s+at \\(eval /" if $] > 5.006 ;
 596     return "/$string\\s+at /" ;
 597 }
 598
 599 sub dumpObj
 600 {
 601     my $obj = shift ;
 602
 603     my ($dummy, $file, $line) = caller ;
 604
 605     if (@_)
 606     {
 607         print "#\n# dumpOBJ from $file line $line @_\n" ;
 608     }
 609     else
 610     {
 611         print "#\n# dumpOBJ from $file line $line \n" ;
 612     }
 613
 614     my $max = 0 ;;
 615     foreach my $k (keys %{ *$obj })
 616     {
 617         $max = length $k if length $k > $max ;
 618     }
 619
 620     foreach my $k (sort keys %{ *$obj })
 621     {
 622         my $v = $obj->{$k} ;
 623         $v = '-undef-' unless defined $v;
 624         my $pad = ' ' x ($max - length($k) + 2) ;
 625         print "# $k$pad: [$v]\n";
 626     }
 627     print "#\n" ;
 628 }
 629
 630
 631 sub getMultiValues
 632 {
 633     my $class = shift ;
 634
 635     return (0,0) if $class =~ /lzf/i;
 636     return (1,0);
 637 }
 638
 639
 640 sub gotScalarUtilXS
 641 {
 642     eval ' use Scalar::Util "dualvar" ';
 643     return $@ ? 0 : 1 ;
 644 }
 645
 646 package CompTestUtils;
 647
 648 1;
 649 __END__
 650         t/Test/Builder.pm
 651         t/Test/More.pm
 652         t/Test/Simple.pm
 653         t/compress/CompTestUtils.pm
 654         t/compress/any.pl
 655         t/compress/anyunc.pl
 656         t/compress/destroy.pl
 657         t/compress/generic.pl
 658         t/compress/merge.pl
 659         t/compress/multi.pl
 660         t/compress/newtied.pl
 661         t/compress/oneshot.pl
 662         t/compress/prime.pl
 663         t/compress/tied.pl
 664         t/compress/truncate.pl
 665         t/compress/zlib-generic.plParsing config.in...
 666 Building Zlib enabled
 667 Auto Detect Gzip OS Code..
 668 Setting Gzip OS Code to 3 [Unix/Default]
 669 Looks Good.