File Coverage

blib/lib/ClearPress/decorator.pm
Criterion Covered Total %
statement 89 105 84.7
branch 21 30 70.0
condition 12 22 54.5
subroutine 17 17 100.0
pod 11 11 100.0
total 150 185 81.0


line stmt bran cond sub pod time code
1             # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
2             # vim:ts=8:sw=2:et:sta:sts=2
3             #########
4             # Author: rmp
5             # Created: 2007-06-07
6             #
7             package ClearPress::decorator;
8 5     5   1003 use strict;
  5         12  
  5         150  
9 5     5   29 use warnings;
  5         13  
  5         157  
10 5     5   727 use CGI qw(param);
  5         42483  
  5         44  
11 5     5   714 use base qw(Class::Accessor);
  5         23  
  5         877  
12 5     5   3058 use Readonly;
  5         5039  
  5         208  
13 5     5   30 use Carp;
  5         10  
  5         6138  
14              
15             our $VERSION = q[476.4.2];
16             our $DEFAULTS = {
17             meta_content_type => 'text/html',
18             meta_version => '0.2',
19             meta_description => q[],
20             meta_author => q[],
21             meta_keywords => q[],
22             username => q[],
23             charset => q[iso8859-1],
24             lang => [qw(en)],
25             };
26              
27             Readonly::Scalar our $PROCESS_COMMA_YES => 1;
28             Readonly::Scalar our $PROCESS_COMMA_NO => 2;
29             our $ARRAY_FIELDS = {
30             'jsfile' => $PROCESS_COMMA_YES,
31             'rss' => $PROCESS_COMMA_YES,
32             'atom' => $PROCESS_COMMA_YES,
33             'stylesheet' => $PROCESS_COMMA_YES,
34             'script' => $PROCESS_COMMA_NO,
35             'lang' => $PROCESS_COMMA_YES,
36             };
37             __PACKAGE__->mk_accessors(__PACKAGE__->fields());
38              
39             sub fields {
40 20     20 1 216 return qw(title stylesheet style jsfile script atom rss
41             meta_keywords meta_description meta_author meta_version
42             meta_refresh meta_cookie meta_content_type meta_expires
43             onload onunload onresize username charset headers
44             lang);
45             }
46              
47             sub get {
48 546     546 1 13651 my ($self, $field) = @_;
49              
50 546 100       1389 if($ARRAY_FIELDS->{$field}) {
51 166   100     986 my $val = $self->{$field} || $DEFAULTS->{$field} || [];
52 166 100       477 if(!ref $val) {
53 4         14 $val = [$val];
54             }
55              
56 166 100       454 if($ARRAY_FIELDS->{$field} == $PROCESS_COMMA_YES) {
57 142         255 return [map { split /,/smx } @{$val}];
  50         445  
  142         553  
58              
59             } else {
60 24         123 return $val;
61             }
62              
63              
64             } else {
65 380   100     2223 return $self->{$field} || $DEFAULTS->{$field};
66             }
67             }
68              
69             sub defaults {
70 25     25 1 74 my ($self, $key) = @_;
71 25         165 return $DEFAULTS->{$key};
72             }
73              
74             sub new {
75 32     32 1 13081 my ($class, $ref) = @_;
76 32 100       128 if(!$ref) {
77 14         40 $ref = {};
78             }
79 32         99 bless $ref, $class;
80 32         122 return $ref;
81             }
82              
83             sub header {
84 8     8 1 32 my ($self) = @_;
85              
86 8         41 return $self->site_header();
87             }
88              
89             sub cookie {
90 15     15 1 63 my ($self, @cookies) = @_;
91              
92 15 50       72 if(scalar @cookies) {
93 0         0 $self->{cookie} = \@cookies;
94             }
95              
96 15 50       41 return @{$self->{cookie}||[]};
  15         145  
97             }
98              
99             sub site_header {
100 8     8 1 24 my ($self) = @_;
101 8         63 my $cgi = $self->cgi();
102              
103 8         27 my $ss = <<"EOT";
104             @{[map {
105 0         0 qq( );
106 8         21 } grep { $_ } @{$self->stylesheet()}]}
  0         0  
  8         43  
107             EOT
108              
109 8 50       45 if($self->style()) {
110 0         0 $ss .= q();
111             }
112              
113 8         25 my $rss = <<"EOT";
114             @{[map {
115 0         0 qq( \n);
116 8         24 } grep { $_ } @{$self->rss()}]}
  0         0  
  8         39  
117             EOT
118              
119 8         26 my $atom = <<"EOT";
120             @{[map {
121 0         0 qq( \n);
122 8         22 } grep { $_ } @{$self->atom()}]}
  0         0  
  8         45  
123             EOT
124              
125 8         23 my $js = <<"EOT";
126             @{[map {
127 1         3 qq( \n);
  1         7  
128 8         20 } grep { $_ } @{$self->jsfile()}]}
  1         5  
  8         37  
129             EOT
130              
131 8         8784 my $script = <<"EOT";
132             @{[map {
133 0         0 qq( \n);
134 8         20 } grep { $_ } @{$self->script()}]}
  0         0  
  8         38  
135             EOT
136              
137 8 50       63 my $onload = (scalar $self->onload()) ? qq( onload="@{[ join q(;), $self->onload()]}") : q[];
  0         0  
138 8 50       39 my $onunload = (scalar $self->onunload()) ? qq( onunload="@{[join q(;), $self->onunload()]}") : q[];
  0         0  
139 8 50       57 my $onresize = (scalar $self->onresize()) ? qq( onresize="@{[join q(;), $self->onresize()]}") : q[];
  0         0  
140 8         25 return <<"EOT";
141            
142            
143 8         22
  8         37  
  8         26  
  8         34  
144            
145 8   33     40
146 8 50 33     40 @{[(scalar $self->meta_cookie())?(map { qq( \n) } $self->meta_cookie()):q[]]}@{[$self->meta_refresh()?qq():q[]]}@{[$self->meta_expires()?qq():q[]]}
  0 50       0  
  8 50       39  
  0         0  
  8         37  
  0         0  
  8         38  
147 8   33     36
148 8   33     41
149 8   33     41
150 8   100     39 @{[$self->title || 'ClearPress Application']}
151             $ss$rss$atom$js$script
152            
153             EOT
154             }
155              
156             sub footer {
157 7     7 1 36 return <<'EOT';
158            
159            
160             EOT
161             }
162              
163             sub cgi {
164 12     12 1 55 my ($self, $cgi) = @_;
165              
166 12 100       65 if($cgi) {
    100          
167 1         4 $self->{cgi} = $cgi;
168              
169             } elsif(!$self->{cgi}) {
170 9         75 $self->{cgi} = CGI->new();
171             }
172              
173 12         3230 return $self->{cgi};
174             }
175              
176             sub session {
177 15     15 1 135 return {};
178             }
179              
180             sub save_session {
181 16     16 1 44 return;
182             }
183              
184             1;
185             __END__