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

1 dpavlin 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