File Coverage

blib/lib/CGI/SpeedUp.pm
Criterion Covered Total %
statement 30 31 96.7
branch 3 6 50.0
condition 3 7 42.8
subroutine 7 8 87.5
pod 0 2 0.0
total 43 54 79.6


line stmt bran cond sub pod time code
1             package CGI::SpeedUp;
2              
3 1     1   495 use strict;
  1         2  
  1         26  
4 1     1   6 use File::Spec;
  1         1  
  1         26  
5 1     1   5 use vars qw( $VERSION $File_base $Control $Done $DEBUG );
  1         3  
  1         225  
6             $VERSION = 0.11;
7              
8             BEGIN
9             {
10 1     1   2 $DEBUG = 0; # <-- DEBUG
11              
12 0     0 0 0 sub import_error { $Done = 1; }
13              
14 1         2192 require 'CGI.pm';
15 1         16708 $CGI::NO_DEBUG = 1; #Do not use STDIN debugging!
16              
17 1         133 ($File_base = File::Spec->catfile(File::Spec->tmpdir(),__PACKAGE__)) =~ s/::/-/g;
18              
19 1         64 open (STDERR, File::Spec->devnull());
20              
21 1   50     283 $/ ||= "\n"; # Bug in perl 5.005_02 !!!
22             }
23              
24              
25             END
26             {
27 1 50   1   211 return if $Done; # This avoids a perl core dump under 5.005_02
28 1         4 my ($out_ref) = &header_control;
29 1 50       42 print $$out_ref if defined $$out_ref;
30             }
31              
32              
33             sub import
34             {
35 1     1   7 my( $self, @list ) = @_;
36              
37 1         4 (my $module_name = __PACKAGE__ ) =~ s/::/-/g;
38 1   33     8 foreach( CGI::cookie("${module_name}-header"), (exists $ENV{"${module_name}-header"} and $ENV{"${module_name}-header"})) {
39 1 50 50     7378 $_ and $Control->{'header'}{$_} = 1 and last;
40             }
41              
42 1         23 open(OLDOUT, ">&STDOUT"); # Save real STDOUT
43 1         1736 open(STDOUT, ">${File_base}-out-$$");
44             }
45              
46             sub header_control
47             {
48 1     1 0 3 my $outfile = "";
49              
50             # Retrieve real STDOUT
51 1         39 open( STDOUT, ">&OLDOUT" );
52              
53 1         79 open(my $fh, '<', "${File_base}-out-$$");
54              
55 1         35 $outfile = join '', <$fh>;
56 1         98 unlink "${File_base}-out-$$";
57              
58 1         107 return(\$outfile);
59             }
60              
61             1;
62              
63             =head1 NAME
64              
65             CGI::SpeedUp
66              
67              
68             =head1 SYNOPSIS
69              
70             # ONLY THIS
71             use CGI::SpeedUp;
72            
73             =head1 DESCRIPTION
74              
75             The CGI::SpeedUp module provides a simple way to speed up any CGI application by managing its STDOUT and STDERR. This module was tested in a production environment.
76              
77             =head1 SUBROUTINES/METHODS
78              
79             All is done automagicaly. You shoud only C it :-)
80              
81             =head1 DEPENDENCIES
82              
83             =over 4
84              
85             =item CGI
86              
87             =item File::Spec
88              
89             =back
90              
91              
92             =head1 INCOMPATIBILITIES
93              
94             None known.
95              
96             =head1 BUGS AND LIMITATIONS
97              
98             None known.
99              
100             =head1 AUTHOR
101              
102             Strzelecki Łukasz
103              
104             =head1 LICENCE AND COPYRIGHT
105              
106             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
107              
108             See http://www.perl.com/perl/misc/Artistic.html
109