File Coverage

blib/lib/Labyrinth/Writer/Render/CGI.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package Labyrinth::Writer::Render::CGI;
2              
3 2     2   4543 use warnings;
  2         3  
  2         60  
4 2     2   10 use strict;
  2         3  
  2         53  
5              
6 2     2   8 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  2         3  
  2         151  
7             $VERSION = '5.31';
8              
9             =head1 NAME
10              
11             Labyrinth::Writer::Render::CGI - Output Handler via CGI for Labyrinth.
12              
13             =head1 SYNOPSIS
14              
15             use Labyrinth::Writer::Render::CGI;
16             my $render = Labyrinth::Writer::Render::CGI->new();
17              
18             $render->redirect($url); # HTTP redirect
19              
20             $render->publish($format, $text);
21              
22             =head1 DESCRIPTION
23              
24             Use CGI to output text or redirect.
25              
26             =cut
27              
28             # -------------------------------------
29             # Library Modules
30              
31 2     2   16 use CGI;
  2         3  
  2         14  
32 2     2   88 use IO::File;
  2         3  
  2         313  
33              
34 2     2   9 use Labyrinth::Audit;
  2         3  
  2         230  
35 2     2   69 use Labyrinth::Globals;
  0            
  0            
36             use Labyrinth::Variables;
37              
38             # -------------------------------------
39             # Variables
40              
41             my $cgi = CGI->new();
42              
43             # -------------------------------------
44             # The Subs
45              
46             =head1 METHODS
47              
48             =over 4
49              
50             =item new
51              
52             Object constructor.
53              
54             =item redirect($url)
55              
56             Redirect to given URL.
57              
58             =item binary($vars)
59              
60             Shorthand output of binary data and files.
61              
62             =item publish($format, $text)
63              
64             Publishes text output.
65              
66             =back
67              
68             =cut
69              
70             sub new {
71             my($class) = @_;
72              
73             my $self = bless { cgi => 1 }, $class;
74             $self;
75             }
76              
77             sub redirect {
78             my ($self, $url) = @_;
79             print $cgi->redirect($url);
80             }
81              
82             sub binary {
83             my ($self, $vars) = @_;
84              
85             my $fh = IO::File->new($settings{webdir}.'/'.$vars->{file},'r');
86             if($fh) {
87             print $cgi->header( -type => $vars->{ctype} );
88             my $buffer;
89             while(read($fh,$buffer,1024)) { print $buffer }
90             $fh->close;
91             }
92             }
93              
94             sub publish {
95             my ($self, $headers, $body) = @_;
96              
97             my %cgihash = map { '-' . $_ => $headers->{$_} } grep {$headers->{$_}} qw(type status cookie attachment charset);
98             #LogDebug("CGI Hash=".Dumper(\%cgihash));
99              
100             print $cgi->header( %cgihash ) . $$body;
101             }
102              
103             1;
104              
105             __END__