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

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 $dsn = 'Pg:dbname=libdata';
15 my ($user,$passwd) = ('dpavlin','');
16
17 my @persistent_vars = qw(p ms);
18
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 's' => 'show_s',
40 );
41 $self->start_mode('home');
42 $self->mode_param('p');
43
44 $self->header_props(-charset=>$CHARSET);
45 }
46
47
48 # home page
49 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
70 # MasterSubject
71 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 $tmpl->param('search_field' => lc($ms->{'mastersubject'}) );
84
85 $tmpl->param('InfoTypes' => $self->get_infotypes() );
86
87 $tmpl->param('Subjects' => $self->get_subjects() );
88
89 return $tmpl->output;
90
91 }
92
93
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 # load template and generate permanent valirables in template
118 #
119
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
138 #
139 # get data from database
140 #
141
142 # get all MasterSubjects
143 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 # get one MasterSubject by it's ID
162 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 # get all InfoTypes
180 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
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 $sql .= qq{
199 and res_sub_infotype.subject_id = ?
200 };
201 push @args, $q->param('s');
202 } elsif ($q->param('ms')) {
203 $sql .= qq{
204 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 # get first letters for all Subjects
226 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 # get all Subjects
243 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 # 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 1;

  ViewVC Help
Powered by ViewVC 1.1.26