← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:15 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/IO/Zlib.pm
StatementsExecuted 36 statements in 3.50ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.56ms3.27msIO::Zlib::::BEGIN@307IO::Zlib::BEGIN@307
11155µs64µsIO::Zlib::::BEGIN@288IO::Zlib::BEGIN@288
11127µs85µsIO::Zlib::::BEGIN@306IO::Zlib::BEGIN@306
11115µs104µsIO::Zlib::::BEGIN@289IO::Zlib::BEGIN@289
11113µs66µsIO::Zlib::::BEGIN@291IO::Zlib::BEGIN@291
11113µs49µsIO::Zlib::::BEGIN@292IO::Zlib::BEGIN@292
11112µs12µsIO::Zlib::::BEGIN@301IO::Zlib::BEGIN@301
11111µs21µsIO::Zlib::::importIO::Zlib::import
11110µs10µsIO::Zlib::::_aliasIO::Zlib::_alias
0000s0sIO::Zlib::::AUTOLOADIO::Zlib::AUTOLOAD
0000s0sIO::Zlib::::CLOSEIO::Zlib::CLOSE
0000s0sIO::Zlib::::DESTROYIO::Zlib::DESTROY
0000s0sIO::Zlib::::EOFIO::Zlib::EOF
0000s0sIO::Zlib::::FILENOIO::Zlib::FILENO
0000s0sIO::Zlib::::OPENIO::Zlib::OPEN
0000s0sIO::Zlib::::READIO::Zlib::READ
0000s0sIO::Zlib::::READLINEIO::Zlib::READLINE
0000s0sIO::Zlib::::TIEHANDLEIO::Zlib::TIEHANDLE
0000s0sIO::Zlib::::WRITEIO::Zlib::WRITE
0000s0sIO::Zlib::::_importIO::Zlib::_import
0000s0sIO::Zlib::::can_gunzipIO::Zlib::can_gunzip
0000s0sIO::Zlib::::getlineIO::Zlib::getline
0000s0sIO::Zlib::::getlinesIO::Zlib::getlines
0000s0sIO::Zlib::::gzclose_externalIO::Zlib::gzclose_external
0000s0sIO::Zlib::::gzeof_externalIO::Zlib::gzeof_external
0000s0sIO::Zlib::::gzip_externalIO::Zlib::gzip_external
0000s0sIO::Zlib::::gzip_read_openIO::Zlib::gzip_read_open
0000s0sIO::Zlib::::gzip_usedIO::Zlib::gzip_used
0000s0sIO::Zlib::::gzip_write_openIO::Zlib::gzip_write_open
0000s0sIO::Zlib::::gzopen_externalIO::Zlib::gzopen_external
0000s0sIO::Zlib::::gzread_externalIO::Zlib::gzread_external
0000s0sIO::Zlib::::gzreadline_externalIO::Zlib::gzreadline_external
0000s0sIO::Zlib::::gzwrite_externalIO::Zlib::gzwrite_external
0000s0sIO::Zlib::::has_Compress_ZlibIO::Zlib::has_Compress_Zlib
0000s0sIO::Zlib::::newIO::Zlib::new
0000s0sIO::Zlib::::openedIO::Zlib::opened
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# IO::Zlib.pm
2#
3# Copyright (c) 1998-2004 Tom Hughes <[email protected]>.
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
911µs$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<[email protected]>E<gt>.
275
276Support for external gzip added by Jarkko Hietaniemi E<lt>F<[email protected]>E<gt>.
277
278=head1 COPYRIGHT
279
280Copyright (c) 1998-2004 Tom Hughes E<lt>F<[email protected]>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
286116µsrequire 5.006;
287
288255µs273µs
# spent 64µs (55+9) within IO::Zlib::BEGIN@288 which was called: # once (55µs+9µs) by Archive::Tar::BEGIN@11 at line 288
use strict;
# spent 64µs making 1 call to IO::Zlib::BEGIN@288 # spent 9µs making 1 call to strict::import
289250µs2193µs
# spent 104µs (15+89) within IO::Zlib::BEGIN@289 which was called: # once (15µs+89µs) by Archive::Tar::BEGIN@11 at line 289
use vars qw($VERSION $AUTOLOAD @ISA);
# spent 104µs making 1 call to IO::Zlib::BEGIN@289 # spent 89µs making 1 call to vars::import
290
291242µs2119µs
# spent 66µs (13+53) within IO::Zlib::BEGIN@291 which was called: # once (13µs+53µs) by Archive::Tar::BEGIN@11 at line 291
use Carp;
# spent 66µs making 1 call to IO::Zlib::BEGIN@291 # spent 53µs making 1 call to Exporter::import
2922105µs285µs
# spent 49µs (13+36) within IO::Zlib::BEGIN@292 which was called: # once (13µs+36µs) by Archive::Tar::BEGIN@11 at line 292
use Fcntl qw(SEEK_SET);
# spent 49µs making 1 call to IO::Zlib::BEGIN@292 # spent 36µs making 1 call to Exporter::import
293
29410smy $has_Compress_Zlib;
295my $aliased;
296
297sub has_Compress_Zlib {
298 $has_Compress_Zlib;
299}
300
301
# spent 12µs within IO::Zlib::BEGIN@301 which was called: # once (12µs+0s) by Archive::Tar::BEGIN@11 at line 304
BEGIN {
30222µs eval { require Compress::Zlib };
303110µs $has_Compress_Zlib = $@ || $Compress::Zlib::VERSION < 2.000 ? 0 : 1;
304141µs112µs}
# spent 12µs making 1 call to IO::Zlib::BEGIN@301
305
306241µs2143µs
# spent 85µs (27+58) within IO::Zlib::BEGIN@306 which was called: # once (27µs+58µs) by Archive::Tar::BEGIN@11 at line 306
use Symbol;
# spent 85µs making 1 call to IO::Zlib::BEGIN@306 # spent 58µs making 1 call to Exporter::import
30723.10ms13.27ms
# spent 3.27ms (1.56+1.71) within IO::Zlib::BEGIN@307 which was called: # once (1.56ms+1.71ms) by Archive::Tar::BEGIN@11 at line 307
use Tie::Handle;
# spent 3.27ms making 1 call to IO::Zlib::BEGIN@307
308
309# These might use some $^O logic.
31011µsmy $gzip_read_open = "gzip -dc %s |";
31110smy $gzip_write_open = "| gzip > %s";
312
31310smy $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
374
# spent 10µs within IO::Zlib::_alias which was called: # once (10µs+0s) by IO::Zlib::import at line 407
sub _alias {
37510s my $import = shift;
37611µs 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 {
38810s croak "$import: no Compress::Zlib and no external gzip"
389 unless $has_Compress_Zlib;
39011µs *gzopen = \&Compress::Zlib::gzopen;
39113µs *gzread = \&Compress::Zlib::gzread;
39211µs *gzwrite = \&Compress::Zlib::gzwrite;
39311µs *gzreadline = \&Compress::Zlib::gzreadline;
39411µs *gzeof = \&Compress::Zlib::gzeof;
395 }
39617µs $aliased = 1;
397}
398
399
# spent 21µs (11+10) within IO::Zlib::import which was called: # once (11µs+10µs) by Archive::Tar::BEGIN@11 at line 11 of Archive/Tar.pm
sub import {
40011µs shift;
40110s my $import = "IO::Zlib::import";
40211µs if (@_) {
403 if (_import($import, @_)) {
404 croak "$import: '@_' is illegal";
405 }
406 }
40714µs110µs _alias($import);
# spent 10µs making 1 call to IO::Zlib::_alias
408}
409
41018µs@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
65217µs1;
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.