1package CompTestUtils; 2 3package main ; 4 5use strict ; 6use warnings; 7use bytes; 8 9#use lib qw(t t/compress); 10 11use Carp ; 12#use Test::More ; 13 14 15 16sub title 17{ 18 #diag "" ; 19 ok 1, $_[0] ; 20 #diag "" ; 21} 22 23sub 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} 74sub 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 100sub touch 101{ 102 foreach (@_) { writeFile($_, '') } 103} 104 105sub 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 119sub 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 135sub 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 173sub readHeaderInfo 174{ 175 my $name = shift ; 176 my %opts = @_ ; 177 178 my $string = <<EOM; 179some text 180EOM 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 200sub cmpFile 201{ 202 my ($filename, $uue) = @_ ; 203 return readFile($filename) eq unpack("u", $uue) ; 204} 205 206sub isRawFormat 207{ 208 my $class = shift; 209 my %raw = map { $_ => 1 } qw( RawDeflate ); 210 211 return defined $raw{$class}; 212} 213 214sub 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::Lzma' => 'IO::Uncompress::UnLzma', 236 'IO::Compress::Lzma::lzma' => 'IO::Uncompress::UnLzma', 237 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', 238 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp', 239 ); 240 241 my $out ; 242 my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1); 243 1 while $obj->read($out) > 0 ; 244 return $out ; 245 246} 247 248my %ErrorMap = ( 'IO::Compress::Gzip' => \$IO::Compress::Gzip::GzipError, 249 'IO::Compress::Gzip::gzip' => \$IO::Compress::Gzip::GzipError, 250 'IO::Uncompress::Gunzip' => \$IO::Uncompress::Gunzip::GunzipError, 251 'IO::Uncompress::Gunzip::gunzip' => \$IO::Uncompress::Gunzip::GunzipError, 252 'IO::Uncompress::Inflate' => \$IO::Uncompress::Inflate::InflateError, 253 'IO::Uncompress::Inflate::inflate' => \$IO::Uncompress::Inflate::InflateError, 254 'IO::Compress::Deflate' => \$IO::Compress::Deflate::DeflateError, 255 'IO::Compress::Deflate::deflate' => \$IO::Compress::Deflate::DeflateError, 256 'IO::Uncompress::RawInflate' => \$IO::Uncompress::RawInflate::RawInflateError, 257 'IO::Uncompress::RawInflate::rawinflate' => \$IO::Uncompress::RawInflate::RawInflateError, 258 'IO::Uncompress::AnyInflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, 259 'IO::Uncompress::AnyInflate::anyinflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, 260 'IO::Uncompress::AnyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, 261 'IO::Uncompress::AnyUncompress::anyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, 262 'IO::Compress::RawDeflate' => \$IO::Compress::RawDeflate::RawDeflateError, 263 'IO::Compress::RawDeflate::rawdeflate' => \$IO::Compress::RawDeflate::RawDeflateError, 264 'IO::Compress::Bzip2' => \$IO::Compress::Bzip2::Bzip2Error, 265 'IO::Compress::Bzip2::bzip2' => \$IO::Compress::Bzip2::Bzip2Error, 266 'IO::Uncompress::Bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, 267 'IO::Uncompress::Bunzip2::bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, 268 'IO::Compress::Zip' => \$IO::Compress::Zip::ZipError, 269 'IO::Compress::Zip::zip' => \$IO::Compress::Zip::ZipError, 270 'IO::Uncompress::Unzip' => \$IO::Uncompress::Unzip::UnzipError, 271 'IO::Uncompress::Unzip::unzip' => \$IO::Uncompress::Unzip::UnzipError, 272 'IO::Compress::Lzop' => \$IO::Compress::Lzop::LzopError, 273 'IO::Compress::Lzop::lzop' => \$IO::Compress::Lzop::LzopError, 274 'IO::Uncompress::UnLzop' => \$IO::Uncompress::UnLzop::UnLzopError, 275 'IO::Uncompress::UnLzop::unlzop' => \$IO::Uncompress::UnLzop::UnLzopError, 276 'IO::Compress::Lzf' => \$IO::Compress::Lzf::LzfError, 277 'IO::Compress::Lzf::lzf' => \$IO::Compress::Lzf::LzfError, 278 'IO::Uncompress::UnLzf' => \$IO::Uncompress::UnLzf::UnLzfError, 279 'IO::Uncompress::UnLzf::unlzf' => \$IO::Uncompress::UnLzf::UnLzfError, 280 'IO::Compress::PPMd' => \$IO::Compress::PPMd::PPMdError, 281 'IO::Compress::PPMd::ppmd' => \$IO::Compress::PPMd::PPMdError, 282 'IO::Uncompress::UnPPMd' => \$IO::Uncompress::UnPPMd::UnPPMdError, 283 'IO::Uncompress::UnPPMd::unppmd' => \$IO::Uncompress::UnPPMd::UnPPMdError, 284 'IO::Compress::Lzma' => \$IO::Compress::Lzma::LzmaError, 285 'IO::Compress::Lzma::lzma' => \$IO::Compress::Lzma::LzmaError, 286 'IO::Uncompress::UnLzma' => \$IO::Uncompress::UnLzma::UnLzmaError, 287 'IO::Uncompress::UnLzma::unlzma' => \$IO::Uncompress::UnLzma::UnLzmaError, 288 289 'IO::Compress::DummyComp' => \$IO::Compress::DummyComp::DummyCompError, 290 'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError, 291 'IO::Uncompress::DummyUncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, 292 'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, 293 ); 294 295my %TopFuncMap = ( 'IO::Compress::Gzip' => 'IO::Compress::Gzip::gzip', 296 'IO::Uncompress::Gunzip' => 'IO::Uncompress::Gunzip::gunzip', 297 298 'IO::Compress::Deflate' => 'IO::Compress::Deflate::deflate', 299 'IO::Uncompress::Inflate' => 'IO::Uncompress::Inflate::inflate', 300 301 'IO::Compress::RawDeflate' => 'IO::Compress::RawDeflate::rawdeflate', 302 'IO::Uncompress::RawInflate' => 'IO::Uncompress::RawInflate::rawinflate', 303 304 'IO::Uncompress::AnyInflate' => 'IO::Uncompress::AnyInflate::anyinflate', 305 'IO::Uncompress::AnyUncompress' => 'IO::Uncompress::AnyUncompress::anyuncompress', 306 307 'IO::Compress::Bzip2' => 'IO::Compress::Bzip2::bzip2', 308 'IO::Uncompress::Bunzip2' => 'IO::Uncompress::Bunzip2::bunzip2', 309 310 'IO::Compress::Zip' => 'IO::Compress::Zip::zip', 311 'IO::Uncompress::Unzip' => 'IO::Uncompress::Unzip::unzip', 312 'IO::Compress::Lzop' => 'IO::Compress::Lzop::lzop', 313 'IO::Uncompress::UnLzop' => 'IO::Uncompress::UnLzop::unlzop', 314 'IO::Compress::Lzf' => 'IO::Compress::Lzf::lzf', 315 'IO::Uncompress::UnLzf' => 'IO::Uncompress::UnLzf::unlzf', 316 'IO::Compress::PPMd' => 'IO::Compress::PPMd::ppmd', 317 'IO::Uncompress::UnPPMd' => 'IO::Uncompress::UnPPMd::unppmd', 318 319 'IO::Compress::Lzma' => 'IO::Compress::Lzma::lzma', 320 'IO::Uncompress::UnLzma' => 'IO::Uncompress::UnLzma::unlzma', 321 322 'IO::Compress::DummyComp' => 'IO::Compress::DummyComp::dummyuncomp', 323 'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', 324 ); 325 326 %TopFuncMap = map { ($_ => $TopFuncMap{$_}, 327 $TopFuncMap{$_} => $TopFuncMap{$_}) } 328 keys %TopFuncMap ; 329 330 #%TopFuncMap = map { ($_ => \&{ $TopFuncMap{$_} ) } 331 #keys %TopFuncMap ; 332 333 334my %inverse = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', 335 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip::gunzip', 336 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', 337 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate::inflate', 338 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', 339 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate::rawinflate', 340 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2::bunzip2', 341 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', 342 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip::unzip', 343 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', 344 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop::unlzop', 345 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', 346 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf::unlzf', 347 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf', 348 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd::unppmd', 349 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd', 350 'IO::Compress::Lzma::lzma' => 'IO::Uncompress::UnLzma::unlzma', 351 'IO::Compress::Lzma' => 'IO::Uncompress::UnLzma', 352 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', 353 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', 354 ); 355 356%inverse = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse; 357 358sub getInverse 359{ 360 my $class = shift ; 361 362 return $inverse{$class} ; 363} 364 365sub getErrorRef 366{ 367 my $class = shift ; 368 369 return $ErrorMap{$class} ; 370} 371 372sub getTopFuncRef 373{ 374 my $class = shift ; 375 376 return \&{ $TopFuncMap{$class} } ; 377} 378 379sub getTopFuncName 380{ 381 my $class = shift ; 382 383 return $TopFuncMap{$class} ; 384} 385 386sub compressBuffer 387{ 388 my $compWith = shift ; 389 my $buffer = shift ; 390 391 my %mapping = ( 'IO::Uncompress::Gunzip' => 'IO::Compress::Gzip', 392 'IO::Uncompress::Gunzip::gunzip' => 'IO::Compress::Gzip', 393 'IO::Uncompress::Inflate' => 'IO::Compress::Deflate', 394 'IO::Uncompress::Inflate::inflate' => 'IO::Compress::Deflate', 395 'IO::Uncompress::RawInflate' => 'IO::Compress::RawDeflate', 396 'IO::Uncompress::RawInflate::rawinflate' => 'IO::Compress::RawDeflate', 397 'IO::Uncompress::Bunzip2' => 'IO::Compress::Bzip2', 398 'IO::Uncompress::Bunzip2::bunzip2' => 'IO::Compress::Bzip2', 399 'IO::Uncompress::Unzip' => 'IO::Compress::Zip', 400 'IO::Uncompress::Unzip::unzip' => 'IO::Compress::Zip', 401 'IO::Uncompress::UnLzop' => 'IO::Compress::Lzop', 402 'IO::Uncompress::UnLzop::unlzop' => 'IO::Compress::Lzop', 403 'IO::Uncompress::UnLzp' => 'IO::Compress::Lzf', 404 'IO::Uncompress::UnLzf::unlzf' => 'IO::Compress::Lzf', 405 'IO::Uncompress::UnPPMd' => 'IO::Compress::PPMd', 406 'IO::Uncompress::UnPPMd::unppmd' => 'IO::Compress::PPMd', 407 'IO::Uncompress::AnyInflate' => 'IO::Compress::Gzip', 408 'IO::Uncompress::AnyInflate::anyinflate' => 'IO::Compress::Gzip', 409 'IO::Uncompress::AnyUncompress' => 'IO::Compress::Gzip', 410 'IO::Uncompress::AnyUncompress::anyuncompress' => 'IO::Compress::Gzip', 411 'IO::Uncompress::UnLzma' => 'IO::Compress::Lzma', 412 'IO::Uncompress::UnLzma::unlzma' => 'IO::Compress::Lzma', 413 'IO::Uncompress::DummyUncomp' => 'IO::Compress::DummyComp', 414 'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp', 415 ); 416 417 my $out ; 418 my $obj = $mapping{$compWith}->new( \$out); 419 $obj->write($buffer) ; 420 $obj->close(); 421 return $out ; 422} 423 424our ($AnyUncompressError); 425BEGIN 426{ 427 eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); '; 428} 429 430sub anyUncompress 431{ 432 my $buffer = shift ; 433 my $already = shift; 434 435 my @opts = (); 436 if (ref $buffer && ref $buffer eq 'ARRAY') 437 { 438 @opts = @$buffer; 439 $buffer = shift @opts; 440 } 441 442 if (ref $buffer) 443 { 444 croak "buffer is undef" unless defined $$buffer; 445 croak "buffer is empty" unless length $$buffer; 446 447 } 448 449 450 my $data ; 451 if (IO::Compress::Base::Common::isaFilehandle($buffer)) 452 { 453 $data = readFile($buffer); 454 } 455 elsif (IO::Compress::Base::Common::isaFilename($buffer)) 456 { 457 $data = readFile($buffer); 458 } 459 else 460 { 461 $data = $$buffer ; 462 } 463 464 if (defined $already && length $already) 465 { 466 467 my $got = substr($data, 0, length($already)); 468 substr($data, 0, length($already)) = ''; 469 470 is $got, $already, ' Already OK' ; 471 } 472 473 my $out = ''; 474 my $o = new IO::Uncompress::AnyUncompress \$data, 475 Append => 1, 476 Transparent => 0, 477 RawInflate => 1, 478 @opts 479 or croak "Cannot open buffer/file: $AnyUncompressError" ; 480 481 1 while $o->read($out) > 0 ; 482 483 croak "Error uncompressing -- " . $o->error() 484 if $o->error() ; 485 486 return $out ; 487 488} 489 490sub getHeaders 491{ 492 my $buffer = shift ; 493 my $already = shift; 494 495 my @opts = (); 496 if (ref $buffer && ref $buffer eq 'ARRAY') 497 { 498 @opts = @$buffer; 499 $buffer = shift @opts; 500 } 501 502 if (ref $buffer) 503 { 504 croak "buffer is undef" unless defined $$buffer; 505 croak "buffer is empty" unless length $$buffer; 506 507 } 508 509 510 my $data ; 511 if (IO::Compress::Base::Common::isaFilehandle($buffer)) 512 { 513 $data = readFile($buffer); 514 } 515 elsif (IO::Compress::Base::Common::isaFilename($buffer)) 516 { 517 $data = readFile($buffer); 518 } 519 else 520 { 521 $data = $$buffer ; 522 } 523 524 if (defined $already && length $already) 525 { 526 527 my $got = substr($data, 0, length($already)); 528 substr($data, 0, length($already)) = ''; 529 530 is $got, $already, ' Already OK' ; 531 } 532 533 my $out = ''; 534 my $o = new IO::Uncompress::AnyUncompress \$data, 535 MultiStream => 1, 536 Append => 1, 537 Transparent => 0, 538 RawInflate => 1, 539 @opts 540 or croak "Cannot open buffer/file: $AnyUncompressError" ; 541 542 1 while $o->read($out) > 0 ; 543 544 croak "Error uncompressing -- " . $o->error() 545 if $o->error() ; 546 547 return ($o->getHeaderInfo()) ; 548 549} 550 551sub mkComplete 552{ 553 my $class = shift ; 554 my $data = shift; 555 my $Error = getErrorRef($class); 556 557 my $buffer ; 558 my %params = (); 559 560 if ($class eq 'IO::Compress::Gzip') { 561 %params = ( 562 Name => "My name", 563 Comment => "a comment", 564 ExtraField => ['ab' => "extra"], 565 HeaderCRC => 1); 566 } 567 elsif ($class eq 'IO::Compress::Zip'){ 568 %params = ( 569 Name => "My name", 570 Comment => "a comment", 571 ZipComment => "last comment", 572 exTime => [100, 200, 300], 573 ExtraFieldLocal => ["ab" => "extra1"], 574 ExtraFieldCentral => ["cd" => "extra2"], 575 ); 576 } 577 578 my $z = new $class( \$buffer, %params) 579 or croak "Cannot create $class object: $$Error"; 580 $z->write($data); 581 $z->close(); 582 583 my $unc = getInverse($class); 584 anyUncompress(\$buffer) eq $data 585 or die "bad bad bad"; 586 my $u = new $unc( \$buffer); 587 my $info = $u->getHeaderInfo() ; 588 589 590 return wantarray ? ($info, $buffer) : $buffer ; 591} 592 593sub mkErr 594{ 595 my $string = shift ; 596 my ($dummy, $file, $line) = caller ; 597 -- $line ; 598 599 $file = quotemeta($file); 600 601 #return "/$string\\s+at $file line $line/" if $] >= 5.006 ; 602 return "/$string\\s+at /" ; 603} 604 605sub mkEvalErr 606{ 607 my $string = shift ; 608 609 return "/$string\\s+at \\(eval /" if $] > 5.006 ; 610 return "/$string\\s+at /" ; 611} 612 613sub dumpObj 614{ 615 my $obj = shift ; 616 617 my ($dummy, $file, $line) = caller ; 618 619 if (@_) 620 { 621 print "#\n# dumpOBJ from $file line $line @_\n" ; 622 } 623 else 624 { 625 print "#\n# dumpOBJ from $file line $line \n" ; 626 } 627 628 my $max = 0 ;; 629 foreach my $k (keys %{ *$obj }) 630 { 631 $max = length $k if length $k > $max ; 632 } 633 634 foreach my $k (sort keys %{ *$obj }) 635 { 636 my $v = $obj->{$k} ; 637 $v = '-undef-' unless defined $v; 638 my $pad = ' ' x ($max - length($k) + 2) ; 639 print "# $k$pad: [$v]\n"; 640 } 641 print "#\n" ; 642} 643 644 645sub getMultiValues 646{ 647 my $class = shift ; 648 649 return (0,0) if $class =~ /lzf/i; 650 return (1,0); 651} 652 653 654sub gotScalarUtilXS 655{ 656 eval ' use Scalar::Util "dualvar" '; 657 return $@ ? 0 : 1 ; 658} 659 660sub currmem { 661 662 # From https://github.com/eserte/srezic-repository/blob/master/perl/currmem#L14 663 664 my $pid = shift || $$; 665 666 no warnings 'portable'; # because of possible large hex values on 64bit systems 667 668 if ($^O eq 'freebsd' && open(MAP, "dd if=/proc/$pid/map bs=64k 2>/dev/null |")) { # FreeBSD 669 my $mem = 0; 670 my $realmem = 0; 671 while(<MAP>) { 672 my(@l) = split /\s+/; 673 my $delta = (hex($l[1])-hex($l[0])); 674 $mem += $delta; 675 if ($l[11] ne 'vnode') { 676 $realmem += $delta; 677 } 678 679 } 680 681 close MAP; 682 ($mem, $realmem); 683 684 } elsif ($^O eq 'linux' && open(MAP, "/proc/$pid/maps")) { # Linux 685 686 my $mem = 0; 687 my $realmem = 0; 688 while(<MAP>) { 689 my(@l) = split /\s+/; 690 my($start,$end) = split /-/, $l[0]; 691 my $delta = (hex($end)-hex($start)); 692 $mem += $delta; 693 if (!defined $l[5] || $l[5] eq '' || $l[5] eq '[heap]') { 694 $realmem += $delta; 695 } 696 } 697 close MAP; 698 ($mem, $realmem); 699 } else { 700 undef; 701 } 702} 703 704sub displayMemoryUsage 705{ 706 my $message = shift; 707 708 my ($mem, $realmem) = currmem(); 709 print "$message:\t$mem\t$realmem\n"; 710} 711 712package CompTestUtils; 713 7141; 715__END__ 716 t/Test/Builder.pm 717 t/Test/More.pm 718 t/Test/Simple.pm 719 t/compress/CompTestUtils.pm 720 t/compress/any.pl 721 t/compress/anyunc.pl 722 t/compress/destroy.pl 723 t/compress/generic.pl 724 t/compress/merge.pl 725 t/compress/multi.pl 726 t/compress/newtied.pl 727 t/compress/oneshot.pl 728 t/compress/prime.pl 729 t/compress/tied.pl 730 t/compress/truncate.pl 731 t/compress/zlib-generic.plParsing config.in... 732Building Zlib enabled 733Auto Detect Gzip OS Code.. 734Setting Gzip OS Code to 3 [Unix/Default] 735Looks Good. 736