/[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 1 - (show annotations)
Sun Mar 7 18:22:26 2004 UTC (20 years ago) by dpavlin
File size: 4954 byte(s)
initial import

1 package Portal;
2
3 use base 'CGI::Application';
4 use strict;
5
6 use Config::IniFiles;
7 use DBI;
8
9 use Data::Dumper;
10
11 use lib '..';
12
13 my $dsn = 'Pg:dbname=libdata';
14 my ($user,$passwd) = ('dpavlin','');
15
16 my @persistent_vars = qw(p);
17
18 # read global.conf configuration
19 my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";
20
21 # configuration options from global.conf
22 my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') || die "need template_html in global.conf, section webpac";
23 my $CHARSET = $cfg_global->val('webpac', 'charset') || 'ISO-8859-1';
24
25 my $dbh = DBI->connect("DBI:$dsn",$user,$passwd, { RaiseError => 1 });
26
27 use POSIX qw(locale_h);
28 setlocale(LC_CTYPE, "hr_HR");
29 use locale;
30
31 sub setup {
32 my $self = shift;
33 $self->tmpl_path($TEMPLATE_PATH);
34 $self->run_modes(
35 'home' => 'show_home',
36 'ms' => 'show_ms',
37 'it' => 'show_home',
38 's' => 'show_home',
39 );
40 $self->start_mode('home');
41 $self->mode_param('p');
42
43 $self->header_props(-charset=>$CHARSET);
44 }
45
46
47 sub show_home {
48 my $self = shift;
49
50 # Get the CGI.pm query object
51 my $q = $self->query();
52 # template
53
54 # read master template
55 my $tmpl = $self->use_template('home.html');
56
57 $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
58 $tmpl->param('InfoTypes' => $self->get_infotypes() );
59
60 $tmpl->param('Subjects_letters' => $self->get_subjects_letters() );
61 $tmpl->param('Subjects' => $self->get_subjects() );
62
63 return $tmpl->output;
64
65 }
66
67 sub show_ms {
68 my $self = shift;
69
70 my $q = $self->query();
71
72 my $tmpl = $self->use_template('ms.html');
73
74 $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
75
76 my $ms = $self->get_mastersubjects_by_id($q->param('ms'));
77
78 $tmpl->param('title' => uc($ms->{'mastersubject'}) );
79 $tmpl->param('mastersubject_lc' => lc($ms->{'mastersubject'}) );
80
81 $tmpl->param('InfoTypes' => $self->get_infotypes() );
82
83 $tmpl->param('Subjects' => $self->get_subjects() );
84
85 return $tmpl->output;
86
87 }
88
89 # load template and generate permanent valirables in template
90
91 sub use_template {
92 my $self = shift;
93 my $q = $self->query();
94
95 my $tmpl_file = shift || croak("perm_vars need tempate file");
96 my $tmpl = $self->load_tmpl($tmpl_file, global_vars => 1, die_on_bad_params => 0);
97
98 $tmpl->param('self_url_full', $q->url(-relative=>1,-query=>1));
99 $tmpl->param('self_url', $q->url(-relative=>1));
100
101 foreach my $var (@persistent_vars) {
102 $tmpl->param($var, $q->param($var));
103 }
104
105 return $tmpl;
106 }
107
108 # get data from database
109
110 sub get_mastersubjects {
111 my $self = shift;
112
113 my $q = $self->query();
114
115 my $sql = qq{
116 select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected
117 from mastersubject
118 where mastersubject_id > 2
119 order by mastersubject
120 };
121
122 my $sth = $dbh->prepare($sql);
123 $sth->execute($q->param('ms') || undef);
124
125 return $sth->fetchall_arrayref({});
126 }
127
128 sub get_mastersubjects_by_id {
129 my $self = shift;
130
131 my $id = shift || croak("need mastersubject id");
132
133 my $sql = qq{
134 select mastersubject
135 from mastersubject
136 where mastersubject_id = ?
137 };
138
139 my $sth = $dbh->prepare($sql);
140 $sth->execute($id);
141
142 return $sth->fetchrow_hashref();
143 }
144
145 sub get_infotypes {
146 my $self = shift;
147
148 my $q = $self->query();
149 my @args;
150
151 push @args,$q->param('it') || undef; # for selected
152
153 my $sql = qq{
154 select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected
155 from res_sub_infotype,infotype
156 where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
157 };
158
159 if ($q->param('ms')) {
160 $sql .= qq{
161 and res_sub_infotype.subject_id in
162 (select subject_id from sub_mastersubject where mastersubject_id = ?)
163 };
164 push @args, $q->param('ms');
165 }
166
167 $sql .= qq{
168 order by infotype
169 };
170
171 my $sth = $dbh->prepare($sql);
172 $sth->execute(@args);
173
174 my $arr = $sth->fetchall_arrayref({});
175
176 # find element which is on half of list
177 my $half = int(scalar @$arr / 2) - 1;
178 $arr->[$half]->{half} = 1 if ($half > 0);
179 return $arr;
180 }
181
182 sub get_subjects_letters {
183 my $self = shift;
184
185 my $sql = qq{
186 select distinct substr(subject,1,1) as letter
187 from subject
188 where subject_id > 1
189 order by substr(subject,1,1)
190 };
191
192 my $sth = $dbh->prepare($sql);
193 $sth->execute();
194
195 return $sth->fetchall_arrayref({});
196 }
197
198 sub get_subjects {
199 my $self = shift;
200
201 my $q = $self->query();
202 my @args;
203
204 my $sql = qq{
205 select subject.subject_id,subject.subject,sub_mastersubject.mastersubject_id
206 from subject,sub_mastersubject
207 where subject.subject_id=sub_mastersubject.subject_id
208 and subject.subject_id > 1
209 };
210
211 if ($q->param('s_letter')) {
212 push @args,$q->param('s_letter') . '%';
213 $sql .= qq{
214 and upper(subject.subject) like upper(?)
215 };
216 }
217
218 if ($q->param('ms')) {
219 push @args,$q->param('ms');
220 $sql .= qq{
221 and sub_mastersubject.mastersubject_id = ?
222 };
223 }
224
225 $sql .= qq{
226 order by subject.subject
227 };
228
229 my $sth = $dbh->prepare($sql);
230 $sth->execute(@args);
231
232 return $sth->fetchall_arrayref({});
233 }
234
235 1;

  ViewVC Help
Powered by ViewVC 1.1.26