← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:24 2013

Filename/usr/lib64/perl5/vendor_perl/5.16.0/IO/Scalar.pm
StatementsExecuted 19 statements in 10.8ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11184µs339µsIO::Scalar::::BEGIN@149IO::Scalar::BEGIN@149
11173µs73µsIO::Scalar::::BEGIN@154IO::Scalar::BEGIN@154
11172µs182µsIO::Scalar::::BEGIN@152IO::Scalar::BEGIN@152
11163µs236µsIO::Scalar::::BEGIN@157IO::Scalar::BEGIN@157
11155µs180µsIO::Scalar::::BEGIN@158IO::Scalar::BEGIN@158
11149µs136µsIO::Scalar::::BEGIN@150IO::Scalar::BEGIN@150
11147µs286µsIO::Scalar::::BEGIN@151IO::Scalar::BEGIN@151
0000s0sIO::Scalar::::CLOSEIO::Scalar::CLOSE
0000s0sIO::Scalar::::DESTROYIO::Scalar::DESTROY
0000s0sIO::Scalar::::EOFIO::Scalar::EOF
0000s0sIO::Scalar::::GETCIO::Scalar::GETC
0000s0sIO::Scalar::::PRINTIO::Scalar::PRINT
0000s0sIO::Scalar::::PRINTFIO::Scalar::PRINTF
0000s0sIO::Scalar::::READIO::Scalar::READ
0000s0sIO::Scalar::::READLINEIO::Scalar::READLINE
0000s0sIO::Scalar::::SEEKIO::Scalar::SEEK
0000s0sIO::Scalar::::TELLIO::Scalar::TELL
0000s0sIO::Scalar::::TIEHANDLEIO::Scalar::TIEHANDLE
0000s0sIO::Scalar::::WRITEIO::Scalar::WRITE
0000s0sIO::Scalar::::__ANON__[:157]IO::Scalar::__ANON__[:157]
0000s0sIO::Scalar::::__ANON__[:158]IO::Scalar::__ANON__[:158]
0000s0sIO::Scalar::::_old_printIO::Scalar::_old_print
0000s0sIO::Scalar::::_unsafe_printIO::Scalar::_unsafe_print
0000s0sIO::Scalar::::autoflushIO::Scalar::autoflush
0000s0sIO::Scalar::::binmodeIO::Scalar::binmode
0000s0sIO::Scalar::::clearerrIO::Scalar::clearerr
0000s0sIO::Scalar::::closeIO::Scalar::close
0000s0sIO::Scalar::::eofIO::Scalar::eof
0000s0sIO::Scalar::::flushIO::Scalar::flush
0000s0sIO::Scalar::::getcIO::Scalar::getc
0000s0sIO::Scalar::::getlineIO::Scalar::getline
0000s0sIO::Scalar::::getlinesIO::Scalar::getlines
0000s0sIO::Scalar::::newIO::Scalar::new
0000s0sIO::Scalar::::openIO::Scalar::open
0000s0sIO::Scalar::::openedIO::Scalar::opened
0000s0sIO::Scalar::::printIO::Scalar::print
0000s0sIO::Scalar::::readIO::Scalar::read
0000s0sIO::Scalar::::seekIO::Scalar::seek
0000s0sIO::Scalar::::setposIO::Scalar::setpos
0000s0sIO::Scalar::::srefIO::Scalar::sref
0000s0sIO::Scalar::::sysreadIO::Scalar::sysread
0000s0sIO::Scalar::::sysseekIO::Scalar::sysseek
0000s0sIO::Scalar::::syswriteIO::Scalar::syswrite
0000s0sIO::Scalar::::tellIO::Scalar::tell
0000s0sIO::Scalar::::use_RSIO::Scalar::use_RS
0000s0sIO::Scalar::::writeIO::Scalar::write
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package IO::Scalar;
2
3
4=head1 NAME
5
6IO::Scalar - IO:: interface for reading/writing a scalar
7
8
9=head1 SYNOPSIS
10
11Perform I/O on strings, using the basic OO interface...
12
13 use 5.005;
14 use IO::Scalar;
15 $data = "My message:\n";
16
17 ### Open a handle on a string, and append to it:
18 $SH = new IO::Scalar \$data;
19 $SH->print("Hello");
20 $SH->print(", world!\nBye now!\n");
21 print "The string is now: ", $data, "\n";
22
23 ### Open a handle on a string, read it line-by-line, then close it:
24 $SH = new IO::Scalar \$data;
25 while (defined($_ = $SH->getline)) {
26 print "Got line: $_";
27 }
28 $SH->close;
29
30 ### Open a handle on a string, and slurp in all the lines:
31 $SH = new IO::Scalar \$data;
32 print "All lines:\n", $SH->getlines;
33
34 ### Get the current position (either of two ways):
35 $pos = $SH->getpos;
36 $offset = $SH->tell;
37
38 ### Set the current position (either of two ways):
39 $SH->setpos($pos);
40 $SH->seek($offset, 0);
41
42 ### Open an anonymous temporary scalar:
43 $SH = new IO::Scalar;
44 $SH->print("Hi there!");
45 print "I printed: ", ${$SH->sref}, "\n"; ### get at value
46
47
48Don't like OO for your I/O? No problem.
49Thanks to the magic of an invisible tie(), the following now
50works out of the box, just as it does with IO::Handle:
51
52 use 5.005;
53 use IO::Scalar;
54 $data = "My message:\n";
55
56 ### Open a handle on a string, and append to it:
57 $SH = new IO::Scalar \$data;
58 print $SH "Hello";
59 print $SH ", world!\nBye now!\n";
60 print "The string is now: ", $data, "\n";
61
62 ### Open a handle on a string, read it line-by-line, then close it:
63 $SH = new IO::Scalar \$data;
64 while (<$SH>) {
65 print "Got line: $_";
66 }
67 close $SH;
68
69 ### Open a handle on a string, and slurp in all the lines:
70 $SH = new IO::Scalar \$data;
71 print "All lines:\n", <$SH>;
72
73 ### Get the current position (WARNING: requires 5.6):
74 $offset = tell $SH;
75
76 ### Set the current position (WARNING: requires 5.6):
77 seek $SH, $offset, 0;
78
79 ### Open an anonymous temporary scalar:
80 $SH = new IO::Scalar;
81 print $SH "Hi there!";
82 print "I printed: ", ${$SH->sref}, "\n"; ### get at value
83
84
85And for you folks with 1.x code out there: the old tie() style still works,
86though this is I<unnecessary and deprecated>:
87
88 use IO::Scalar;
89
90 ### Writing to a scalar...
91 my $s;
92 tie *OUT, 'IO::Scalar', \$s;
93 print OUT "line 1\nline 2\n", "line 3\n";
94 print "String is now: $s\n"
95
96 ### Reading and writing an anonymous scalar...
97 tie *OUT, 'IO::Scalar';
98 print OUT "line 1\nline 2\n", "line 3\n";
99 tied(OUT)->seek(0,0);
100 while (<OUT>) {
101 print "Got line: ", $_;
102 }
103
104
105Stringification works, too!
106
107 my $SH = new IO::Scalar \$data;
108 print $SH "Hello, ";
109 print $SH "world!";
110 print "I printed: $SH\n";
111
- -
114=head1 DESCRIPTION
115
116This class is part of the IO::Stringy distribution;
117see L<IO::Stringy> for change log and general information.
118
119The IO::Scalar class implements objects which behave just like
120IO::Handle (or FileHandle) objects, except that you may use them
121to write to (or read from) scalars. These handles are
122automatically tiehandle'd (though please see L<"WARNINGS">
123for information relevant to your Perl version).
124
125
126Basically, this:
127
128 my $s;
129 $SH = new IO::Scalar \$s;
130 $SH->print("Hel", "lo, "); ### OO style
131 $SH->print("world!\n"); ### ditto
132
133Or this:
134
135 my $s;
136 $SH = tie *OUT, 'IO::Scalar', \$s;
137 print OUT "Hel", "lo, "; ### non-OO style
138 print OUT "world!\n"; ### ditto
139
140Causes $s to be set to:
141
142 "Hello, world!\n"
143
144
145=head1 PUBLIC INTERFACE
146
147=cut
148
1492161µs2594µs
# spent 339µs (84+255) within IO::Scalar::BEGIN@149 which was called: # once (84µs+255µs) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 149
use Carp;
# spent 339µs making 1 call to IO::Scalar::BEGIN@149 # spent 255µs making 1 call to Exporter::import
1502172µs2222µs
# spent 136µs (49+87) within IO::Scalar::BEGIN@150 which was called: # once (49µs+87µs) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 150
use strict;
# spent 136µs making 1 call to IO::Scalar::BEGIN@150 # spent 87µs making 1 call to strict::import
1512231µs2525µs
# spent 286µs (47+239) within IO::Scalar::BEGIN@151 which was called: # once (47µs+239µs) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 151
use vars qw($VERSION @ISA);
# spent 286µs making 1 call to IO::Scalar::BEGIN@151 # spent 239µs making 1 call to vars::import
1522187µs2293µs
# spent 182µs (72+110) within IO::Scalar::BEGIN@152 which was called: # once (72µs+110µs) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 152
use IO::Handle;
# spent 182µs making 1 call to IO::Scalar::BEGIN@152 # spent 110µs making 1 call to Exporter::import
153
1542448µs173µs
# spent 73µs within IO::Scalar::BEGIN@154 which was called: # once (73µs+0s) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 154
use 5.005;
# spent 73µs making 1 call to IO::Scalar::BEGIN@154
155
156### Stringification, courtesy of B. K. Oxley (binkley): :-)
1572251µs2410µs
# spent 236µs (63+173) within IO::Scalar::BEGIN@157 which was called: # once (63µs+173µs) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 157
use overload '""' => sub { ${*{$_[0]}->{SR}} };
# spent 236µs making 1 call to IO::Scalar::BEGIN@157 # spent 173µs making 1 call to overload::import
15828.76ms2306µs
# spent 180µs (55+125) within IO::Scalar::BEGIN@158 which was called: # once (55µs+125µs) by RTP::Webmerge::Process::CSS::Inlinedata::BEGIN@26 at line 158
use overload 'bool' => sub { 1 }; ### have to do this, so object is true!
# spent 180µs making 1 call to IO::Scalar::BEGIN@158 # spent 125µs making 1 call to overload::import
159
160### The package version, both in 1.23 style *and* usable by MakeMaker:
16114µs$VERSION = "2.110";
162
163### Inheritance:
164136µs@ISA = qw(IO::Handle);
165
166### This stuff should be got rid of ASAP.
1671551µsrequire IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004);
168
169#==============================
170
171=head2 Construction
172
173=over 4
174
175=cut
176
177#------------------------------
178
179=item new [ARGS...]
180
181I<Class method.>
182Return a new, unattached scalar handle.
183If any arguments are given, they're sent to open().
184
185=cut
186
187sub new {
188 my $proto = shift;
189 my $class = ref($proto) || $proto;
190 my $self = bless \do { local *FH }, $class;
191 tie *$self, $class, $self;
192 $self->open(@_); ### open on anonymous by default
193 $self;
194}
195sub DESTROY {
196 shift->close;
197}
198
199#------------------------------
200
201=item open [SCALARREF]
202
203I<Instance method.>
204Open the scalar handle on a new scalar, pointed to by SCALARREF.
205If no SCALARREF is given, a "private" scalar is created to hold
206the file data.
207
208Returns the self object on success, undefined on error.
209
210=cut
211
212sub open {
213 my ($self, $sref) = @_;
214
215 ### Sanity:
216 defined($sref) or do {my $s = ''; $sref = \$s};
217 (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar";
218
219 ### Setup:
220 *$self->{Pos} = 0; ### seek position
221 *$self->{SR} = $sref; ### scalar reference
222 $self;
223}
224
225#------------------------------
226
227=item opened
228
229I<Instance method.>
230Is the scalar handle opened on something?
231
232=cut
233
234sub opened {
235 *{shift()}->{SR};
236}
237
238#------------------------------
239
240=item close
241
242I<Instance method.>
243Disassociate the scalar handle from its underlying scalar.
244Done automatically on destroy.
245
246=cut
247
248sub close {
249 my $self = shift;
250 %{*$self} = ();
251 1;
252}
253
254=back
255
256=cut
257
- -
260#==============================
261
262=head2 Input and output
263
264=over 4
265
266=cut
267
268
269#------------------------------
270
271=item flush
272
273I<Instance method.>
274No-op, provided for OO compatibility.
275
276=cut
277
278sub flush { "0 but true" }
279
280#------------------------------
281
282=item getc
283
284I<Instance method.>
285Return the next character, or undef if none remain.
286
287=cut
288
289sub getc {
290 my $self = shift;
291
292 ### Return undef right away if at EOF; else, move pos forward:
293 return undef if $self->eof;
294 substr(${*$self->{SR}}, *$self->{Pos}++, 1);
295}
296
297#------------------------------
298
299=item getline
300
301I<Instance method.>
302Return the next line, or undef on end of string.
303Can safely be called in an array context.
304Currently, lines are delimited by "\n".
305
306=cut
307
308sub getline {
309 my $self = shift;
310
311 ### Return undef right away if at EOF:
312 return undef if $self->eof;
313
314 ### Get next line:
315 my $sr = *$self->{SR};
316 my $i = *$self->{Pos}; ### Start matching at this point.
317
318 ### Minimal impact implementation!
319 ### We do the fast fast thing (no regexps) if using the
320 ### classic input record separator.
321
322 ### Case 1: $/ is undef: slurp all...
323 if (!defined($/)) {
324 *$self->{Pos} = length $$sr;
325 return substr($$sr, $i);
326 }
327
328 ### Case 2: $/ is "\n": zoom zoom zoom...
329 elsif ($/ eq "\012") {
330
331 ### Seek ahead for "\n"... yes, this really is faster than regexps.
332 my $len = length($$sr);
333 for (; $i < $len; ++$i) {
334 last if ord (substr ($$sr, $i, 1)) == 10;
335 }
336
337 ### Extract the line:
338 my $line;
339 if ($i < $len) { ### We found a "\n":
340 $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1);
341 *$self->{Pos} = $i+1; ### Remember where we finished up.
342 }
343 else { ### No "\n"; slurp the remainder:
344 $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos});
345 *$self->{Pos} = $len;
346 }
347 return $line;
348 }
349
350 ### Case 3: $/ is ref to int. Do fixed-size records.
351 ### (Thanks to Dominique Quatravaux.)
352 elsif (ref($/)) {
353 my $len = length($$sr);
354 my $i = ${$/} + 0;
355 my $line = substr ($$sr, *$self->{Pos}, $i);
356 *$self->{Pos} += $i;
357 *$self->{Pos} = $len if (*$self->{Pos} > $len);
358 return $line;
359 }
360
361 ### Case 4: $/ is either "" (paragraphs) or something weird...
362 ### This is Graham's general-purpose stuff, which might be
363 ### a tad slower than Case 2 for typical data, because
364 ### of the regexps.
365 else {
366 pos($$sr) = $i;
367
368 ### If in paragraph mode, skip leading lines (and update i!):
369 length($/) or
370 (($$sr =~ m/\G\n*/g) and ($i = pos($$sr)));
371
372 ### If we see the separator in the buffer ahead...
373 if (length($/)
374 ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp!
375 : $$sr =~ m,\n\n,g ### (a paragraph)
376 ) {
377 *$self->{Pos} = pos $$sr;
378 return substr($$sr, $i, *$self->{Pos}-$i);
379 }
380 ### Else if no separator remains, just slurp the rest:
381 else {
382 *$self->{Pos} = length $$sr;
383 return substr($$sr, $i);
384 }
385 }
386}
387
388#------------------------------
389
390=item getlines
391
392I<Instance method.>
393Get all remaining lines.
394It will croak() if accidentally called in a scalar context.
395
396=cut
397
398sub getlines {
399 my $self = shift;
400 wantarray or croak("can't call getlines in scalar context!");
401 my ($line, @lines);
402 push @lines, $line while (defined($line = $self->getline));
403 @lines;
404}
405
406#------------------------------
407
408=item print ARGS...
409
410I<Instance method.>
411Print ARGS to the underlying scalar.
412
413B<Warning:> this continues to always cause a seek to the end
414of the string, but if you perform seek()s and tell()s, it is
415still safer to explicitly seek-to-end before subsequent print()s.
416
417=cut
418
419sub print {
420 my $self = shift;
421 *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : ""));
422 1;
423}
424sub _unsafe_print {
425 my $self = shift;
426 my $append = join('', @_) . $\;
427 ${*$self->{SR}} .= $append;
428 *$self->{Pos} += length($append);
429 1;
430}
431sub _old_print {
432 my $self = shift;
433 ${*$self->{SR}} .= join('', @_) . $\;
434 *$self->{Pos} = length(${*$self->{SR}});
435 1;
436}
437
438
439#------------------------------
440
441=item read BUF, NBYTES, [OFFSET]
442
443I<Instance method.>
444Read some bytes from the scalar.
445Returns the number of bytes actually read, 0 on end-of-file, undef on error.
446
447=cut
448
449sub read {
450 my $self = $_[0];
451 my $n = $_[2];
452 my $off = $_[3] || 0;
453
454 my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n);
455 $n = length($read);
456 *$self->{Pos} += $n;
457 ($off ? substr($_[1], $off) : $_[1]) = $read;
458 return $n;
459}
460
461#------------------------------
462
463=item write BUF, NBYTES, [OFFSET]
464
465I<Instance method.>
466Write some bytes to the scalar.
467
468=cut
469
470sub write {
471 my $self = $_[0];
472 my $n = $_[2];
473 my $off = $_[3] || 0;
474
475 my $data = substr($_[1], $off, $n);
476 $n = length($data);
477 $self->print($data);
478 return $n;
479}
480
481#------------------------------
482
483=item sysread BUF, LEN, [OFFSET]
484
485I<Instance method.>
486Read some bytes from the scalar.
487Returns the number of bytes actually read, 0 on end-of-file, undef on error.
488
489=cut
490
491sub sysread {
492 my $self = shift;
493 $self->read(@_);
494}
495
496#------------------------------
497
498=item syswrite BUF, NBYTES, [OFFSET]
499
500I<Instance method.>
501Write some bytes to the scalar.
502
503=cut
504
505sub syswrite {
506 my $self = shift;
507 $self->write(@_);
508}
509
510=back
511
512=cut
513
514
515#==============================
516
517=head2 Seeking/telling and other attributes
518
519=over 4
520
521=cut
522
523
524#------------------------------
525
526=item autoflush
527
528I<Instance method.>
529No-op, provided for OO compatibility.
530
531=cut
532
533sub autoflush {}
534
535#------------------------------
536
537=item binmode
538
539I<Instance method.>
540No-op, provided for OO compatibility.
541
542=cut
543
544sub binmode {}
545
546#------------------------------
547
548=item clearerr
549
550I<Instance method.> Clear the error and EOF flags. A no-op.
551
552=cut
553
554sub clearerr { 1 }
555
556#------------------------------
557
558=item eof
559
560I<Instance method.> Are we at end of file?
561
562=cut
563
564sub eof {
565 my $self = shift;
566 (*$self->{Pos} >= length(${*$self->{SR}}));
567}
568
569#------------------------------
570
571=item seek OFFSET, WHENCE
572
573I<Instance method.> Seek to a given position in the stream.
574
575=cut
576
577sub seek {
578 my ($self, $pos, $whence) = @_;
579 my $eofpos = length(${*$self->{SR}});
580
581 ### Seek:
582 if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET
583 elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR
584 elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END
585 else { croak "bad seek whence ($whence)" }
586
587 ### Fixup:
588 if (*$self->{Pos} < 0) { *$self->{Pos} = 0 }
589 if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos }
590 return 1;
591}
592
593#------------------------------
594
595=item sysseek OFFSET, WHENCE
596
597I<Instance method.> Identical to C<seek OFFSET, WHENCE>, I<q.v.>
598
599=cut
600
601sub sysseek {
602 my $self = shift;
603 $self->seek (@_);
604}
605
606#------------------------------
607
608=item tell
609
610I<Instance method.>
611Return the current position in the stream, as a numeric offset.
612
613=cut
614
615sub tell { *{shift()}->{Pos} }
616
617#------------------------------
618#
619# use_RS [YESNO]
620#
621# I<Instance method.>
622# Obey the curent setting of $/, like IO::Handle does?
623# Default is false in 1.x, but cold-welded true in 2.x and later.
624#
625sub use_RS {
626 my ($self, $yesno) = @_;
627 carp "use_RS is deprecated and ignored; \$/ is always consulted\n";
628 }
629
630#------------------------------
631
632=item setpos POS
633
634I<Instance method.>
635Set the current position, using the opaque value returned by C<getpos()>.
636
637=cut
638
639sub setpos { shift->seek($_[0],0) }
640
641#------------------------------
642
643=item getpos
644
645I<Instance method.>
646Return the current position in the string, as an opaque object.
647
648=cut
649
65019µs*getpos = \&tell;
651
652
653#------------------------------
654
655=item sref
656
657I<Instance method.>
658Return a reference to the underlying scalar.
659
660=cut
661
662sub sref { *{shift()}->{SR} }
663
664
665#------------------------------
666# Tied handle methods...
667#------------------------------
668
669# Conventional tiehandle interface:
670sub TIEHANDLE {
671 ((defined($_[1]) && UNIVERSAL::isa($_[1], "IO::Scalar"))
672 ? $_[1]
673 : shift->new(@_));
674}
675sub GETC { shift->getc(@_) }
676sub PRINT { shift->print(@_) }
677sub PRINTF { shift->print(sprintf(shift, @_)) }
678sub READ { shift->read(@_) }
679sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) }
680sub WRITE { shift->write(@_); }
681sub CLOSE { shift->close(@_); }
682sub SEEK { shift->seek(@_); }
683sub TELL { shift->tell(@_); }
684sub EOF { shift->eof(@_); }
685
686#------------------------------------------------------------
687
688124µs1;
689
690__END__
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.