File Coverage

blib/lib/Gzip/Faster.pm
Criterion Covered Total %
statement 53 54 98.1
branch 16 22 72.7
condition 6 6 100.0
subroutine 8 8 100.0
pod 3 5 60.0
total 86 95 90.5


line stmt bran cond sub pod time code
1             package Gzip::Faster;
2 2     2   143664 use warnings;
  2         16  
  2         68  
3 2     2   13 use strict;
  2         4  
  2         218  
4             require Exporter;
5             our @ISA = qw(Exporter);
6             our @EXPORT = qw/gzip gunzip gzip_file gunzip_file gzip_to_file/;
7             our @EXPORT_OK = qw/deflate inflate deflate_raw inflate_raw/;
8             our %EXPORT_TAGS = ('all' => [@EXPORT, @EXPORT_OK]);
9 2     2   17 use Carp;
  2         4  
  2         1370  
10             our $VERSION = '0.21';
11             require XSLoader;
12             XSLoader::load ('Gzip::Faster', $VERSION);
13              
14             sub get_file
15             {
16 8     8 0 13 my ($file) = @_;
17 8 50       279 open my $in, "<:raw", $file or croak "Error opening '$file': $!";
18 8         39 local $/;
19 8         152 my $zipped = <$in>;
20 8 50       70 close $in or croak "Error closing '$file': $!";
21 8         44 return $zipped;
22             }
23              
24             sub gzip_options
25             {
26 3     3 0 9 my ($plain, %options) = @_;
27 3         31 my $gf = __PACKAGE__->new ();
28 3         8 my $file_name = $options{file_name};
29 3         5 my $mod_time = $options{mod_time};
30 3 50       6 if ($file_name) {
31 3         10 $gf->file_name ($file_name);
32             }
33 3 100       5 if ($mod_time) {
34 1         3 $gf->mod_time ($mod_time);
35             }
36 3         1120 return $gf->zip ($plain);
37             }
38              
39             sub gzip_file
40             {
41 2     2 1 20054 my ($file, %options) = @_;
42 2         6 my $plain = get_file ($file);
43 2 100       7 if (keys %options) {
44 1         3 return gzip_options ($plain, %options);
45             }
46             else {
47 1         16 my $mod_time = (stat ($file))[9];
48 1         4 return gzip_options ($plain, file_name => $file, mod_time => $mod_time);
49             }
50             }
51              
52             sub gunzip_file
53             {
54 6     6 1 5979 my ($file, %options) = @_;
55 6         15 my $zipped = get_file ($file);
56 6         11 my $plain;
57 6 100       16 if (keys %options) {
58 4         33 my $gf = __PACKAGE__->new ();
59 4         467 $plain = $gf->unzip ($zipped);
60 4         11 my $file_name_ref = $options{file_name};
61 4 100 100     18 if (defined ($file_name_ref) && ref $file_name_ref ne 'SCALAR') {
62 1         10 warn "Cannot write file name to non-scalar reference";
63             }
64             else {
65 3         10 $$file_name_ref = $gf->file_name ();
66             }
67 4         9 my $mod_time_ref = $options{mod_time};
68 4 100 100     15 if (defined ($mod_time_ref) && ref $mod_time_ref ne 'SCALAR') {
69 1         9 warn "Cannot write modification time to non-scalar reference";
70             }
71             else {
72 3         38 $$mod_time_ref = $gf->mod_time ();
73             }
74             }
75             else {
76 2         234 $plain = gunzip ($zipped);
77             }
78 6         25 return $plain;
79             }
80              
81             sub gzip_to_file
82             {
83 1     1 1 2809 my ($plain, $file, %options) = @_;
84 1         10 my $zipped;
85 1 50       8 if (keys %options) {
86 1         4 $zipped = gzip_options ($plain, %options);
87             }
88             else {
89 0         0 $zipped = gzip ($plain);
90             }
91 1 50       59 open my $in, ">:raw", $file or croak "Error opening '$file': $!";
92 1         6 print $in $zipped;
93 1 50       35 close $in or croak "Error closing '$file': $!";
94             }
95              
96             1;