File Coverage

blib/lib/Fsdb/Support/DelayPassComments.pm
Criterion Covered Total %
statement 3 44 6.8
branch 0 14 0.0
condition n/a
subroutine 1 5 20.0
pod 4 4 100.0
total 8 67 11.9


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # Fsdb::Support::DelayPassComments.pm
5             # Copyright (C) 2007 by John Heidemann
6             # $Id: e2fb010c7ca0b5463de954715d29202803f1f8a7 $
7             #
8             # This program is distributed under terms of the GNU general
9             # public license, version 2. See the file COPYING
10             # in $dblibdir for details.
11             #
12              
13              
14             package Fsdb::Support::DelayPassComments;
15              
16             =head1 NAME
17              
18             Fsdb::Support::DelayPassComments - support for buffering comments
19              
20             =head1 SYNOPSIS
21              
22             Buffer and send out comments
23              
24             =head1 FUNCTIONS
25              
26             =head2 new
27              
28             $filter->{_delay_pass_comments} = new Fsdb::Support::DelayPassComments;
29              
30             or more likely, one uses it indirectly with Fsdb::Filter and Fsdb::IO::Reader:
31              
32             $self->{_in} = finish_io_options('input', -comment_handler => create_delay_pass_comments_sub);
33             $self->{_out} = new Fsdb::IO::Writer(...);
34             ...
35             # in Fsdb::Filter
36             $self->{_delay_comments}->flush($self->{_out};
37              
38             Creates a buffer for comments that will run with bounded memory usage.
39             New requires the output stream, a Fsdb::IO::Writer object.
40             Fsdb::Filter will dump these after all other output.
41              
42             =cut
43              
44             @ISA = ();
45             ($VERSION) = 1.0;
46              
47 2     2   19 use Carp;
  2         7  
  2         1445  
48              
49             sub new {
50 0     0 1   my $class = shift @_;
51 0           my $fsdb_out = shift @_;
52 0           my($queue_ref) = [ 0 ]; # first element is byte count of buffered data,
53             # or an IO::Handle of the on-disk buffer.
54 0           my $self = bless $queue_ref, $class;
55 0           return $self;
56             }
57              
58             =head2 enqueue
59              
60             $dpc->enqueue($comment [, $other_comments...])
61              
62             Save up the $COMMENT.
63              
64             =cut
65              
66             sub enqueue {
67 0     0 1   my $self = shift @_;
68 0           foreach (@_) {
69 0 0         if (ref($self->[0])) {
70             # going to disk
71 0           $self->[0]->print($_);
72 0           next;
73             };
74 0           push(@$self, $_);
75 0           $self->[0] += length($_);
76 0 0         $self->spill_to_disk if ($self->[0] > 10000);
77             };
78             }
79              
80             =head2 spill_to_disk
81              
82             $dpc->spill_to_disk
83              
84             Internal: switch from in-memory caching to disk caching.
85              
86             =cut
87              
88             sub spill_to_disk {
89 0     0 1   my $self = shift @_;
90 0           my $fh = IO::File::new_tmpfile;
91 0 0         croak "delayed_pass_comments: cannot create tmpfile"
92             if (!defined($fh));
93 0           shift @$self; # eat the byte count
94             # write everything so far to disk
95 0           foreach (@{$self}) {
  0            
96 0           print $fh $_;
97             };
98             # switch over
99 0           $self->[0] = $fh;
100 0           $#{$self} = 0; # who knew $#a was writable? Apparently the perlfunc man page...
  0            
101             }
102              
103             =head2 flush
104              
105             $dpc->flush($output_fsdb);
106              
107             Dump all saved comments to the saved Fsdb::IO::Writer,
108             or if C<$OUTPUT_FSDB> is undef, then to stdout.
109              
110             =cut
111              
112             sub flush {
113 0     0 1   my $self = shift @_;
114 0           my $fsdb = shift @_;
115              
116 0 0         return if ($#{$self} == 0); # nothing queued
  0            
117 0 0         if (!ref($self->[0])) {
118             # in memory
119 0           shift @$self;
120 0           foreach (@$self) {
121 0 0         if (defined($fsdb)) {
122 0           $fsdb->write_raw($_);
123             } else {
124 0           print $_;
125             };
126             };
127             } else {
128             # on disk
129 0           my $fh = shift @$self;
130 0           $fh->seek(0, 0); # rewind to start
131 0           my($line);
132 0           while (defined($line = $fh->getline)) {
133 0 0         if (defined($fsdb)) {
134 0           $fsdb->write_raw($line);
135             } else {
136 0           print $line;
137             };
138             };
139 0           $fh->close;
140             };
141             }
142              
143             1;