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   4732 use strict;
  5         15  
  5         173  
9 5     5   37 use warnings;
  5         11  
  5         184  
10 5     5   744 use CGI qw(param);
  5         41013  
  5         44  
11 5     5   1072 use base qw(Class::Accessor);
  5         14  
  5         2314  
12 5     5   8650 use Readonly;
  5         5339  
  5         377  
13 5     5   42 use Carp;
  5         39  
  5         8257  
14              
15             our $VERSION = q[477.1.2];
16              
17             our $DEFAULTS = {
18             meta_content_type => 'text/html',
19             meta_version => '0.2',
20             meta_description => q[],
21             meta_author => q[],
22             meta_keywords => q[],
23             username => q[],
24             charset => q[iso8859-1],
25             lang => [qw(en)],
26             };
27              
28             Readonly::Scalar our $PROCESS_COMMA_YES => 1;
29             Readonly::Scalar our $PROCESS_COMMA_NO => 2;
30             our $ARRAY_FIELDS = {
31             'jsfile' => $PROCESS_COMMA_YES,
32             'rss' => $PROCESS_COMMA_YES,
33             'atom' => $PROCESS_COMMA_YES,
34             'stylesheet' => $PROCESS_COMMA_YES,
35             'script' => $PROCESS_COMMA_NO,
36             'lang' => $PROCESS_COMMA_YES,
37             };
38             __PACKAGE__->mk_accessors(__PACKAGE__->fields());
39              
40             sub fields {
41 20     20 1 253 return qw(title stylesheet style jsfile script atom rss
42             meta_keywords meta_description meta_author meta_version
43             meta_refresh meta_cookie meta_content_type meta_expires
44             onload onunload onresize username charset headers
45             lang);
46             }
47              
48             sub get {
49 546     546 1 16599 my ($self, $field) = @_;
50              
51 546 100       1492 if($ARRAY_FIELDS->{$field}) {
52 166   100     1032 my $val = $self->{$field} || $DEFAULTS->{$field} || [];
53 166 100       492 if(!ref $val) {
54 4         29 $val = [$val];
55             }
56              
57 166 100       14074 if($ARRAY_FIELDS->{$field} == $PROCESS_COMMA_YES) {
58 142         361 return [map { split /,/smx } @{$val}];
  50         496  
  142         688  
59              
60             } else {
61 24         129 return $val;
62             }
63              
64              
65             } else {
66 380   100     2582 return $self->{$field} || $DEFAULTS->{$field};
67             }
68             }
69              
70             sub defaults {
71 25     25 1 90 my ($self, $key) = @_;
72 25         198 return $DEFAULTS->{$key};
73             }
74              
75             sub new {
76 32     32 1 12892 my ($class, $ref) = @_;
77 32 100       133 if(!$ref) {
78 14         40 $ref = {};
79             }
80 32         91 bless $ref, $class;
81 32         135 return $ref;
82             }
83              
84             sub header {
85 8     8 1 36 my ($self) = @_;
86              
87 8         46 return $self->site_header();
88             }
89              
90             sub cookie {
91 15     15 1 65 my ($self, @cookies) = @_;
92              
93 15 50       72 if(scalar @cookies) {
94 0         0 $self->{cookie} = \@cookies;
95             }
96              
97 15 50       40 return @{$self->{cookie}||[]};
  15         156  
98             }
99              
100             sub site_header {
101 8     8 1 25 my ($self) = @_;
102 8         82 my $cgi = $self->cgi();
103              
104 8         32 my $ss = <<"EOT";
105             @{[map {
106 0         0 qq( );
107 8         28 } grep { $_ } @{$self->stylesheet()}]}
  0         0  
  8         50  
108             EOT
109              
110 8 50       50 if($self->style()) {
111 0         0 $ss .= q();
112             }
113              
114 8         26 my $rss = <<"EOT";
115             @{[map {
116 0         0 qq( \n);
117 8         27 } grep { $_ } @{$self->rss()}]}
  0         0  
  8         43  
118             EOT
119              
120 8         27 my $atom = <<"EOT";
121             @{[map {
122 0         0 qq( \n);
123 8         23 } grep { $_ } @{$self->atom()}]}
  0         0  
  8         38  
124             EOT
125              
126 8         38 my $js = <<"EOT";
127             @{[map {
128 1         4 qq( \n);
  1         8  
129 8         23 } grep { $_ } @{$self->jsfile()}]}
  1         4  
  8         42  
130             EOT
131              
132 8         9131 my $script = <<"EOT";
133             @{[map {
134 0         0 qq( \n);
135 8         25 } grep { $_ } @{$self->script()}]}
  0         0  
  8         41  
136             EOT
137              
138 8 50       51 my $onload = (scalar $self->onload()) ? qq( onload="@{[ join q(;), $self->onload()]}") : q[];
  0         0  
139 8 50       44 my $onunload = (scalar $self->onunload()) ? qq( onunload="@{[join q(;), $self->onunload()]}") : q[];
  0         0  
140 8 50       42 my $onresize = (scalar $self->onresize()) ? qq( onresize="@{[join q(;), $self->onresize()]}") : q[];
  0         0  
141 8         40 return <<"EOT";
142            
143            
144 8         40
  8         42  
  8         29  
  8         46  
145            
146 8   33     52
147 8 50 33     48 @{[(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       43  
  0         0  
  8         43  
  0         0  
  8         46  
148 8   33     58
149 8   33     51
150 8   33     47
151 8   100     50 @{[$self->title || 'ClearPress Application']}
152             $ss$rss$atom$js$script
153            
154             EOT
155             }
156              
157             sub footer {
158 7     7 1 43 return <<'EOT';
159            
160            
161             EOT
162             }
163              
164             sub cgi {
165 12     12 1 59 my ($self, $cgi) = @_;
166              
167 12 100       78 if($cgi) {
    100          
168 1         5 $self->{cgi} = $cgi;
169              
170             } elsif(!$self->{cgi}) {
171 9         82 $self->{cgi} = CGI->new();
172             }
173              
174 12         3809 return $self->{cgi};
175             }
176              
177             sub session {
178 15     15 1 148 return {};
179             }
180              
181             sub save_session {
182 16     16 1 49 return;
183             }
184              
185             1;
186             __END__