libdata-portal/trunk/Portal.pm

package Portal;

use base 'CGI::Application';
use strict;

use Config::IniFiles;
use DBI;
use Carp;

use Data::Dumper;

use lib '..';

my $dsn = 'Pg:dbname=libdata';
my ($user,$passwd) = ('dpavlin','');

my @persistent_vars = qw(p ms s);

# read global.conf configuration
my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";

# configuration options from global.conf
my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') || die "need template_html in global.conf, section webpac";
my $CHARSET = $cfg_global->val('webpac', 'charset') || 'ISO-8859-1';

my $dbh = DBI->connect("DBI:$dsn",$user,$passwd, { RaiseError => 1 });

use POSIX qw(locale_h);
setlocale(LC_CTYPE, "hr_HR");
use locale;

sub setup {
        my $self = shift;
        $self->tmpl_path($TEMPLATE_PATH);
        $self->run_modes(
                'home' => 'show_home',
                'ms' => 'show_mastersubject',
                's' => 'show_subject',
                'r' => 'search_resources',
        );
        $self->start_mode('home');
        $self->mode_param('p');

        $self->header_props(-charset=>$CHARSET);
}


# home page
sub show_home {
        my $self = shift;

        # Get the CGI.pm query object
        my $q = $self->query();
        # template

        # read master template
        my $tmpl = $self->use_template('home.html');

        $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
        $tmpl->param('InfoTypes' => $self->get_infotypes() );

        $tmpl->param('Subjects_letters' => $self->get_subjects_letters() );
        $tmpl->param('Subjects' => $self->get_subjects() );

        return $tmpl->output;

}


# MasterSubject
sub show_mastersubject {
        my $self = shift;

        my $q = $self->query();

        my $tmpl = $self->use_template('ms.html');

        $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );

        my $ms = $self->get_mastersubject_by_id($q->param('ms'));

        $tmpl->param('title' => uc($ms->{'mastersubject'}) );
        $tmpl->param('search_field' => lc($ms->{'mastersubject'}) );

        $tmpl->param('InfoTypes' => $self->get_infotypes() );

        $tmpl->param('Subjects' => $self->get_subjects() );

        return $tmpl->output;

}


# Subject
sub show_subject {
        my $self = shift;

        my $q = $self->query();

        my $tmpl = $self->use_template('s.html');

        $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );

        my $s = $self->get_subject_by_id($q->param('s'));

        $tmpl->param('title' => uc($s->{'subject'}) );
        $tmpl->param('search_field' => lc($s->{'subject'}) );

        $tmpl->param('InfoTypes' => $self->get_infotypes() );

        return $tmpl->output;

}


# search for resources and display results
sub search_resources {
        my $self = shift;

        my $q = $self->query();

        my $tmpl = $self->use_template('r.html');

        $tmpl->param('MasterSubjects' => $self->get_mastersubjects() );

        if ($q->param('s')) {
                my $s = $self->get_subject_by_id($q->param('s'));

                $tmpl->param('title' => uc($s->{'subject'}) );
                $tmpl->param('search_field' => lc($s->{'subject'}) );
        } elsif ($q->param('ms')) {
                my $s = $self->get_mastersubject_by_id($q->param('ms'));

                $tmpl->param('title' => uc($s->{'mastersubject'}) );
                $tmpl->param('search_field' => lc($s->{'mastersubject'}) );
        }

        my $res = $self->get_resources();
        $tmpl->param('resource_results' => $res);
        $tmpl->param('nr_results' => scalar @$res);

        $tmpl->param('limit_infotype' => $self->get_infotype_by_id($q->param('it'))->{'infotype'});

        return $tmpl->output;

}

#
# load template and generate permanent valirables in template
#

sub use_template {
        my $self = shift;
        my $q = $self->query();
        
        my $tmpl_file = shift || croak("perm_vars need tempate file");
        my $tmpl = $self->load_tmpl($tmpl_file, global_vars => 1, die_on_bad_params => 0);

        $tmpl->param('self_url_full', $q->url(-relative=>1,-query=>1));
        $tmpl->param('self_url', $q->url(-relative=>1));

        foreach my $var (@persistent_vars) {
                $tmpl->param($var, $q->param($var));
        }

        return $tmpl;
}


#
# get data from database
#

