1# IO::Zlib.pm 2# 3# Copyright (c) 1998-2004 Tom Hughes <tom@compton.nu>. 4# All rights reserved. This program is free software; you can redistribute 5# it and/or modify it under the same terms as Perl itself. 6 7package IO::Zlib; 8 9$VERSION = "1.10"; 10 11=head1 NAME 12 13IO::Zlib - IO:: style interface to L<Compress::Zlib> 14 15=head1 SYNOPSIS 16 17With any version of Perl 5 you can use the basic OO interface: 18 19 use IO::Zlib; 20 21 $fh = new IO::Zlib; 22 if ($fh->open("file.gz", "rb")) { 23 print <$fh>; 24 $fh->close; 25 } 26 27 $fh = IO::Zlib->new("file.gz", "wb9"); 28 if (defined $fh) { 29 print $fh "bar\n"; 30 $fh->close; 31 } 32 33 $fh = IO::Zlib->new("file.gz", "rb"); 34 if (defined $fh) { 35 print <$fh>; 36 undef $fh; # automatically closes the file 37 } 38 39With Perl 5.004 you can also use the TIEHANDLE interface to access 40compressed files just like ordinary files: 41 42 use IO::Zlib; 43 44 tie *FILE, 'IO::Zlib', "file.gz", "wb"; 45 print FILE "line 1\nline2\n"; 46 47 tie *FILE, 'IO::Zlib', "file.gz", "rb"; 48 while (<FILE>) { print "LINE: ", $_ }; 49 50=head1 DESCRIPTION 51 52C<IO::Zlib> provides an IO:: style interface to L<Compress::Zlib> and 53hence to gzip/zlib compressed files. It provides many of the same methods 54as the L<IO::Handle> interface. 55 56Starting from IO::Zlib version 1.02, IO::Zlib can also use an 57external F<gzip> command. The default behaviour is to try to use 58an external F<gzip> if no C<Compress::Zlib> can be loaded, unless 59explicitly disabled by 60 61 use IO::Zlib qw(:gzip_external 0); 62 63If explicitly enabled by 64 65 use IO::Zlib qw(:gzip_external 1); 66 67then the external F<gzip> is used B<instead> of C<Compress::Zlib>. 68 69=head1 CONSTRUCTOR 70 71=over 4 72 73=item new ( [ARGS] ) 74 75Creates an C<IO::Zlib> object. If it receives any parameters, they are 76passed to the method C<open>; if the open fails, the object is destroyed. 77Otherwise, it is returned to the caller. 78 79=back 80 81=head1 OBJECT METHODS 82 83=over 4 84 85=item open ( FILENAME, MODE ) 86 87C<open> takes two arguments. The first is the name of the file to open 88and the second is the open mode. The mode can be anything acceptable to 89L<Compress::Zlib> and by extension anything acceptable to I<zlib> (that 90basically means POSIX fopen() style mode strings plus an optional number 91to indicate the compression level). 92 93=item opened 94 95Returns true if the object currently refers to a opened file. 96 97=item close 98 99Close the file associated with the object and disassociate 100the file from the handle. 101Done automatically on destroy. 102 103=item getc 104 105Return the next character from the file, or undef if none remain. 106 107=item getline 108 109Return the next line from the file, or undef on end of string. 110Can safely be called in an array context. 111Currently ignores $/ ($INPUT_RECORD_SEPARATOR or $RS when L<English> 112is in use) and treats lines as delimited by "\n". 113 114=item getlines 115 116Get all remaining lines from the file. 117It will croak() if accidentally called in a scalar context. 118 119=item print ( ARGS... ) 120 121Print ARGS to the file. 122 123=item read ( BUF, NBYTES, [OFFSET] ) 124 125Read some bytes from the file. 126Returns the number of bytes actually read, 0 on end-of-file, undef on error. 127 128=item eof 129 130Returns true if the handle is currently positioned at end of file? 131 132=item seek ( OFFSET, WHENCE ) 133 134Seek to a given position in the stream. 135Not yet supported. 136 137=item tell 138 139Return the current position in the stream, as a numeric offset. 140Not yet supported. 141 142=item setpos ( POS ) 143 144Set the current position, using the opaque value returned by C<getpos()>. 145Not yet supported. 146 147=item getpos ( POS ) 148 149Return the current position in the string, as an opaque object. 150Not yet supported. 151 152=back 153 154=head1 USING THE EXTERNAL GZIP 155 156If the external F<gzip> is used, the following C<open>s are used: 157 158 open(FH, "gzip -dc $filename |") # for read opens 159 open(FH, " | gzip > $filename") # for write opens 160 161You can modify the 'commands' for example to hardwire 162an absolute path by e.g. 163 164 use IO::Zlib ':gzip_read_open' => '/some/where/gunzip -c %s |'; 165 use IO::Zlib ':gzip_write_open' => '| /some/where/gzip.exe > %s'; 166 167The C<%s> is expanded to be the filename (C<sprintf> is used, so be 168careful to escape any other C<%> signs). The 'commands' are checked 169for sanity - they must contain the C<%s>, and the read open must end 170with the pipe sign, and the write open must begin with the pipe sign. 171 172=head1 CLASS METHODS 173 174=over 4 175 176=item has_Compress_Zlib 177 178Returns true if C<Compress::Zlib> is available. Note that this does 179not mean that C<Compress::Zlib> is being used: see L</gzip_external> 180and L<gzip_used>. 181 182=item gzip_external 183 184Undef if an external F<gzip> B<can> be used if C<Compress::Zlib> is 185not available (see L</has_Compress_Zlib>), true if an external F<gzip> 186is explicitly used, false if an external F<gzip> must not be used. 187See L</gzip_used>. 188 189=item gzip_used 190 191True if an external F<gzip> is being used, false if not. 192 193=item gzip_read_open 194 195Return the 'command' being used for opening a file for reading using an 196external F<gzip>. 197 198=item gzip_write_open 199 200Return the 'command' being used for opening a file for writing using an 201external F<gzip>. 202 203=back 204 205=head1 DIAGNOSTICS 206 207=over 4 208 209=item IO::Zlib::getlines: must be called in list context 210 211If you want read lines, you must read in list context. 212 213=item IO::Zlib::gzopen_external: mode '...' is illegal 214 215Use only modes 'rb' or 'wb' or /wb[1-9]/. 216 217=item IO::Zlib::import: '...' is illegal 218 219The known import symbols are the C<:gzip_external>, C<:gzip_read_open>, 220and C<:gzip_write_open>. Anything else is not recognized. 221 222=item IO::Zlib::import: ':gzip_external' requires an argument 223 224The C<:gzip_external> requires one boolean argument. 225 226=item IO::Zlib::import: 'gzip_read_open' requires an argument 227 228The C<:gzip_external> requires one string argument. 229 230=item IO::Zlib::import: 'gzip_read' '...' is illegal 231 232The C<:gzip_read_open> argument must end with the pipe sign (|) 233and have the C<%s> for the filename. See L</"USING THE EXTERNAL GZIP">. 234 235=item IO::Zlib::import: 'gzip_write_open' requires an argument 236 237The C<:gzip_external> requires one string argument. 238 239=item IO::Zlib::import: 'gzip_write_open' '...' is illegal 240 241The C<:gzip_write_open> argument must begin with the pipe sign (|) 242and have the C<%s> for the filename. An output redirect (>) is also 243often a good idea, depending on your operating system shell syntax. 244See L</"USING THE EXTERNAL GZIP">. 245 246=item IO::Zlib::import: no Compress::Zlib and no external gzip 247 248Given that we failed to load C<Compress::Zlib> and that the use of 249 an external F<gzip> was disabled, IO::Zlib has not much chance of working. 250 251=item IO::Zlib::open: needs a filename 252 253No filename, no open. 254 255=item IO::Zlib::READ: NBYTES must be specified 256 257We must know how much to read. 258 259=item IO::Zlib::WRITE: too long LENGTH 260 261The LENGTH must be less than or equal to the buffer size. 262 263=back 264 265=head1 SEE ALSO 266 267L<perlfunc>, 268L<perlop/"I/O Operators">, 269L<IO::Handle>, 270L<Compress::Zlib> 271 272=head1 HISTORY 273 274Created by Tom Hughes E<lt>F<tom@compton.nu>E<gt>. 275 276Support for external gzip added by Jarkko Hietaniemi E<lt>F<jhi@iki.fi>E<gt>. 277 278=head1 COPYRIGHT 279 280Copyright (c) 1998-2004 Tom Hughes E<lt>F<tom@compton.nu>E<gt>. 281All rights reserved. This program is free software; you can redistribute 282it and/or modify it under the same terms as Perl itself. 283 284=cut 285 286require 5.006; 287 288use strict; 289use vars qw($VERSION $AUTOLOAD @ISA); 290 291use Carp; 292use Fcntl qw(SEEK_SET); 293 294my $has_Compress_Zlib; 295my $aliased; 296 297sub has_Compress_Zlib { 298 $has_Compress_Zlib; 299} 300 301BEGIN { 302 eval { require Compress::Zlib }; 303 $has_Compress_Zlib = $@ || $Compress::Zlib::VERSION < 2.000 ? 0 : 1; 304} 305 306use Symbol; 307use Tie::Handle; 308 309# These might use some $^O logic. 310my $gzip_read_open = "gzip -dc %s |"; 311my $gzip_write_open = "| gzip > %s"; 312 313my $gzip_external; 314my $gzip_used; 315 316sub gzip_read_open { 317 $gzip_read_open; 318} 319 320sub gzip_write_open { 321 $gzip_write_open; 322} 323 324sub gzip_external { 325 $gzip_external; 326} 327 328sub gzip_used { 329 $gzip_used; 330} 331 332sub can_gunzip { 333 $has_Compress_Zlib || $gzip_external; 334} 335 336sub _import { 337 my $import = shift; 338 while (@_) { 339 if ($_[0] eq ':gzip_external') { 340 shift; 341 if (@_) { 342 $gzip_external = shift; 343 } else { 344 croak "$import: ':gzip_external' requires an argument"; 345 } 346 } 347 elsif ($_[0] eq ':gzip_read_open') { 348 shift; 349 if (@_) { 350 $gzip_read_open = shift; 351 croak "$import: ':gzip_read_open' '$gzip_read_open' is illegal" 352 unless $gzip_read_open =~ /^.+%s.+\|\s*$/; 353 } else { 354 croak "$import: ':gzip_read_open' requires an argument"; 355 } 356 } 357 elsif ($_[0] eq ':gzip_write_open') { 358 shift; 359 if (@_) { 360 $gzip_write_open = shift; 361 croak "$import: ':gzip_write_open' '$gzip_read_open' is illegal" 362 unless $gzip_write_open =~ /^\s*\|.+%s.*$/; 363 } else { 364 croak "$import: ':gzip_write_open' requires an argument"; 365 } 366 } 367 else { 368 last; 369 } 370 } 371 return @_; 372} 373 374sub _alias { 375 my $import = shift; 376 if ((!$has_Compress_Zlib && !defined $gzip_external) || $gzip_external) { 377 # The undef *gzopen is really needed only during 378 # testing where we eval several 'use IO::Zlib's. 379 undef *gzopen; 380 *gzopen = \&gzopen_external; 381 *IO::Handle::gzread = \&gzread_external; 382 *IO::Handle::gzwrite = \&gzwrite_external; 383 *IO::Handle::gzreadline = \&gzreadline_external; 384 *IO::Handle::gzeof = \&gzeof_external; 385 *IO::Handle::gzclose = \&gzclose_external; 386 $gzip_used = 1; 387 } else { 388 croak "$import: no Compress::Zlib and no external gzip" 389 unless $has_Compress_Zlib; 390 *gzopen = \&Compress::Zlib::gzopen; 391 *gzread = \&Compress::Zlib::gzread; 392 *gzwrite = \&Compress::Zlib::gzwrite; 393 *gzreadline = \&Compress::Zlib::gzreadline; 394 *gzeof = \&Compress::Zlib::gzeof; 395 } 396 $aliased = 1; 397} 398 399sub import { 400 shift; 401 my $import = "IO::Zlib::import"; 402 if (@_) { 403 if (_import($import, @_)) { 404 croak "$import: '@_' is illegal"; 405 } 406 } 407 _alias($import); 408} 409 410@ISA = qw(Tie::Handle); 411 412sub TIEHANDLE 413{ 414 my $class = shift; 415 my @args = @_; 416 417 my $self = bless {}, $class; 418 419 return @args ? $self->OPEN(@args) : $self; 420} 421 422sub DESTROY 423{ 424} 425 426sub OPEN 427{ 428 my $self = shift; 429 my $filename = shift; 430 my $mode = shift; 431 432 croak "IO::Zlib::open: needs a filename" unless defined($filename); 433 434 $self->{'file'} = gzopen($filename,$mode); 435 436 return defined($self->{'file'}) ? $self : undef; 437} 438 439sub CLOSE 440{ 441 my $self = shift; 442 443 return undef unless defined($self->{'file'}); 444 445 my $status = $self->{'file'}->gzclose(); 446 447 delete $self->{'file'}; 448 449 return ($status == 0) ? 1 : undef; 450} 451 452sub READ 453{ 454 my $self = shift; 455 my $bufref = \$_[0]; 456 my $nbytes = $_[1]; 457 my $offset = $_[2] || 0; 458 459 croak "IO::Zlib::READ: NBYTES must be specified" unless defined($nbytes); 460 461 $$bufref = "" unless defined($$bufref); 462 463 my $bytesread = $self->{'file'}->gzread(substr($$bufref,$offset),$nbytes); 464 465 return undef if $bytesread < 0; 466 467 return $bytesread; 468} 469 470sub READLINE 471{ 472 my $self = shift; 473 474 my $line; 475 476 return () if $self->{'file'}->gzreadline($line) <= 0; 477 478 return $line unless wantarray; 479 480 my @lines = $line; 481 482 while ($self->{'file'}->gzreadline($line) > 0) 483 { 484 push @lines, $line; 485 } 486 487 return @lines; 488} 489 490sub WRITE 491{ 492 my $self = shift; 493 my $buf = shift; 494 my $length = shift; 495 my $offset = shift; 496 497 croak "IO::Zlib::WRITE: too long LENGTH" unless $offset + $length <= length($buf); 498 499 return $self->{'file'}->gzwrite(substr($buf,$offset,$length)); 500} 501 502sub EOF 503{ 504 my $self = shift; 505 506 return $self->{'file'}->gzeof(); 507} 508 509sub FILENO 510{ 511 return undef; 512} 513 514sub new 515{ 516 my $class = shift; 517 my @args = @_; 518 519 _alias("new", @_) unless $aliased; # Some call new IO::Zlib directly... 520 521 my $self = gensym(); 522 523 tie *{$self}, $class, @args; 524 525 return tied(${$self}) ? bless $self, $class : undef; 526} 527 528sub getline 529{ 530 my $self = shift; 531 532 return scalar tied(*{$self})->READLINE(); 533} 534 535sub getlines 536{ 537 my $self = shift; 538 539 croak "IO::Zlib::getlines: must be called in list context" 540 unless wantarray; 541 542 return tied(*{$self})->READLINE(); 543} 544 545sub opened 546{ 547 my $self = shift; 548 549 return defined tied(*{$self})->{'file'}; 550} 551 552sub AUTOLOAD 553{ 554 my $self = shift; 555 556 $AUTOLOAD =~ s/.*:://; 557 $AUTOLOAD =~ tr/a-z/A-Z/; 558 559 return tied(*{$self})->$AUTOLOAD(@_); 560} 561 562sub gzopen_external { 563 my ($filename, $mode) = @_; 564 require IO::Handle; 565 my $fh = IO::Handle->new(); 566 if ($mode =~ /r/) { 567 # Because someone will try to read ungzipped files 568 # with this we peek and verify the signature. Yes, 569 # this means that we open the file twice (if it is 570 # gzipped). 571 # Plenty of race conditions exist in this code, but 572 # the alternative would be to capture the stderr of 573 # gzip and parse it, which would be a portability nightmare. 574 if (-e $filename && open($fh, $filename)) { 575 binmode $fh; 576 my $sig; 577 my $rdb = read($fh, $sig, 2); 578 if ($rdb == 2 && $sig eq "\x1F\x8B") { 579 my $ropen = sprintf $gzip_read_open, $filename; 580 if (open($fh, $ropen)) { 581 binmode $fh; 582 return $fh; 583 } else { 584 return undef; 585 } 586 } 587 seek($fh, 0, SEEK_SET) or 588 die "IO::Zlib: open('$filename', 'r'): seek: $!"; 589 return $fh; 590 } else { 591 return undef; 592 } 593 } elsif ($mode =~ /w/) { 594 my $level = ''; 595 $level = "-$1" if $mode =~ /([1-9])/; 596 # To maximize portability we would need to open 597 # two filehandles here, one for "| gzip $level" 598 # and another for "> $filename", and then when 599 # writing copy bytes from the first to the second. 600 # We are using IO::Handle objects for now, however, 601 # and they can only contain one stream at a time. 602 my $wopen = sprintf $gzip_write_open, $filename; 603 if (open($fh, $wopen)) { 604 $fh->autoflush(1); 605 binmode $fh; 606 return $fh; 607 } else { 608 return undef; 609 } 610 } else { 611 croak "IO::Zlib::gzopen_external: mode '$mode' is illegal"; 612 } 613 return undef; 614} 615 616sub gzread_external { 617 # Use read() instead of syswrite() because people may 618 # mix reads and readlines, and we don't want to mess 619 # the stdio buffering. See also gzreadline_external() 620 # and gzwrite_external(). 621 my $nread = read($_[0], $_[1], @_ == 3 ? $_[2] : 4096); 622 defined $nread ? $nread : -1; 623} 624 625sub gzwrite_external { 626 # Using syswrite() is okay (cf. gzread_external()) 627 # since the bytes leave this process and buffering 628 # is therefore not an issue. 629 my $nwrote = syswrite($_[0], $_[1]); 630 defined $nwrote ? $nwrote : -1; 631} 632 633sub gzreadline_external { 634 # See the comment in gzread_external(). 635 $_[1] = readline($_[0]); 636 return defined $_[1] ? length($_[1]) : -1; 637} 638 639sub gzeof_external { 640 return eof($_[0]); 641} 642 643sub gzclose_external { 644 close($_[0]); 645 # I am not entirely certain why this is needed but it seems 646 # the above close() always fails (as if the stream would have 647 # been already closed - something to do with using external 648 # processes via pipes?) 649 return 0; 650} 651 6521; 653