/[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 3 - (hide annotations)
Sun Mar 7 18:48:13 2004 UTC (16 years, 5 months ago) by dpavlin
File size: 6063 byte(s)
implemented subject screen

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     my $dsn = 'Pg:dbname=libdata';
15     my ($user,$passwd) = ('dpavlin','');
16    
17 dpavlin 3 my @persistent_vars = qw(p ms);
18 dpavlin 1
19     # read global.conf configuration
20     my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";
21    
22     # configuration options from global.conf
23     my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') || die "need template_html in global.conf, section webpac";
24     my $CHARSET = $cfg_global->val('webpac', 'charset') || 'ISO-8859-1';
25    
26     my $dbh = DBI->connect("DBI:$dsn",$user,$passwd, { RaiseError => 1 });
27    
28     use POSIX qw(locale_h);
29     setlocale(LC_CTYPE, "hr_HR");
30     use locale;
31    
32     sub setup {
33     my $self = shift;
34     $self->tmpl_path($TEMPLATE_PATH);
35     $self->run_modes(
36     'home' => 'show_home',
37     'ms' => 'show_ms',
38     'it' => 'show_home',
39 dpavlin 3 's' => 'show_s',
40 dpavlin 1 );
41     $self->start_mode('home');
42     $self->mode_param('p');
43    
44     $self->header_props(-charset=>$CHARSET);
45     }
46    
47    
48 dpavlin 3 # home page
49 dpavlin 1 sub show_home {
50     my $self = shift;
51    
52     # Get the CGI.pm query object
53     my $q = $self->query();
54     # template
55    
56     # read master template
57     my $tmpl = $self->use_template('home.html');
58    
59     $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
60     $tmpl->param('InfoTypes' => $self->get_infotypes() );
61    
62     $tmpl->param('Subjects_letters' => $self->get_subjects_letters() );
63     $tmpl->param('Subjects' => $self->get_subjects() );
64    
65     return $tmpl->output;
66    
67     }
68    
69 dpavlin 3
70     # MasterSubject
71 dpavlin 1 sub show_ms {
72     my $self = shift;
73    
74     my $q = $self->query();
75    
76     my $tmpl = $self->use_template('ms.html');
77    
78     $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
79    
80     my $ms = $self->get_mastersubjects_by_id($q->param('ms'));
81    
82     $tmpl->param('title' => uc($ms->{'mastersubject'}) );
83 dpavlin 3 $tmpl->param('search_field' => lc($ms->{'mastersubject'}) );
84 dpavlin 1
85     $tmpl->param('InfoTypes' => $self->get_infotypes() );
86    
87     $tmpl->param('Subjects' => $self->get_subjects() );
88    
89     return $tmpl->output;
90    
91     }
92    
93 dpavlin 3
94     # Subject
95     sub show_s {
96     my $self = shift;
97    
98     my $q = $self->query();
99    
100     my $tmpl = $self->use_template('s.html');
101    
102     $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
103    
104     my $s = $self->get_subjects_by_id($q->param('s'));
105    
106     $tmpl->param('title' => uc($s->{'subject'}) );
107     $tmpl->param('search_field' => lc($s->{'subject'}) );
108    
109     $tmpl->param('InfoTypes' => $self->get_infotypes() );
110    
111     return $tmpl->output;
112    
113     }
114    
115    
116     #
117 dpavlin 1 # load template and generate permanent valirables in template
118 dpavlin 3 #
119 dpavlin 1
120     sub use_template {
121     my $self = shift;
122     my $q = $self->query();
123    
124     my $tmpl_file = shift || croak("perm_vars need tempate file");
125     my $tmpl = $self->load_tmpl($tmpl_file, global_vars => 1, die_on_bad_params => 0);
126    
127     $tmpl->param('self_url_full', $q->url(-relative=>1,-query=>1));
128     $tmpl->param('self_url', $q->url(-relative=>1));
129    
130     foreach my $var (@persistent_vars) {
131     $tmpl->param($var, $q->param($var));
132     }
133    
134     return $tmpl;
135     }
136    
137 dpavlin 3
138     #
139 dpavlin 1 # get data from database
140 dpavlin 3 #
141 dpavlin 1
142 dpavlin 3 # get all MasterSubjects
143 dpavlin 1 sub get_mastersubjects {
144     my $self = shift;
145    
146     my $q = $self->query();
147    
148     my $sql = qq{
149     select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected
150     from mastersubject
151     where mastersubject_id > 2
152     order by mastersubject
153     };
154    
155     my $sth = $dbh->prepare($sql);
156     $sth->execute($q->param('ms') || undef);
157    
158     return $sth->fetchall_arrayref({});
159     }
160    
161 dpavlin 3 # get one MasterSubject by it's ID
162 dpavlin 1 sub get_mastersubjects_by_id {
163     my $self = shift;
164    
165     my $id = shift || croak("need mastersubject id");
166    
167     my $sql = qq{
168     select mastersubject
169     from mastersubject
170     where mastersubject_id = ?
171     };
172    
173     my $sth = $dbh->prepare($sql);
174     $sth->execute($id);
175    
176     return $sth->fetchrow_hashref();
177     }
178    
179 dpavlin 3 # get all InfoTypes
180 dpavlin 1 sub get_infotypes {
181     my $self = shift;
182    
183     my $q = $self->query();
184     my @args;
185    
186     push @args,$q->param('it') || undef; # for selected
187    
188     my $sql = qq{
189     select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected
190     from res_sub_infotype,infotype
191     where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
192     };
193    
194 dpavlin 3
195     # first check if subject is defined and limit by that, and only if it's not
196     # fallback to mastersubject
197     if ($q->param('s')) {
198 dpavlin 1 $sql .= qq{
199 dpavlin 3 and res_sub_infotype.subject_id = ?
200     };
201     push @args, $q->param('s');
202     } elsif ($q->param('ms')) {
203     $sql .= qq{
204 dpavlin 1 and res_sub_infotype.subject_id in
205     (select subject_id from sub_mastersubject where mastersubject_id = ?)
206     };
207     push @args, $q->param('ms');
208     }
209    
210     $sql .= qq{
211     order by infotype
212     };
213    
214     my $sth = $dbh->prepare($sql);
215     $sth->execute(@args);
216    
217     my $arr = $sth->fetchall_arrayref({});
218    
219     # find element which is on half of list
220     my $half = int(scalar @$arr / 2) - 1;
221     $arr->[$half]->{half} = 1 if ($half > 0);
222     return $arr;
223     }
224    
225 dpavlin 3 # get first letters for all Subjects
226 dpavlin 1 sub get_subjects_letters {
227     my $self = shift;
228    
229     my $sql = qq{
230     select distinct substr(subject,1,1) as letter
231     from subject
232     where subject_id > 1
233     order by substr(subject,1,1)
234     };
235    
236     my $sth = $dbh->prepare($sql);
237     $sth->execute();
238    
239     return $sth->fetchall_arrayref({});
240     }
241    
242 dpavlin 3 # get all Subjects
243 dpavlin 1 sub get_subjects {
244     my $self = shift;
245    
246     my $q = $self->query();
247     my @args;
248    
249     my $sql = qq{
250     select subject.subject_id,subject.subject,sub_mastersubject.mastersubject_id
251     from subject,sub_mastersubject
252     where subject.subject_id=sub_mastersubject.subject_id
253     and subject.subject_id > 1
254     };
255    
256     if ($q->param('s_letter')) {
257     push @args,$q->param('s_letter') . '%';
258     $sql .= qq{
259     and upper(subject.subject) like upper(?)
260     };
261     }
262    
263     if ($q->param('ms')) {
264     push @args,$q->param('ms');
265     $sql .= qq{
266     and sub_mastersubject.mastersubject_id = ?
267     };
268     }
269    
270     $sql .= qq{
271     order by subject.subject
272     };
273    
274     my $sth = $dbh->prepare($sql);
275     $sth->execute(@args);
276    
277     return $sth->fetchall_arrayref({});
278     }
279    
280 dpavlin 3 # get one Subject by it's ID
281     sub get_subjects_by_id {
282     my $self = shift;
283    
284     my $id = shift || croak("need subject id");
285    
286     my $sql = qq{
287     select subject
288     from subject
289     where subject_id = ?
290     };
291    
292     my $sth = $dbh->prepare($sql);
293     $sth->execute($id);
294    
295     return $sth->fetchrow_hashref();
296     }
297    
298 dpavlin 1 1;

  ViewVC Help
Powered by ViewVC 1.1.26