/[libdata-portal]/branches/mysql/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

Diff of /branches/mysql/trunk/Portal.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/Portal.pm revision 1 by dpavlin, Sun Mar 7 18:22:26 2004 UTC branches/mysql/trunk/Portal.pm revision 13 by dpavlin, Sun Mar 28 21:13:20 2004 UTC
# Line 5  use strict; Line 5  use strict;
5    
6  use Config::IniFiles;  use Config::IniFiles;
7  use DBI;  use DBI;
8    use Carp;
9    
10  use Data::Dumper;  use Data::Dumper;
11    
12  use lib '..';  use lib '..';
13    
14  my $dsn = 'Pg:dbname=libdata';  my @persistent_vars = qw(p ms s);
 my ($user,$passwd) = ('dpavlin','');  
   
 my @persistent_vars = qw(p);  
15    
16  # read global.conf configuration  # read global.conf configuration
17  my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";  my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";
18    
19  # configuration options from global.conf  # configuration options from global.conf
20  my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') || die "need template_html in global.conf, section webpac";  my $TEMPLATE_PATH = $cfg_global->val('portal', 'template_html') || die "need template_html in global.conf, section portal";
21  my $CHARSET = $cfg_global->val('webpac', 'charset') || 'ISO-8859-1';  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 });  my $dbh = DBI->connect("DBI:".$dsn,$user,$passwd, { RaiseError => 1 });
28    
29  use POSIX qw(locale_h);  use POSIX qw(locale_h);
30  setlocale(LC_CTYPE, "hr_HR");  setlocale(LC_CTYPE, $locale);
31  use locale;  use locale;
32    
33  sub setup {  sub setup {
# Line 33  sub setup { Line 35  sub setup {
35          $self->tmpl_path($TEMPLATE_PATH);          $self->tmpl_path($TEMPLATE_PATH);
36          $self->run_modes(          $self->run_modes(
37                  'home' => 'show_home',                  'home' => 'show_home',
38                  'ms' => 'show_ms',                  'ms' => 'show_mastersubject',
39                  'it' => 'show_home',                  's' => 'show_subject',
40                  's' => 'show_home',                  'r' => 'search_resources',
41          );          );
42          $self->start_mode('home');          $self->start_mode('home');
43          $self->mode_param('p');          $self->mode_param('p');
# Line 44  sub setup { Line 46  sub setup {
46  }  }
47    
48    
49    # home page
50  sub show_home {  sub show_home {
51          my $self = shift;          my $self = shift;
52    
# Line 64  sub show_home { Line 67  sub show_home {
67    
68  }  }
69    
70  sub show_ms {  
71    # MasterSubject
72    sub show_mastersubject {
73          my $self = shift;          my $self = shift;
74    
75          my $q = $self->query();          my $q = $self->query();
# Line 73  sub show_ms { Line 78  sub show_ms {
78    
79          $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );          $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
80    
81          my $ms = $self->get_mastersubjects_by_id($q->param('ms'));          my $ms = $self->get_mastersubject_by_id($q->param('ms'));
82    
83          $tmpl->param('title' => uc($ms->{'mastersubject'}) );          $tmpl->param('title' => uc($ms->{'mastersubject'}) );
84          $tmpl->param('mastersubject_lc' => lc($ms->{'mastersubject'}) );          $tmpl->param('search_field' => lc($ms->{'mastersubject'}) );
85    
86          $tmpl->param('InfoTypes' => $self->get_infotypes() );          $tmpl->param('InfoTypes' => $self->get_infotypes() );
87    
# Line 86  sub show_ms { Line 91  sub show_ms {
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  # load template and generate permanent valirables in template
151    #
152    
153  sub use_template {  sub use_template {
154          my $self = shift;          my $self = shift;
# Line 105  sub use_template { Line 167  sub use_template {
167          return $tmpl;          return $tmpl;
168  }  }
169    
170    
171    #
172  # get data from database  # get data from database
173    #
174    
175    # get all MasterSubjects
176  sub get_mastersubjects {  sub get_mastersubjects {
177          my $self = shift;          my $self = shift;
178    
179          my $q = $self->query();          my $q = $self->query();
180    
181          my $sql = qq{          my $sql = qq{
182          select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected          select mastersubject_id,upper(mastersubject) as mastersubject
183                  from mastersubject                  from mastersubject
184                  where mastersubject_id > 2                  where mastersubject_id > 2
185                  order by mastersubject                  order by mastersubject
186          };          };
187    
188          my $sth = $dbh->prepare($sql);          my $sth = $dbh->prepare($sql);
189          $sth->execute($q->param('ms') || undef);          $sth->execute();
190            my $arr = $sth->fetchall_arrayref({});
191    
192          return $sth->fetchall_arrayref({});          return if (! $arr);
193            return $arr if (! $q->param('ms'));
194    
195            # add selected column
196            foreach my $i ( 0 .. (scalar @$arr)-1 ) {
197                    $arr->[$i]->{'selected'} = ($arr->[$i]->{'mastersubject_id'} == $q->param('ms'));
198            }
199            return $arr;
200  }  }
201    
202  sub get_mastersubjects_by_id {  # get one MasterSubject by it's ID
203    sub get_mastersubject_by_id {
204          my $self = shift;          my $self = shift;
205    
206          my $id = shift || croak("need mastersubject id");          my $id = shift || croak("need mastersubject id");
# Line 142  sub get_mastersubjects_by_id { Line 217  sub get_mastersubjects_by_id {
217          return $sth->fetchrow_hashref();          return $sth->fetchrow_hashref();
218  }  }
219    
220    # WARNING: Cludge ahead!
221    #
222    # stupid MySQL doesn't support subselects.
223    #
224    sub select_subject_id_where_mastersubject_id {
225            my $id = shift || croak("sub select emulation needs mastersubject_id");
226            my $sql = qq{ select subject_id from sub_mastersubject where mastersubject_id = ? };
227    
228            my $sth = $dbh->prepare($sql);
229            $sth->execute($id);
230    
231            my $arr = $sth->fetchall_hashref('subject_id');
232    
233            $sql = join(",",keys %$arr);
234            $sql = "null" if (! $sql);
235            return $sql;
236    }
237    
238    
239    # get all InfoTypes
240  sub get_infotypes {  sub get_infotypes {
241          my $self = shift;          my $self = shift;
242    
243          my $q = $self->query();          my $q = $self->query();
244          my @args;          my @args;
245                    
         push @args,$q->param('it') || undef;    # for selected  
           
246          my $sql = qq{          my $sql = qq{
247                  select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected                  select distinct infotype.infotype_id,infotype.infotype, 0 as half
248                  from res_sub_infotype,infotype                  from res_sub_infotype,infotype
249                  where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1                  where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
250          };          };
251    
252          if ($q->param('ms')) {  
253            # first check if subject is defined and limit by that, and only if it's not
254            # fallback to mastersubject
255            if ($q->param('s')) {
256                  $sql .= qq{                  $sql .= qq{
257                          and res_sub_infotype.subject_id in                          and res_sub_infotype.subject_id = ?
                                 (select subject_id from sub_mastersubject where mastersubject_id = ?)  
258                  };                  };
259                  push @args, $q->param('ms');                  push @args, $q->param('s');
260            } elsif ($q->param('ms')) {
261                    my $ss_sql = select_subject_id_where_mastersubject_id($q->param('ms'));
262                    $sql .= qq{ and res_sub_infotype.subject_id in ($ss_sql) };
263          }          }
264    
265          $sql .= qq{          $sql .= qq{
# Line 176  sub get_infotypes { Line 274  sub get_infotypes {
274          # find element which is on half of list          # find element which is on half of list
275          my $half = int(scalar @$arr / 2) - 1;          my $half = int(scalar @$arr / 2) - 1;
276          $arr->[$half]->{half} = 1 if ($half > 0);          $arr->[$half]->{half} = 1 if ($half > 0);
277    
278            return $arr if (! $q->param('it'));
279    
280            # add selected column
281            foreach my $i ( 0 .. (scalar @$arr)-1 ) {
282                    $arr->[$i]->{'selected'} = ($arr->[$i]->{'infotype_id'} == $q->param('it'));
283            }
284          return $arr;          return $arr;
285  }  }
286    
287    # get first letters for all Subjects
288  sub get_subjects_letters {  sub get_subjects_letters {
289          my $self = shift;          my $self = shift;
290    
291          my $sql = qq{          my $sql = qq{
292          select distinct substr(subject,1,1) as letter          select distinct substring(subject from 1 for 1) as letter
293                  from subject                  from subject
294                  where subject_id > 1                  where subject_id > 1
295                  order by substr(subject,1,1)                  order by substring(subject from 1 for 1)
296          };          };
297    
298          my $sth = $dbh->prepare($sql);          my $sth = $dbh->prepare($sql);
# Line 195  sub get_subjects_letters { Line 301  sub get_subjects_letters {
301          return $sth->fetchall_arrayref({});          return $sth->fetchall_arrayref({});
302  }  }
303    
304    # get all Subjects
305  sub get_subjects {  sub get_subjects {
306          my $self = shift;          my $self = shift;
307    
# Line 223  sub get_subjects { Line 330  sub get_subjects {
330          }          }
331    
332          $sql .= qq{          $sql .= qq{
333                    group by subject.subject_id
334                  order by subject.subject                  order by subject.subject
335          };          };
336    
# Line 232  sub get_subjects { Line 340  sub get_subjects {
340          return $sth->fetchall_arrayref({});          return $sth->fetchall_arrayref({});
341  }  }
342    
343    # get one Subject by it's ID
344    sub get_subject_by_id {
345            my $self = shift;
346    
347            my $id = shift || croak("need subject id");
348    
349            my $sql = qq{
350            select subject
351                    from subject
352                    where subject_id = ?
353            };
354    
355            my $sth = $dbh->prepare($sql);
356            $sth->execute($id);
357    
358            return $sth->fetchrow_hashref();
359    }
360    
361    # get one InfoType by it's ID
362    sub get_infotype_by_id {
363            my $self = shift;
364    
365            my $id = shift || croak("need infotype id");
366    
367            my $sql = qq{
368            select infotype
369                    from infotype
370                    where infotype_id = ?
371            };
372    
373            my $sth = $dbh->prepare($sql);
374            $sth->execute($id);
375    
376            return $sth->fetchrow_hashref();
377    }
378    
379    # get add resources for given criteria
380    sub get_resources {
381            my $self = shift;
382    
383            my $q = $self->query();
384            my @args;
385    
386            my $sql = qq{
387                    select distinct resource.resource_id, title, infotype.infotype, coverage_detail, url
388            };
389    
390            my $sql_from = qq{
391                            from resource,infotype
392            };
393    
394            my $sql_where = qq{
395                            where resource.infotype_id=infotype.infotype_id
396            };
397    
398            # limits
399            if ($q->param('s')) {
400                    $sql_from .= qq{ , res_sub_infotype };
401                    $sql_where .= qq{
402                            and res_sub_infotype.resource_id = resource.resource_id
403                            and res_sub_infotype.subject_id = ?
404                    };
405                    push @args, $q->param('s');
406            } elsif ($q->param('ms')) {
407                    $sql_from .= qq{ , res_sub_infotype };
408                    my $ss_sql = select_subject_id_where_mastersubject_id($q->param('ms'));
409                    $sql_where .= qq{
410                            and res_sub_infotype.resource_id = resource.resource_id
411                            and res_sub_infotype.subject_id in ($ss_sql)
412                    };
413            }
414            if ($q->param('it')) {
415                    if ($sql_from !~ m/res_sub_infotype/) {
416                            $sql_from .= qq{ , res_sub_infotype };
417                            $sql_where .= qq{ and res_sub_infotype.resource_id = resource.resource_id };
418                    }
419                    $sql_where .= qq{ and res_sub_infotype.infotype_id = ? };
420                    push @args, $q->param('it');
421            }
422    
423            my $sth = $dbh->prepare($sql.$sql_from.$sql_where);
424            $sth->execute(@args);
425    
426            my $arr = $sth->fetchall_arrayref({});
427    
428            # now fill-in features
429            $sql = qq{
430                    select feature
431                            from res_feature,feature
432                            where res_feature.feature_id = feature.feature_id and res_feature.resource_id = ?
433            };
434            $sth = $dbh->prepare($sql);
435    
436            foreach my $i ( 0 .. (scalar @$arr)-1 ) {
437                    $sth->execute($arr->[$i]->{'resource_id'});
438                    $arr->[$i]->{'res_features'} = $sth->fetchall_arrayref({});
439            }
440    
441            return $arr;
442    }
443  1;  1;
Legend:
Removed from v.1  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26