File Coverage

blib/lib/IO/File/Cycle.pm
Criterion Covered Total %
statement 31 33 93.9
branch 3 4 75.0
condition n/a
subroutine 8 9 88.8
pod 5 5 100.0
total 47 51 92.1


line stmt bran cond sub pod time code
1             package IO::File::Cycle;
2              
3 2     2   50823 use 5.006;
  2         10  
  2         87  
4 2     2   14 use strict;
  2         5  
  2         76  
5 2     2   13 use warnings;
  2         11  
  2         87  
6 2     2   14 use base 'IO::File';
  2         5  
  2         2392  
7              
8             =head1 NAME
9              
10             IO::File::Cycle - Easily split output file while writing
11              
12             =head1 VERSION
13              
14             Version 0.03
15              
16             =cut
17              
18             our $VERSION = '0.03';
19              
20             =head1 SYNOPSIS
21              
22             This module makes it easy to split a file while writing to it. This, for example, will create a number of files in /tmp called "foo.1.txt", "foo.2.txt", &c., all at most 10,000 bytes in size:
23              
24             use IO::File::Cycle;
25              
26             my $file = IO::File::Cycle->new('>/tmp/foo.txt');
27             for ( 1..100_000 ) {
28             $file->cycle if tell($file) + length($_) + 1 > 10_000;
29             print $file $_, "\n";
30             }
31             $file->close;
32              
33             =head1 SUBROUTINES/METHODS
34              
35             =head2 start_at()
36              
37             Defines the starting number, which can be easily overridden in a subclass.
38              
39             =cut
40              
41 5     5 1 24 sub start_at { 1 }
42              
43             =head2 open()
44              
45             Sets up some internal variables, then calls IO::File::open().
46              
47             =cut
48              
49             sub open {
50 1     1 1 54 my $io = shift;
51 1         2 my $filename = shift;
52 1         1 my @mode_and_perms = @_;
53 1 50       9 if ( $filename =~ s/^(\+?(<|>|>>))// ) {
54 1         2 $mode_and_perms[0] = $1;
55             }
56 1         6 (my $base = $filename) =~ s/\.([^.]+)$//;
57 1         5 *{$io} = \ {
  1         10  
58             count => $io->start_at,
59             current => $filename,
60             base => $base,
61             extension => $1,
62             mode_and_perms => \@mode_and_perms,
63             };
64 1         8 $io->SUPER::open($filename, @mode_and_perms);
65             }
66              
67             =head2 format_filename()
68              
69             Formats the filename.
70              
71             =cut
72              
73             sub format_filename {
74 5     5 1 6 my $io = shift;
75 5         130 return join '.', grep $_, $$$io->{base}, shift, $$$io->{extension};
76             }
77              
78             =head2 cycle()
79              
80             Closes the current file, then opens a new file with an incremented number in the filename (before the extension if there is one, and after a "."). After closing the initial file, it renames it to have the index "1" – for example, "filename.1.ext".
81              
82             =cut
83              
84             sub cycle {
85 4     4 1 13269 my $io = shift;
86 4         23 $io->close;
87 4 100       163 if ( $$$io->{count} == (my $start_at = $io->start_at) ) {
88 1         6 rename $$$io->{current}, $io->format_filename( $start_at );
89             }
90 4         13 $$$io->{current} = $io->format_filename( ++$$$io->{count} );
91 4         8 $io->SUPER::open($$$io->{current}, @{$$$io->{mode_and_perms}});
  4         17  
92             }
93              
94             =head2 filename()
95              
96             Returns the current file's name. This can be called from a close() method in a subclass to post-process each file.
97              
98             =cut
99              
100             sub filename {
101 0     0 1   my $io = shift;
102 0           return $$$io->{current};
103             }
104              
105             =head2 close()
106              
107             This is a sample close() method, which in a subclass could post-process each file.
108              
109             sub close {
110             my $io = shift;
111             my $filename = $io->filename;
112             $io->SUPER::close;
113             system "gzip -f $filename";
114             }
115              
116             =cut
117              
118             =head1 AUTHOR
119              
120             Nic Wolff, C<< >>
121              
122             =head1 BUGS
123              
124             Please report any bugs or feature requests to C, or through
125             the web interface at L. I will be notified, and then you'll
126             automatically be notified of progress on your bug as I make changes.
127              
128              
129              
130              
131             =head1 SUPPORT
132              
133             You can find documentation for this module with the perldoc command.
134              
135             perldoc IO::File::Cycle
136              
137              
138             You can also look for information at:
139              
140             =over 4
141              
142             =item * RT: CPAN's request tracker (report bugs here)
143              
144             L
145              
146             =item * AnnoCPAN: Annotated CPAN documentation
147              
148             L
149              
150             =item * CPAN Ratings
151              
152             L
153              
154             =item * Search CPAN
155              
156             L
157              
158             =back
159              
160              
161             =head1 ACKNOWLEDGEMENTS
162              
163              
164             =head1 LICENSE AND COPYRIGHT
165              
166             Copyright 2012 Nic Wolff.
167              
168             This program is free software; you can redistribute it and/or modify it
169             under the terms of either: the GNU General Public License as published
170             by the Free Software Foundation; or the Artistic License.
171              
172             See http://dev.perl.org/licenses/ for more information.
173              
174              
175             =cut
176              
177             1; # End of IO::File::Cycle