/[libdata-portal]/trunk/Portal.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/Portal.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8 - (show annotations)
Sun Mar 7 20:57:54 2004 UTC (15 years, 7 months ago) by dpavlin
File size: 9097 byte(s)
moved configuration into global.conf, removed left-over code

1 package Portal;
2
3 use base 'CGI::Application';
4 use strict;
5
6 use Config::IniFiles;
7 use DBI;
8 use Carp;
9
10 use Data::Dumper;
11
12 use lib '..';
13
14 my @persistent_vars = qw(p ms s);
15
16 # read global.conf configuration
17 my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";
18
19 # configuration options from global.conf
20 my $TEMPLATE_PATH = $cfg_global->val('portal', 'template_html') || die "need template_html in global.conf, section portal";
21 my $CHARSET = $cfg_global->val('portal', 'charset') || 'ISO-8859-1';
22 my $dsn = $cfg_global->val('portal', 'dbi_dsn') || die "need dsn in global.conf, section portal";
23 my ($user,$passwd) = ($cfg_global->val('portal', 'dbi_user'), $cfg_global->val('portal', 'dbi_passwd'));
24 my $locale = $cfg_global->val('portal', 'locale') || 'C';
25
26
27 my $dbh = DBI->connect("DBI:".$dsn,$user,$passwd, { RaiseError => 1 });
28
29 use POSIX qw(locale_h);
30 setlocale(LC_CTYPE, $locale);
31 use locale;
32
33 sub setup {
34 my $self = shift;
35 $self->tmpl_path($TEMPLATE_PATH);
36 $self->run_modes(
37 'home' => 'show_home',
38 'ms' => 'show_mastersubject',
39 's' => 'show_subject',
40 'r' => 'search_resources',
41 );
42 $self->start_mode('home');
43 $self->mode_param('p');
44
45 $self->header_props(-charset=>$CHARSET);
46 }
47
48
49 # home page
50 sub show_home {
51 my $self = shift;
52
53 # Get the CGI.pm query object
54 my $q = $self->query();
55 # template
56
57 # read master template
58 my $tmpl = $self->use_template('home.html');
59
60 $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
61 $tmpl->param('InfoTypes' => $self->get_infotypes() );
62
63 $tmpl->param('Subjects_letters' => $self->get_subjects_letters() );
64 $tmpl->param('Subjects' => $self->get_subjects() );
65
66 return $tmpl->output;
67
68 }
69
70
71 # MasterSubject
72 sub show_mastersubject {
73 my $self = shift;
74
75 my $q = $self->query();
76
77 my $tmpl = $self->use_template('ms.html');
78
79 $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
80
81 my $ms = $self->get_mastersubject_by_id($q->param('ms'));
82
83 $tmpl->param('title' => uc($ms->{'mastersubject'}) );
84 $tmpl->param('search_field' => lc($ms->{'mastersubject'}) );
85
86 $tmpl->param('InfoTypes' => $self->get_infotypes() );
87
88 $tmpl->param('Subjects' => $self->get_subjects() );
89
90 return $tmpl->output;
91
92 }
93
94
95 # Subject
96 sub show_subject {
97 my $self = shift;
98
99 my $q = $self->query();
100
101 my $tmpl = $self->use_template('s.html');
102
103 $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
104
105 my $s = $self->get_subject_by_id($q->param('s'));
106
107 $tmpl->param('title' => uc($s->{'subject'}) );
108 $tmpl->param('search_field' => lc($s->{'subject'}) );
109
110 $tmpl->param('InfoTypes' => $self->get_infotypes() );
111
112 return $tmpl->output;
113
114 }
115
116
117 # search for resources and display results
118 sub search_resources {
119 my $self = shift;
120
121 my $q = $self->query();
122
123 my $tmpl = $self->use_template('r.html');
124
125 $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
126
127 if ($q->param('s')) {
128 my $s = $self->get_subject_by_id($q->param('s'));
129
130 $tmpl->param('title' => uc($s->{'subject'}) );
131 $tmpl->param('search_field' => lc($s->{'subject'}) );
132 } elsif ($q->param('ms')) {
133 my $s = $self->get_mastersubject_by_id($q->param('ms'));
134
135 $tmpl->param('title' => uc($s->{'mastersubject'}) );
136 $tmpl->param('search_field' => lc($s->{'mastersubject'}) );
137 }
138
139 my $res = $self->get_resources();
140 $tmpl->param('resource_results' => $res);
141 $tmpl->param('nr_results' => scalar @$res);
142
143 $tmpl->param('limit_infotype' => $self->get_infotype_by_id($q->param('it'))->{'infotype'});
144
145 return $tmpl->output;
146
147 }
148
149 #
150 # load template and generate permanent valirables in template
151 #
152
153 sub use_template {
154 my $self = shift;
155 my $q = $self->query();
156
157 my $tmpl_file = shift || croak("perm_vars need tempate file");
158 my $tmpl = $self->load_tmpl($tmpl_file, global_vars => 1, die_on_bad_params => 0);
159
160 $tmpl->param('self_url_full', $q->url(-relative=>1,-query=>1));
161 $tmpl->param('self_url', $q->url(-relative=>1));
162
163 foreach my $var (@persistent_vars) {
164 $tmpl->param($var, $q->param($var));
165 }
166
167 return $tmpl;
168 }
169
170
171 #
172 # get data from database
173 #
174
175 # get all MasterSubjects
176 sub get_mastersubjects {
177 my $self = shift;
178
179 my $q = $self->query();
180
181 my $sql = qq{
182 select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected
183 from mastersubject
184 where mastersubject_id > 2
185 order by mastersubject
186 };
187
188 my $sth = $dbh->prepare($sql);
189 $sth->execute($q->param('ms') || undef);
190
191 return $sth->fetchall_arrayref({});
192 }
193
194 # get one MasterSubject by it's ID
195 sub get_mastersubject_by_id {
196 my $self = shift;
197
198 my $id = shift || croak("need mastersubject id");
199
200 my $sql = qq{
201 select mastersubject
202 from mastersubject
203 where mastersubject_id = ?
204 };
205
206 my $sth = $dbh->prepare($sql);
207 $sth->execute($id);
208
209 return $sth->fetchrow_hashref();
210 }
211
212 # get all InfoTypes
213 sub get_infotypes {
214 my $self = shift;
215
216 my $q = $self->query();
217 my @args;
218
219 push @args,$q->param('it') || undef; # for selected
220
221 my $sql = qq{
222 select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected
223 from res_sub_infotype,infotype
224 where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
225 };
226
227
228 # first check if subject is defined and limit by that, and only if it's not
229 # fallback to mastersubject
230 if ($q->param('s')) {
231 $sql .= qq{
232 and res_sub_infotype.subject_id = ?
233 };
234 push @args, $q->param('s');
235 } elsif ($q->param('ms')) {
236 $sql .= qq{
237 and res_sub_infotype.subject_id in
238 (select subject_id from sub_mastersubject where mastersubject_id = ?)
239 };
240 push @args, $q->param('ms');
241 }
242
243 $sql .= qq{
244 order by infotype
245 };
246
247 my $sth = $dbh->prepare($sql);
248 $sth->execute(@args);
249
250 my $arr = $sth->fetchall_arrayref({});
251
252 # find element which is on half of list
253 my $half = int(scalar @$arr / 2) - 1;
254 $arr->[$half]->{half} = 1 if ($half > 0);
255 return $arr;
256 }
257
258 # get first letters for all Subjects
259 sub get_subjects_letters {
260 my $self = shift;
261
262 my $sql = qq{
263 select distinct substr(subject,1,1) as letter
264 from subject
265 where subject_id > 1
266 order by substr(subject,1,1)
267 };
268
269 my $sth = $dbh->prepare($sql);
270 $sth->execute();
271
272 return $sth->fetchall_arrayref({});
273 }
274
275 # get all Subjects
276 sub get_subjects {
277 my $self = shift;
278
279 my $q = $self->query();
280 my @args;
281
282 my $sql = qq{
283 select subject.subject_id,subject.subject,sub_mastersubject.mastersubject_id
284 from subject,sub_mastersubject
285 where subject.subject_id=sub_mastersubject.subject_id
286 and subject.subject_id > 1
287 };
288
289 if ($q->param('s_letter')) {
290 push @args,$q->param('s_letter') . '%';
291 $sql .= qq{
292 and upper(subject.subject) like upper(?)
293 };
294 }
295
296 if ($q->param('ms')) {
297 push @args,$q->param('ms');
298 $sql .= qq{
299 and sub_mastersubject.mastersubject_id = ?
300 };
301 }
302
303 $sql .= qq{
304 order by subject.subject
305 };
306
307 my $sth = $dbh->prepare($sql);
308 $sth->execute(@args);
309
310 return $sth->fetchall_arrayref({});
311 }
312
313 # get one Subject by it's ID
314 sub get_subject_by_id {
315 my $self = shift;
316
317 my $id = shift || croak("need subject id");
318
319 my $sql = qq{
320 select subject
321 from subject
322 where subject_id = ?
323 };
324
325 my $sth = $dbh->prepare($sql);
326 $sth->execute($id);
327
328 return $sth->fetchrow_hashref();
329 }
330
331 # get one InfoType by it's ID
332 sub get_infotype_by_id {
333 my $self = shift;
334
335 my $id = shift || croak("need infotype id");
336
337 my $sql = qq{
338 select infotype
339 from infotype
340 where infotype_id = ?
341 };
342
343 my $sth = $dbh->prepare($sql);
344 $sth->execute($id);
345
346 return $sth->fetchrow_hashref();
347 }
348
349 # get add resources for given criteria
350 sub get_resources {
351 my $self = shift;
352
353 my $q = $self->query();
354 my @args;
355
356 my $sql = qq{
357 select distinct resource.resource_id, title, infotype.infotype, coverage_detail, url
358 };
359
360 my $sql_from = qq{
361 from resource,infotype
362 };
363
364 my $sql_where = qq{
365 where resource.infotype_id=infotype.infotype_id
366 };
367
368 # limits
369 if ($q->param('s')) {
370 $sql_from .= qq{ , res_sub_infotype };
371 $sql_where .= qq{
372 and res_sub_infotype.resource_id = resource.resource_id
373 and res_sub_infotype.subject_id = ?
374 };
375 push @args, $q->param('s');
376 } elsif ($q->param('ms')) {
377 $sql_from .= qq{ , res_sub_infotype };
378 $sql_where .= qq{
379 and res_sub_infotype.resource_id = resource.resource_id
380 and res_sub_infotype.subject_id in
381 (select subject_id from sub_mastersubject where mastersubject_id = ?)
382 };
383 push @args, $q->param('ms');
384 }
385 if ($q->param('it')) {
386 if ($sql_from !~ m/res_sub_infotype/) {
387 $sql_from .= qq{ , res_sub_infotype };
388 $sql_where .= qq{ and res_sub_infotype.resource_id = resource.resource_id };
389 }
390 $sql_where .= qq{ and res_sub_infotype.infotype_id = ? };
391 push @args, $q->param('it');
392 }
393
394 my $sth = $dbh->prepare($sql.$sql_from.$sql_where);
395 $sth->execute(@args);
396
397 my $arr = $sth->fetchall_arrayref({});
398
399 # now fill-in features
400 $sql = qq{
401 select feature
402 from res_feature,feature
403 where res_feature.feature_id = feature.feature_id and res_feature.resource_id = ?
404 };
405 $sth = $dbh->prepare($sql);
406
407 foreach my $i ( 0 .. (scalar @$arr)-1 ) {
408 $sth->execute($arr->[$i]->{'resource_id'});
409 $arr->[$i]->{'res_features'} = $sth->fetchall_arrayref({});
410 }
411
412 return $arr;
413 }
414 1;

  ViewVC Help
Powered by ViewVC 1.1.26