# get all MasterSubjects
sub get_mastersubjects {
        my $self = shift;

        my $q = $self->query();

        my $sql = qq{
        select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected
                from mastersubject
                where mastersubject_id > 2
                order by mastersubject
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute($q->param('ms') || undef);

        return $sth->fetchall_arrayref({});
}

# get one MasterSubject by it's ID
sub get_mastersubject_by_id {
        my $self = shift;

        my $id = shift || croak("need mastersubject id");

        my $sql = qq{
        select mastersubject
                from mastersubject
                where mastersubject_id = ?
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute($id);

        return $sth->fetchrow_hashref();
}

# get all InfoTypes
sub get_infotypes {
        my $self = shift;

        my $q = $self->query();
        my @args;
        
        push @args,$q->param('it') || undef;    # for selected
        
        my $sql = qq{
                select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected
                from res_sub_infotype,infotype
                where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
        };


        # first check if subject is defined and limit by that, and only if it's not
        # fallback to mastersubject
        if ($q->param('s')) {
                $sql .= qq{
                        and res_sub_infotype.subject_id = ?
                };
                push @args, $q->param('s');
        } elsif ($q->param('ms')) {
                $sql .= qq{
                        and res_sub_infotype.subject_id in
                                (select subject_id from sub_mastersubject where mastersubject_id = ?)
                };
                push @args, $q->param('ms');
        }

        $sql .= qq{
                order by infotype
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute(@args);

        my $arr = $sth->fetchall_arrayref({});

        # find element which is on half of list
        my $half = int(scalar @$arr / 2) - 1;
        $arr->[$half]->{half} = 1 if ($half > 0);
        return $arr;
}

# get first letters for all Subjects
sub get_subjects_letters {
        my $self = shift;

        my $sql = qq{
        select distinct substr(subject,1,1) as letter
                from subject
                where subject_id > 1
                order by substr(subject,1,1)
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute();

        return $sth->fetchall_arrayref({});
}

# get all Subjects
sub get_subjects {
        my $self = shift;

        my $q = $self->query();
        my @args;

        my $sql = qq{
        select subject.subject_id,subject.subject,sub_mastersubject.mastersubject_id
                from subject,sub_mastersubject
                where subject.subject_id=sub_mastersubject.subject_id
                        and subject.subject_id > 1
        };

        if ($q->param('s_letter')) {
                push @args,$q->param('s_letter') . '%';
                $sql .= qq{
                        and upper(subject.subject) like upper(?)
                };
        }

        if ($q->param('ms')) {
                push @args,$q->param('ms');
                $sql .= qq{
                        and sub_mastersubject.mastersubject_id = ?
                };
        }

        $sql .= qq{
                order by subject.subject
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute(@args);

        return $sth->fetchall_arrayref({});
}

# get one Subject by it's ID
sub get_subject_by_id {
        my $self = shift;

        my $id = shift || croak("need subject id");

        my $sql = qq{
        select subject
                from subject
                where subject_id = ?
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute($id);

        return $sth->fetchrow_hashref();
}

# get one InfoType by it's ID
sub get_infotype_by_id {
        my $self = shift;

        my $id = shift || croak("need infotype id");

        my $sql = qq{
        select infotype
                from infotype
                where infotype_id = ?
        };

        my $sth = $dbh->prepare($sql);
        $sth->execute($id);

        return $sth->fetchrow_hashref();
}

# get add resources for given criteria
sub get_resources {
        my $self = shift;

        my $q = $self->query();
        my @args;

        my $sql = qq{
                select distinct resource.resource_id, title, infotype.infotype, coverage_detail, url
        };

        my $sql_from = qq{
                        from resource,infotype
        };

        my $sql_where = qq{
                        where resource.infotype_id=infotype.infotype_id
        };

        # limits
        if ($q->param('s')) {
                $sql_from .= qq{ , res_sub_infotype };
                $sql_where .= qq{
                        and res_sub_infotype.resource_id = resource.resource_id
                        and res_sub_infotype.subject_id = ?
                };
                push @args, $q->param('s');
        } elsif ($q->param('ms')) {
                $sql_from .= qq{ , res_sub_infotype };
                $sql_where .= qq{
                        and res_sub_infotype.resource_id = resource.resource_id
                        and res_sub_infotype.subject_id in
                                (select subject_id from sub_mastersubject where mastersubject_id = ?)
                };
                push @args, $q->param('ms');
        }
        if ($q->param('it')) {
                if ($sql_from !~ m/res_sub_infotype/) {
                        $sql_from .= qq{ , res_sub_infotype };
                        $sql_where .= qq{ and res_sub_infotype.resource_id = resource.resource_id };
                }
                $sql_where .= qq{ and res_sub_infotype.infotype_id = ? };
                push @args, $q->param('it');
        }

        my $sth = $dbh->prepare($sql.$sql_from.$sql_where);
        $sth->execute(@args);

        my $arr = $sth->fetchall_arrayref({});

        # now fill-in features
        $sql = qq{
                select feature
                        from res_feature,feature
                        where res_feature.feature_id = feature.feature_id and res_feature.resource_id = ?
        };
        $sth = $dbh->prepare($sql);

        foreach my $i ( 0 .. (scalar @$arr)-1 ) {
                $sth->execute($arr->[$i]->{'resource_id'});
                $arr->[$i]->{'res_features'} = $sth->fetchall_arrayref({});
        }

        return $arr;
}
1;
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	6	my @persistent_vars = qw(p ms s);
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	dpavlin	6	'ms' => 'show_mastersubject',
38			's' => 'show_subject',
39			'r' => 'search_resources',
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	6	sub show_mastersubject {
72	dpavlin	1	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	dpavlin	6	my $ms = $self->get_mastersubject_by_id($q->param('ms'));
81	dpavlin	1
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	dpavlin	6	sub show_subject {
96	dpavlin	3	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	dpavlin	6	my $s = $self->get_subject_by_id($q->param('s'));
105	dpavlin	3
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	dpavlin	6	# search for resources and display results
117			sub search_resources {
118			my $self = shift;
119
120			my $q = $self->query();
121
122			my $tmpl = $self->use_template('r.html');
123
124			$tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
125
126			if ($q->param('s')) {
127			my $s = $self->get_subject_by_id($q->param('s'));
128
129			$tmpl->param('title' => uc($s->{'subject'}) );
130			$tmpl->param('search_field' => lc($s->{'subject'}) );
131			} elsif ($q->param('ms')) {
132			my $s = $self->get_mastersubject_by_id($q->param('ms'));
133
134			$tmpl->param('title' => uc($s->{'mastersubject'}) );
135			$tmpl->param('search_field' => lc($s->{'mastersubject'}) );
136			}
137
138			my $res = $self->get_resources();
139			$tmpl->param('resource_results' => $res);
140			$tmpl->param('nr_results' => scalar @$res);
141
142			$tmpl->param('limit_infotype' => $self->get_infotype_by_id($q->param('it'))->{'infotype'});
143
144			return $tmpl->output;
145
146			}
147
148	dpavlin	3	#
149	dpavlin	1	# load template and generate permanent valirables in template
150	dpavlin	3	#
151	dpavlin	1
152			sub use_template {
153			my $self = shift;
154			my $q = $self->query();
155
156			my $tmpl_file = shift \|\| croak("perm_vars need tempate file");
157			my $tmpl = $self->load_tmpl($tmpl_file, global_vars => 1, die_on_bad_params => 0);
158
159			$tmpl->param('self_url_full', $q->url(-relative=>1,-query=>1));
160			$tmpl->param('self_url', $q->url(-relative=>1));
161
162			foreach my $var (@persistent_vars) {
163			$tmpl->param($var, $q->param($var));
164			}
165
166			return $tmpl;
167			}
168
169	dpavlin	3
170			#
171	dpavlin	1	# get data from database
172	dpavlin	3	#
173	dpavlin	1
174	dpavlin	3	# get all MasterSubjects
175	dpavlin	1	sub get_mastersubjects {
176			my $self = shift;
177
178			my $q = $self->query();
179
180			my $sql = qq{
181			select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected
182			from mastersubject
183			where mastersubject_id > 2
184			order by mastersubject
185			};
186
187			my $sth = $dbh->prepare($sql);
188			$sth->execute($q->param('ms') \|\| undef);
189
190			return $sth->fetchall_arrayref({});
191			}
192
193	dpavlin	3	# get one MasterSubject by it's ID
194	dpavlin	6	sub get_mastersubject_by_id {
195	dpavlin	1	my $self = shift;
196
197			my $id = shift \|\| croak("need mastersubject id");
198
199			my $sql = qq{
200			select mastersubject
201			from mastersubject
202			where mastersubject_id = ?
203			};
204
205			my $sth = $dbh->prepare($sql);
206			$sth->execute($id);
207
208			return $sth->fetchrow_hashref();
209			}
210
211	dpavlin	3	# get all InfoTypes
212	dpavlin	1	sub get_infotypes {
213			my $self = shift;
214
215			my $q = $self->query();
216			my @args;
217
218			push @args,$q->param('it') \|\| undef; # for selected
219
220			my $sql = qq{
221			select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected
222			from res_sub_infotype,infotype
223			where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
224			};
225
226	dpavlin	3
227			# first check if subject is defined and limit by that, and only if it's not
228			# fallback to mastersubject
229			if ($q->param('s')) {
230	dpavlin	1	$sql .= qq{
231	dpavlin	3	and res_sub_infotype.subject_id = ?
232			};
233			push @args, $q->param('s');
234			} elsif ($q->param('ms')) {
235			$sql .= qq{
236	dpavlin	1	and res_sub_infotype.subject_id in
237			(select subject_id from sub_mastersubject where mastersubject_id = ?)
238			};
239			push @args, $q->param('ms');
240			}
241
242			$sql .= qq{
243			order by infotype
244			};
245
246			my $sth = $dbh->prepare($sql);
247			$sth->execute(@args);
248
249			my $arr = $sth->fetchall_arrayref({});
250
251			# find element which is on half of list
252			my $half = int(scalar @$arr / 2) - 1;
253			$arr->[$half]->{half} = 1 if ($half > 0);
254			return $arr;
255			}
256
257	dpavlin	3	# get first letters for all Subjects
258	dpavlin	1	sub get_subjects_letters {
259			my $self = shift;
260
261			my $sql = qq{
262			select distinct substr(subject,1,1) as letter
263			from subject
264			where subject_id > 1
265			order by substr(subject,1,1)
266			};
267
268			my $sth = $dbh->prepare($sql);
269			$sth->execute();
270
271			return $sth->fetchall_arrayref({});
272			}
273
274	dpavlin	3	# get all Subjects
275	dpavlin	1	sub get_subjects {
276			my $self = shift;
277
278			my $q = $self->query();
279			my @args;
280
281			my $sql = qq{
282			select subject.subject_id,subject.subject,sub_mastersubject.mastersubject_id
283			from subject,sub_mastersubject
284			where subject.subject_id=sub_mastersubject.subject_id
285			and subject.subject_id > 1
286			};
287
288			if ($q->param('s_letter')) {
289			push @args,$q->param('s_letter') . '%';
290			$sql .= qq{
291			and upper(subject.subject) like upper(?)
292			};
293			}
294
295			if ($q->param('ms')) {
296			push @args,$q->param('ms');
297			$sql .= qq{
298			and sub_mastersubject.mastersubject_id = ?
299			};
300			}
301
302			$sql .= qq{
303			order by subject.subject
304			};
305
306			my $sth = $dbh->prepare($sql);
307			$sth->execute(@args);
308
309			return $sth->fetchall_arrayref({});
310			}
311
312	dpavlin	3	# get one Subject by it's ID
313	dpavlin	6	sub get_subject_by_id {
314	dpavlin	3	my $self = shift;
315
316			my $id = shift \|\| croak("need subject id");
317
318			my $sql = qq{
319			select subject
320			from subject
321			where subject_id = ?
322			};
323
324			my $sth = $dbh->prepare($sql);
325			$sth->execute($id);
326
327			return $sth->fetchrow_hashref();
328			}
329
330	dpavlin	6	# get one InfoType by it's ID
331			sub get_infotype_by_id {
332			my $self = shift;
333
334			my $id = shift \|\| croak("need infotype id");
335
336			my $sql = qq{
337			select infotype
338			from infotype
339			where infotype_id = ?
340			};
341
342			my $sth = $dbh->prepare($sql);
343			$sth->execute($id);
344
345			return $sth->fetchrow_hashref();
346			}
347
348			# get add resources for given criteria
349			sub get_resources {
350			my $self = shift;
351
352			my $q = $self->query();
353			my @args;
354
355			my $sql = qq{
356			select distinct resource.resource_id, title, infotype.infotype, coverage_detail, url
357			};
358
359			my $sql_from = qq{
360			from resource,infotype
361			};
362
363			my $sql_where = qq{
364			where resource.infotype_id=infotype.infotype_id
365			};
366
367			# limits
368			if ($q->param('s')) {
369			$sql_from .= qq{ , res_sub_infotype };
370			$sql_where .= qq{
371			and res_sub_infotype.resource_id = resource.resource_id
372			and res_sub_infotype.subject_id = ?
373			};
374			push @args, $q->param('s');
375			} elsif ($q->param('ms')) {
376			$sql_from .= qq{ , res_sub_infotype };
377			$sql_where .= qq{
378			and res_sub_infotype.resource_id = resource.resource_id
379			and res_sub_infotype.subject_id in
380			(select subject_id from sub_mastersubject where mastersubject_id = ?)
381			};
382			push @args, $q->param('ms');
383			}
384			if ($q->param('it')) {
385			if ($sql_from !~ m/res_sub_infotype/) {
386			$sql_from .= qq{ , res_sub_infotype };
387			$sql_where .= qq{ and res_sub_infotype.resource_id = resource.resource_id };
388			}
389			$sql_where .= qq{ and res_sub_infotype.infotype_id = ? };
390			push @args, $q->param('it');
391			}
392
393			my $sth = $dbh->prepare($sql.$sql_from.$sql_where);
394			$sth->execute(@args);
395
396			my $arr = $sth->fetchall_arrayref({});
397
398			# now fill-in features
399			$sql = qq{
400			select feature
401			from res_feature,feature
402			where res_feature.feature_id = feature.feature_id and res_feature.resource_id = ?
403			};
404			$sth = $dbh->prepare($sql);
405
406			foreach my $i ( 0 .. (scalar @$arr)-1 ) {
407			$sth->execute($arr->[$i]->{'resource_id'});
408			$arr->[$i]->{'res_features'} = $sth->fetchall_arrayref({});
409			}
410
411			return $arr;
412			}
413	dpavlin	1	1;