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 @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('portal', 'template_html') || die "need template_html in global.conf, section portal";
my $CHARSET = $cfg_global->val('portal', 'charset') || 'ISO-8859-1';
my $dsn = $cfg_global->val('portal', 'dbi_dsn') || die "need dsn in global.conf, section portal";
my ($user,$passwd) = ($cfg_global->val('portal', 'dbi_user'), $cfg_global->val('portal', 'dbi_passwd'));
my $locale = $cfg_global->val('portal', 'locale') || 'C';


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

use POSIX qw(locale_h);
setlocale(LC_CTYPE, $locale);
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	dpavlin	6	my @persistent_vars = qw(p ms s);
15	dpavlin	1
16			# read global.conf configuration
17			my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) \|\| die "can't open 'global.conf'";
18
19			# configuration options from global.conf
20	dpavlin	8	my $TEMPLATE_PATH = $cfg_global->val('portal', 'template_html') \|\| die "need template_html in global.conf, section portal";
21			my $CHARSET = $cfg_global->val('portal', 'charset') \|\| 'ISO-8859-1';
22			my $dsn = $cfg_global->val('portal', 'dbi_dsn') \|\| die "need dsn in global.conf, section portal";
23			my ($user,$passwd) = ($cfg_global->val('portal', 'dbi_user'), $cfg_global->val('portal', 'dbi_passwd'));
24			my $locale = $cfg_global->val('portal', 'locale') \|\| 'C';
25	dpavlin	1
26
27	dpavlin	8	my $dbh = DBI->connect("DBI:".$dsn,$user,$passwd, { RaiseError => 1 });
28
29	dpavlin	1	use POSIX qw(locale_h);
30	dpavlin	8	setlocale(LC_CTYPE, $locale);
31	dpavlin	1	use locale;
32
33			sub setup {
34			my $self = shift;
35			$self->tmpl_path($TEMPLATE_PATH);
36			$self->run_modes(
37			'home' => 'show_home',
38	dpavlin	6	'ms' => 'show_mastersubject',
39			's' => 'show_subject',
40			'r' => 'search_resources',
41	dpavlin	1	);
42			$self->start_mode('home');
43			$self->mode_param('p');
44
45			$self->header_props(-charset=>$CHARSET);
46			}
47
48
49	dpavlin	3	# home page
50	dpavlin	1	sub show_home {
51			my $self = shift;
52
53			# Get the CGI.pm query object
54			my $q = $self->query();
55			# template
56
57			# read master template
58			my $tmpl = $self->use_template('home.html');
59
60			$tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
61			$tmpl->param('InfoTypes' => $self->get_infotypes() );
62
63			$tmpl->param('Subjects_letters' => $self->get_subjects_letters() );
64			$tmpl->param('Subjects' => $self->get_subjects() );
65
66			return $tmpl->output;
67
68			}
69
70	dpavlin	3
71			# MasterSubject
72	dpavlin	6	sub show_mastersubject {
73	dpavlin	1	my $self = shift;
74
75			my $q = $self->query();
76
77			my $tmpl = $self->use_template('ms.html');
78
79			$tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
80
81	dpavlin	6	my $ms = $self->get_mastersubject_by_id($q->param('ms'));
82	dpavlin	1
83			$tmpl->param('title' => uc($ms->{'mastersubject'}) );
84	dpavlin	3	$tmpl->param('search_field' => lc($ms->{'mastersubject'}) );
85	dpavlin	1
86			$tmpl->param('InfoTypes' => $self->get_infotypes() );
87
88			$tmpl->param('Subjects' => $self->get_subjects() );
89
90			return $tmpl->output;
91
92			}
93
94	dpavlin	3
95			# Subject
96	dpavlin	6	sub show_subject {
97	dpavlin	3	my $self = shift;
98
99			my $q = $self->query();
100
101			my $tmpl = $self->use_template('s.html');
102
103			$tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
104
105	dpavlin	6	my $s = $self->get_subject_by_id($q->param('s'));
106	dpavlin	3
107			$tmpl->param('title' => uc($s->{'subject'}) );
108			$tmpl->param('search_field' => lc($s->{'subject'}) );
109
110			$tmpl->param('InfoTypes' => $self->get_infotypes() );
111
112			return $tmpl->output;
113
114			}
115
116
117	dpavlin	6	# search for resources and display results
118			sub search_resources {
119			my $self = shift;
120
121			my $q = $self->query();
122
123			my $tmpl = $self->use_template('r.html');
124
125			$tmpl->param('MasterSubjects' => $self->get_mastersubjects() );
126
127			if ($q->param('s')) {
128			my $s = $self->get_subject_by_id($q->param('s'));
129
130			$tmpl->param('title' => uc($s->{'subject'}) );
131			$tmpl->param('search_field' => lc($s->{'subject'}) );
132			} elsif ($q->param('ms')) {
133			my $s = $self->get_mastersubject_by_id($q->param('ms'));
134
135			$tmpl->param('title' => uc($s->{'mastersubject'}) );
136			$tmpl->param('search_field' => lc($s->{'mastersubject'}) );
137			}
138
139			my $res = $self->get_resources();
140			$tmpl->param('resource_results' => $res);
141			$tmpl->param('nr_results' => scalar @$res);
142
143			$tmpl->param('limit_infotype' => $self->get_infotype_by_id($q->param('it'))->{'infotype'});
144
145			return $tmpl->output;
146
147			}
148
149	dpavlin	3	#
150	dpavlin	1	# load template and generate permanent valirables in template
151	dpavlin	3	#
152	dpavlin	1
153			sub use_template {
154			my $self = shift;
155			my $q = $self->query();
156
157			my $tmpl_file = shift \|\| croak("perm_vars need tempate file");
158			my $tmpl = $self->load_tmpl($tmpl_file, global_vars => 1, die_on_bad_params => 0);
159
160			$tmpl->param('self_url_full', $q->url(-relative=>1,-query=>1));
161			$tmpl->param('self_url', $q->url(-relative=>1));
162
163			foreach my $var (@persistent_vars) {
164			$tmpl->param($var, $q->param($var));
165			}
166
167			return $tmpl;
168			}
169
170	dpavlin	3
171			#
172	dpavlin	1	# get data from database
173	dpavlin	3	#
174	dpavlin	1
175	dpavlin	3	# get all MasterSubjects
176	dpavlin	1	sub get_mastersubjects {
177			my $self = shift;
178
179			my $q = $self->query();
180
181			my $sql = qq{
182			select mastersubject_id,upper(mastersubject) as mastersubject,(mastersubject_id = ?) as selected
183			from mastersubject
184			where mastersubject_id > 2
185			order by mastersubject
186			};
187
188			my $sth = $dbh->prepare($sql);
189			$sth->execute($q->param('ms') \|\| undef);
190
191			return $sth->fetchall_arrayref({});
192			}
193
194	dpavlin	3	# get one MasterSubject by it's ID
195	dpavlin	6	sub get_mastersubject_by_id {
196	dpavlin	1	my $self = shift;
197
198			my $id = shift \|\| croak("need mastersubject id");
199
200			my $sql = qq{
201			select mastersubject
202			from mastersubject
203			where mastersubject_id = ?
204			};
205
206			my $sth = $dbh->prepare($sql);
207			$sth->execute($id);
208
209			return $sth->fetchrow_hashref();
210			}
211
212	dpavlin	3	# get all InfoTypes
213	dpavlin	1	sub get_infotypes {
214			my $self = shift;
215
216			my $q = $self->query();
217			my @args;
218
219			push @args,$q->param('it') \|\| undef; # for selected
220
221			my $sql = qq{
222			select distinct infotype.infotype_id,infotype.infotype, 0 as half, (infotype.infotype_id = ?) as selected
223			from res_sub_infotype,infotype
224			where res_sub_infotype.infotype_id=infotype.infotype_id and infotype.infotype_id > 1
225			};
226
227	dpavlin	3
228			# first check if subject is defined and limit by that, and only if it's not
229			# fallback to mastersubject
230			if ($q->param('s')) {
231	dpavlin	1	$sql .= qq{
232	dpavlin	3	and res_sub_infotype.subject_id = ?
233			};
234			push @args, $q->param('s');
235			} elsif ($q->param('ms')) {
236			$sql .= qq{
237	dpavlin	1	and res_sub_infotype.subject_id in
238			(select subject_id from sub_mastersubject where mastersubject_id = ?)
239			};
240			push @args, $q->param('ms');
241			}
242
243			$sql .= qq{
244			order by infotype
245			};
246
247			my $sth = $dbh->prepare($sql);
248			$sth->execute(@args);
249
250			my $arr = $sth->fetchall_arrayref({});
251
252			# find element which is on half of list
253			my $half = int(scalar @$arr / 2) - 1;
254			$arr->[$half]->{half} = 1 if ($half > 0);
255			return $arr;
256			}
257
258	dpavlin	3	# get first letters for all Subjects
259	dpavlin	1	sub get_subjects_letters {
260			my $self = shift;
261
262			my $sql = qq{
263			select distinct substr(subject,1,1) as letter
264			from subject
265			where subject_id > 1
266			order by substr(subject,1,1)
267			};
268
269			my $sth = $dbh->prepare($sql);
270			$sth->execute();
271
272			return $sth->fetchall_arrayref({});
273			}
274
275	dpavlin	3	# get all Subjects
276	dpavlin	1	sub get_subjects {
277			my $self = shift;
278
279			my $q = $self->query();
280			my @args;
281
282			my $sql = qq{
283			select subject.subject_id,subject.subject,sub_mastersubject.mastersubject_id
284			from subject,sub_mastersubject
285			where subject.subject_id=sub_mastersubject.subject_id
286			and subject.subject_id > 1
287			};
288
289			if ($q->param('s_letter')) {
290			push @args,$q->param('s_letter') . '%';
291			$sql .= qq{
292			and upper(subject.subject) like upper(?)
293			};
294			}
295
296			if ($q->param('ms')) {
297			push @args,$q->param('ms');
298			$sql .= qq{
299			and sub_mastersubject.mastersubject_id = ?
300			};
301			}
302
303			$sql .= qq{
304			order by subject.subject
305			};
306
307			my $sth = $dbh->prepare($sql);
308			$sth->execute(@args);
309
310			return $sth->fetchall_arrayref({});
311			}
312
313	dpavlin	3	# get one Subject by it's ID
314	dpavlin	6	sub get_subject_by_id {
315	dpavlin	3	my $self = shift;
316
317			my $id = shift \|\| croak("need subject id");
318
319			my $sql = qq{
320			select subject
321			from subject
322			where subject_id = ?
323			};
324
325			my $sth = $dbh->prepare($sql);
326			$sth->execute($id);
327
328			return $sth->fetchrow_hashref();
329			}
330
331	dpavlin	6	# get one InfoType by it's ID
332			sub get_infotype_by_id {
333			my $self = shift;
334
335			my $id = shift \|\| croak("need infotype id");
336
337			my $sql = qq{
338			select infotype
339			from infotype
340			where infotype_id = ?
341			};
342
343			my $sth = $dbh->prepare($sql);
344			$sth->execute($id);
345
346			return $sth->fetchrow_hashref();
347			}
348
349			# get add resources for given criteria
350			sub get_resources {
351			my $self = shift;
352
353			my $q = $self->query();
354			my @args;
355
356			my $sql = qq{
357			select distinct resource.resource_id, title, infotype.infotype, coverage_detail, url
358			};
359
360			my $sql_from = qq{
361			from resource,infotype
362			};
363
364			my $sql_where = qq{
365			where resource.infotype_id=infotype.infotype_id
366			};
367
368			# limits
369			if ($q->param('s')) {
370			$sql_from .= qq{ , res_sub_infotype };
371			$sql_where .= qq{
372			and res_sub_infotype.resource_id = resource.resource_id
373			and res_sub_infotype.subject_id = ?
374			};
375			push @args, $q->param('s');
376			} elsif ($q->param('ms')) {
377			$sql_from .= qq{ , res_sub_infotype };
378			$sql_where .= qq{
379			and res_sub_infotype.resource_id = resource.resource_id
380			and res_sub_infotype.subject_id in
381			(select subject_id from sub_mastersubject where mastersubject_id = ?)
382			};
383			push @args, $q->param('ms');
384			}
385			if ($q->param('it')) {
386			if ($sql_from !~ m/res_sub_infotype/) {
387			$sql_from .= qq{ , res_sub_infotype };
388			$sql_where .= qq{ and res_sub_infotype.resource_id = resource.resource_id };
389			}
390			$sql_where .= qq{ and res_sub_infotype.infotype_id = ? };
391			push @args, $q->param('it');
392			}
393
394			my $sth = $dbh->prepare($sql.$sql_from.$sql_where);
395			$sth->execute(@args);
396
397			my $arr = $sth->fetchall_arrayref({});
398
399			# now fill-in features
400			$sql = qq{
401			select feature
402			from res_feature,feature
403			where res_feature.feature_id = feature.feature_id and res_feature.resource_id = ?
404			};
405			$sth = $dbh->prepare($sql);
406
407			foreach my $i ( 0 .. (scalar @$arr)-1 ) {
408			$sth->execute($arr->[$i]->{'resource_id'});
409			$arr->[$i]->{'res_features'} = $sth->fetchall_arrayref({});
410			}
411
412			return $arr;
413			}
414	dpavlin	1	1;