/[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

Annotation of /trunk/Portal.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 dpavlin 1 package Portal;
2    
3     use base 'CGI::Application';
4     use strict;
5    
6     use Config::IniFiles;
7     use DBI;
8 dpavlin 3 use Carp;
9 dpavlin 1
10     use Data::Dumper;
11    
12     use lib '..';
13    
14 dpavlin 6 my @persistent_vars = qw(p ms s);
15 dpavlin 1
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 dpavlin 8 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 dpavlin 1
26    
27 dpavlin 8 my $dbh = DBI->connect("DBI:".$dsn,$user,$passwd, { RaiseError => 1 });
28    
29 dpavlin 1 use POSIX qw(locale_h);
30 dpavlin 8 setlocale(LC_CTYPE, $locale);
31 dpavlin 1 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 dpavlin 6 'ms' => 'show_mastersubject',
39     's' => 'show_subject',
40     'r' => 'search_resources',
41 dpavlin 1 );
42     $self->start_mode('home');
43     $self->mode_param('p');
44    
45     $self->header_props(-charset=>$CHARSET);
46     }
47    
48    
49 dpavlin 3 # home page
50 dpavlin 1 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 dpavlin 3
71     # MasterSubject
72 dpavlin 6 sub show_mastersubject {
73 dpavlin 1 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 dpavlin 6 my $ms = $self->get_mastersubject_by_id($q->param('ms'));
82 dpavlin 1
83     $tmpl->param('title' => uc($ms->{'mastersubject'}) );
84 dpavlin 3 $tmpl->param('search_field' => lc($ms->{'mastersubject'}) );
85 dpavlin 1
86     $tmpl->param('InfoTypes' => $self->get_infotypes() );
87    
88     $tmpl->param('Subjects' => $self->get_subjects() );
89    
90     return $tmpl->output;
91    
92     }
93    
94 dpavlin 3
95     # Subject
96 dpavlin 6 sub show_subject {
97 dpavlin 3 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 dpavlin 6 my $s = $self->get_subject_by_id($q->param('s'));
106 dpavlin 3
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 dpavlin 6 # 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 dpavlin 3 #
150 dpavlin 1 # load template and generate permanent valirables in template
151 dpavlin 3 #
152 dpavlin 1
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 dpavlin 3
171     #
172 dpavlin 1 # get data from database
173 dpavlin 3 #
174 dpavlin 1
175 dpavlin 3 # get all MasterSubjects
176 dpavlin 1 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 dpavlin 3 # get one MasterSubject by it's ID
195 dpavlin 6 sub get_mastersubject_by_id {
196 dpavlin 1 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 dpavlin 3 # get all InfoTypes
213 dpavlin 1 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 dpavlin 3
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 dpavlin 1 $sql .= qq{
232 dpavlin 3 and res_sub_infotype.subject_id = ?
233     };
234     push @args, $q->param('s');
235     } elsif ($q->param('ms')) {
236     $sql .= qq{
237 dpavlin 1 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 dpavlin 3 # get first letters for all Subjects
259 dpavlin 1 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 dpavlin 3 # get all Subjects
276 dpavlin 1 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 dpavlin 3 # get one Subject by it's ID
314 dpavlin 6 sub get_subject_by_id {
315 dpavlin 3 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 dpavlin 6 # 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 dpavlin 1 1;

  ViewVC Help
Powered by ViewVC 1.1.26