[Bio] / WebApplication / WebLayout.pm Repository:
ViewVC logotype

Annotation of /WebApplication/WebLayout.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (view) (download) (as text)

1 : paarmann 1.1 package WebLayout;
2 :    
3 :     use strict;
4 :     use warnings;
5 :    
6 : paczian 1.3 use WebConfig;
7 :    
8 : paarmann 1.1 use HTML::Template;
9 :    
10 : olson 1.15 eval {
11 :     require FIG_Config;
12 :     };
13 :    
14 : paarmann 1.1 1;
15 :    
16 : parrello 1.10 =head3 new
17 :    
18 :     my $layout = WebLayout->new($tmpl_data);
19 :    
20 :     Create a layout object. The layout object contains all the information
21 :     needed to assemble a web page from the caller-specified templates.
22 :    
23 :     =over 4
24 :    
25 :     =item tmpl_data
26 :    
27 :     Information about where to get the templates. If omitted, then default templates are used.
28 :     If a string, then the string should be the name of the template file for the page body.
29 :     If a hash reference, then the C<body> member must be the string for the body template and
30 :     the C<frame> member must be the string for the frame template.
31 :    
32 :     =item RETURN
33 :    
34 :     Returns a blessed layout object initialized using the specified template strings.
35 :    
36 :     =back
37 :    
38 :     =cut
39 : paarmann 1.1 sub new {
40 : paczian 1.3 my ($class, $tmpl_path) = @_;
41 : parrello 1.10 my ($body, $frame);
42 : paczian 1.3 my $tmpl = $tmpl_path || TMPL_PATH.'WebLayoutDefault.tmpl';
43 : parrello 1.10 if (ref $tmpl eq 'HASH') {
44 :     my $bodyString = $tmpl->{body};
45 :     my $frameString = $tmpl->{frame};
46 :     $body = HTML::Template->new(scalarref => \$bodyString, die_on_bad_params => 0);
47 :     $frame = HTML::Template->new(scalarref => \$frameString, die_on_bad_params => 0);
48 :     } else {
49 :     $body = HTML::Template->new(filename => $tmpl, die_on_bad_params => 0);
50 :     $frame = HTML::Template->new(filename => TMPL_PATH . 'WebLayoutFrame.tmpl',
51 :     die_on_bad_params => 0);
52 :     }
53 :    
54 : paczian 1.11 my $self = { 'templates' => [],
55 :     'default_template' => $body,
56 : parrello 1.10 'frame' => $frame,
57 : paczian 1.3 'title' => '',
58 :     'javascript' => [],
59 :     'css' => [],
60 : paczian 1.7 'meta' => [],
61 : parrello 1.10 'relocation' => "",
62 : paczian 1.11 'page' => "",
63 : paczian 1.13 'show_icon' => 0,
64 :     'icon_path' => '',
65 : paczian 1.3 };
66 : paarmann 1.1
67 :     bless($self, $class);
68 :    
69 :     return $self;
70 :     }
71 :    
72 : parrello 1.10 =head3 set_relocation
73 :    
74 :     $layout->set_relocation($prefix);
75 :    
76 :     Specify the relocation rule for relative URLs in links added to the
77 :     header. The rule will change the value C<./> at the beginning of a URL to
78 :     the specified prefix.
79 :    
80 :     =over 4
81 :    
82 :     =item prefix
83 :    
84 :     Relative URL prefix used to get back to the normal location.
85 :    
86 :     =back
87 :    
88 :     =cut
89 :    
90 :     sub set_relocation {
91 :     # Get the parameters.
92 :     my ($self, $prefix) = @_;
93 :     # Set the new relocation prefix.
94 :     $self->{relocation} = $prefix;
95 :     }
96 :    
97 :     =head3 relocate
98 :    
99 :     my $relocatedURL = $layout->relocate($url);
100 :    
101 :     Relocate the specified URL using the stored relocation factor. The
102 :     relocation factor indicates the difference between the location of the
103 :     active CGI script and the expected CGI directory.
104 :    
105 :     =over 4
106 :    
107 :     =item url
108 :    
109 :     URL to relocate.
110 :    
111 :     =item RETURN
112 :    
113 :     Returns a relocated URL. If the URL is absolute, it is unchanged. If it is relative, it
114 :     will be moved according to the instructions in the relocation prefix.
115 :    
116 :     =back
117 :    
118 :     =cut
119 :    
120 :     sub relocate {
121 :     # Get the parameters.
122 :     my ($self, $url) = @_;
123 :     # Declare the return variable.
124 :     my $retVal;
125 :     # Determine the type of URL.
126 :     if ($url =~ m#^(http|/)#) {
127 :     # Here it's absolute, so we don't change it.
128 :     $retVal = $url;
129 :     } else {
130 :     # Here it's relative. We need to relocate it. Strip off a dot-slash. This
131 :     # is essentially a no-op.
132 :     $url =~ s#^\./##;
133 :     # Stash the relocation prefix in front.
134 :     $retVal = $self->{relocation} . $url;
135 :     }
136 :     # Return the result.
137 :     return $retVal;
138 :     }
139 : paczian 1.3
140 : paarmann 1.1 sub set_content {
141 : paczian 1.3 $_[0]->frame->param( TITLE => $_[1]->{'title'} );
142 :    
143 :     my @warn = map { { MSG => $_ } } @{$_[1]->{'warnings'}};
144 :     my @info = map { { MSG => $_ } } @{$_[1]->{'info'}};
145 : jared 1.12 $_[0]->template->param( PAGETITLE => $_[1]->{'pagetitle'});
146 :     $_[0]->template->param( CONTENT => $_[1]->{'content'});
147 :     $_[0]->template->param( MENU => $_[1]->{'menu'});
148 :     $_[0]->template->param( USER => $_[1]->{'user'});
149 :     $_[0]->template->param( WARNINGS => \@warn );
150 :     $_[0]->template->param( INFO => \@info );
151 : olson 1.15 $_[0]->template->param( APP_VERSION => $FIG_Config::app_version );
152 : olson 1.14
153 :     while (my($var, $val) = each %FIG_Config::web_template_settings)
154 :     {
155 :     $_[0]->template->param($var => $val);
156 :     }
157 : jared 1.12 }
158 : paczian 1.3
159 :    
160 : parrello 1.5 sub set_variable {
161 :     $_[0]->template->param( $_[1] => $_[2]);
162 :     }
163 :    
164 : paczian 1.11 sub set_page {
165 :     my ($self, $page) = @_;
166 :     $self->{page} = $page;
167 :     }
168 : parrello 1.5
169 : paczian 1.3 sub add_javascript {
170 :     if ($_[1]) {
171 : parrello 1.10 push @{$_[0]->{'javascript'}}, { 'JSFILE' => $_[0]->relocate($_[1]) };
172 : paczian 1.3 }
173 :     }
174 :    
175 :     sub add_css {
176 :     if ($_[1]) {
177 : parrello 1.10 unshift @{$_[0]->{'css'}}, { 'CSSFILE' => $_[0]->relocate($_[1]) };
178 : paczian 1.3 }
179 : paarmann 1.1 }
180 : paczian 1.9 sub add_css_reverse {
181 :     if ($_[1]) {
182 : parrello 1.10 push @{$_[0]->{'css'}}, { 'CSSFILE' => $_[0]->relocate($_[1]) };
183 : paczian 1.9 }
184 :     }
185 : paarmann 1.1
186 : paczian 1.7 sub add_metatag {
187 :     if ($_[1]) {
188 :     push @{$_[0]->{'meta'}}, { 'METATAG' => $_[1] };
189 :     }
190 :     }
191 :    
192 : paarmann 1.1 sub output {
193 : paczian 1.11 my ($self) = @_;
194 :     my $retVal;
195 : paczian 1.3 $self->frame->param( BODY => $self->template->output() );
196 :     $self->frame->param( JAVASCRIPT => $self->{'javascript'} );
197 :     $self->frame->param( CSS => $self->{'css'} );
198 : paczian 1.7 $self->frame->param( META => $self->{'meta'} );
199 : paczian 1.13 $self->frame->param( SHOW_ICON => $self->show_icon );
200 :     $self->frame->param( ICON_PATH => $self->icon_path );
201 :    
202 : paczian 1.11 $retVal = $self->frame->output();
203 : parrello 1.10 return $retVal;
204 : paarmann 1.1 }
205 :    
206 : paczian 1.11 sub add_template {
207 :     my ($self, $tmpl, $pages) = @_;
208 :     my ($body);
209 :     if (ref $tmpl eq 'HASH') {
210 :     my $bodyString = $tmpl->{body};
211 :     $body = HTML::Template->new(scalarref => \$bodyString, die_on_bad_params => 0);
212 :     } else {
213 :     $body = HTML::Template->new(filename => $tmpl, die_on_bad_params => 0);
214 :     }
215 :     push @{$self->{templates}}, [$body, $pages];
216 :     }
217 :    
218 : paarmann 1.2 sub template {
219 : paczian 1.11 my ($self) = @_;
220 :     unless(defined $self->{page}){
221 :     return $self->{'default_template'};
222 :     } else {
223 :     foreach my $t (@{$self->{templates}}){
224 :     foreach (@{$t->[1]}){
225 :     if($self->{page} eq $_){
226 :     return $t->[0];
227 :     }
228 :     }
229 :     }
230 :     }
231 :     return $self->{'default_template'};
232 : paczian 1.3 }
233 : paarmann 1.1
234 : paczian 1.3 sub frame {
235 :     return $_[0]->{'frame'};
236 : paarmann 1.1 }
237 : parrello 1.10
238 : paczian 1.13 sub show_icon {
239 :     my ($self, $show) = @_;
240 :    
241 :     if (defined($show)) {
242 :     $self->{show_icon} = $show;
243 :     }
244 :    
245 :     return $self->{show_icon};
246 :     }
247 : parrello 1.10
248 : paczian 1.13 sub icon_path {
249 :     my ($self, $path) = @_;
250 :    
251 :     if (defined($path)) {
252 :     $self->{icon_path} = $path;
253 :     }
254 :    
255 :     return $self->{icon_path};
256 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3