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

Annotation of /WebApplication/WebLayout.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (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 : parrello 1.8 use Tracer;
8 : paczian 1.3
9 : paarmann 1.1 use HTML::Template;
10 :    
11 :     1;
12 :    
13 : parrello 1.10 =head3 new
14 :    
15 :     my $layout = WebLayout->new($tmpl_data);
16 :    
17 :     Create a layout object. The layout object contains all the information
18 :     needed to assemble a web page from the caller-specified templates.
19 :    
20 :     =over 4
21 :    
22 :     =item tmpl_data
23 :    
24 :     Information about where to get the templates. If omitted, then default templates are used.
25 :     If a string, then the string should be the name of the template file for the page body.
26 :     If a hash reference, then the C<body> member must be the string for the body template and
27 :     the C<frame> member must be the string for the frame template.
28 :    
29 :     =item RETURN
30 :    
31 :     Returns a blessed layout object initialized using the specified template strings.
32 :    
33 :     =back
34 :    
35 :     =cut
36 : paarmann 1.1 sub new {
37 : paczian 1.3 my ($class, $tmpl_path) = @_;
38 : parrello 1.10 my ($body, $frame);
39 : paczian 1.3 my $tmpl = $tmpl_path || TMPL_PATH.'WebLayoutDefault.tmpl';
40 : parrello 1.10 if (ref $tmpl eq 'HASH') {
41 :     my $bodyString = $tmpl->{body};
42 :     my $frameString = $tmpl->{frame};
43 :     $body = HTML::Template->new(scalarref => \$bodyString, die_on_bad_params => 0);
44 :     $frame = HTML::Template->new(scalarref => \$frameString, die_on_bad_params => 0);
45 :     } else {
46 :     $body = HTML::Template->new(filename => $tmpl, die_on_bad_params => 0);
47 :     $frame = HTML::Template->new(filename => TMPL_PATH . 'WebLayoutFrame.tmpl',
48 :     die_on_bad_params => 0);
49 :     }
50 :    
51 : paczian 1.3
52 : parrello 1.10 my $self = { 'template' => $body,
53 :     'frame' => $frame,
54 : paczian 1.3 'title' => '',
55 :     'javascript' => [],
56 :     'css' => [],
57 : paczian 1.7 'meta' => [],
58 : parrello 1.10 'relocation' => "",
59 : paczian 1.3 };
60 : paarmann 1.1
61 :     bless($self, $class);
62 :    
63 :     return $self;
64 :     }
65 :    
66 : parrello 1.10 =head3 set_relocation
67 :    
68 :     $layout->set_relocation($prefix);
69 :    
70 :     Specify the relocation rule for relative URLs in links added to the
71 :     header. The rule will change the value C<./> at the beginning of a URL to
72 :     the specified prefix.
73 :    
74 :     =over 4
75 :    
76 :     =item prefix
77 :    
78 :     Relative URL prefix used to get back to the normal location.
79 :    
80 :     =back
81 :    
82 :     =cut
83 :    
84 :     sub set_relocation {
85 :     # Get the parameters.
86 :     my ($self, $prefix) = @_;
87 :     # Set the new relocation prefix.
88 :     $self->{relocation} = $prefix;
89 :     }
90 :    
91 :     =head3 relocate
92 :    
93 :     my $relocatedURL = $layout->relocate($url);
94 :    
95 :     Relocate the specified URL using the stored relocation factor. The
96 :     relocation factor indicates the difference between the location of the
97 :     active CGI script and the expected CGI directory.
98 :    
99 :     =over 4
100 :    
101 :     =item url
102 :    
103 :     URL to relocate.
104 :    
105 :     =item RETURN
106 :    
107 :     Returns a relocated URL. If the URL is absolute, it is unchanged. If it is relative, it
108 :     will be moved according to the instructions in the relocation prefix.
109 :    
110 :     =back
111 :    
112 :     =cut
113 :    
114 :     sub relocate {
115 :     # Get the parameters.
116 :     my ($self, $url) = @_;
117 :     # Declare the return variable.
118 :     my $retVal;
119 :     # Determine the type of URL.
120 :     if ($url =~ m#^(http|/)#) {
121 :     # Here it's absolute, so we don't change it.
122 :     $retVal = $url;
123 :     } else {
124 :     # Here it's relative. We need to relocate it. Strip off a dot-slash. This
125 :     # is essentially a no-op.
126 :     $url =~ s#^\./##;
127 :     # Stash the relocation prefix in front.
128 :     $retVal = $self->{relocation} . $url;
129 :     }
130 :     # Return the result.
131 :     return $retVal;
132 :     }
133 : paczian 1.3
134 : paarmann 1.1 sub set_content {
135 : paczian 1.3 $_[0]->frame->param( TITLE => $_[1]->{'title'} );
136 :    
137 :     my @warn = map { { MSG => $_ } } @{$_[1]->{'warnings'}};
138 :     my @info = map { { MSG => $_ } } @{$_[1]->{'info'}};
139 :     $_[0]->template->param( CONTENT => $_[1]->{'content'});
140 :     $_[0]->template->param( MENU => $_[1]->{'menu'});
141 : paarmann 1.4 $_[0]->template->param( USER => $_[1]->{'user'});
142 : paczian 1.3 $_[0]->template->param( WARNINGS => \@warn );
143 :     $_[0]->template->param( INFO => \@info );
144 :     }
145 :    
146 :    
147 : parrello 1.5 sub set_variable {
148 :     $_[0]->template->param( $_[1] => $_[2]);
149 :     }
150 :    
151 :    
152 : paczian 1.3 sub add_javascript {
153 :     if ($_[1]) {
154 : parrello 1.10 push @{$_[0]->{'javascript'}}, { 'JSFILE' => $_[0]->relocate($_[1]) };
155 : paczian 1.3 }
156 :     }
157 :    
158 :     sub add_css {
159 :     if ($_[1]) {
160 : parrello 1.10 unshift @{$_[0]->{'css'}}, { 'CSSFILE' => $_[0]->relocate($_[1]) };
161 : paczian 1.3 }
162 : paarmann 1.1 }
163 : paczian 1.9 sub add_css_reverse {
164 :     if ($_[1]) {
165 : parrello 1.10 push @{$_[0]->{'css'}}, { 'CSSFILE' => $_[0]->relocate($_[1]) };
166 : paczian 1.9 }
167 :     }
168 : paarmann 1.1
169 : paczian 1.7 sub add_metatag {
170 :     if ($_[1]) {
171 :     push @{$_[0]->{'meta'}}, { 'METATAG' => $_[1] };
172 :     }
173 :     }
174 :    
175 : paarmann 1.1 sub output {
176 :     my $self = shift;
177 : parrello 1.10
178 : paczian 1.3 $self->frame->param( BODY => $self->template->output() );
179 :     $self->frame->param( JAVASCRIPT => $self->{'javascript'} );
180 :     $self->frame->param( CSS => $self->{'css'} );
181 : paczian 1.7 $self->frame->param( META => $self->{'meta'} );
182 : parrello 1.10 my $retVal = $self->frame->output();
183 :     return $retVal;
184 : paarmann 1.1 }
185 :    
186 : paarmann 1.2 sub template {
187 : paczian 1.3 return $_[0]->{'template'};
188 :     }
189 : paarmann 1.1
190 : paczian 1.3 sub frame {
191 :     return $_[0]->{'frame'};
192 : paarmann 1.1 }
193 : parrello 1.10
194 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3