21a19a80216fd4a5246d5975db7ccacdf292961b
[ccbs] / html / ccbs.pm
1 package ccbs;
2 use Template;
3 use CGI;
4 use DBI;
5 use HTML::Entities;
6 use strict;
7 use warnings;
8
9 our $ccbs_dbdebug = 0;
10         
11 sub print_header {
12         print CGI::header(-type=>'text/html; charset=utf-8');
13 }
14 sub print_see_other {
15         my $location = shift;
16
17         print CGI::header(-status=>'303 See other',
18                           -location=>'http://ccbs.sesse.net/' . $location,
19                           -type=>'text/html; charset=utf-8');
20 }
21
22 sub db_connect {
23         $ccbs_dbdebug = defined(shift) ? 1 : 0;
24
25         my $dbh = DBI->connect("dbi:Pg:dbname=ccbs;host=altersex.samfundet.no", "ccbs", "GeT|>>B_")
26                 or die "Couldn't connect to database";
27         $dbh->{RaiseError} = 1;
28         return $dbh;
29 }
30
31 sub db_fetch_all {
32         my ($dbh, $sql, @parms) = @_;
33         my $q = $dbh->prepare($sql)
34                 or die "Could not prepare query: " . $dbh->errstr;
35         $q->execute(@parms)
36                 or die "Could not execute query: " . $dbh->errstr;
37
38         if ($ccbs_dbdebug) {
39                 warn $sql;
40                 warn "params=" . join(', ', @parms);
41         }
42         
43         my @ret = ();
44         while (my $ref = $q->fetchrow_hashref()) {
45                 if ($ccbs_dbdebug) {
46                         my $dbstr = "";
47                         for my $k (sort keys %$ref) {
48                                 $dbstr .= " " . $k . "=" . $ref->{$k};
49                         }
50                         warn $dbstr;
51                 }
52                 push @ret, $ref;
53         }
54
55         $q->finish;
56         return \@ret;
57 }
58         
59 sub process_template {
60         my ($page, $title, $vars) = @_;
61         $vars->{'page'} = $page;
62         $vars->{'title'} = $title;
63         
64         my $config = {
65                 INCLUDE_PATH => 'templates/',
66                 INTERPOLATE  => 1,
67                 POST_CHOMP   => 1,
68                 EVAL_PERL    => 1,
69         };
70         my $template = Template->new($config);
71
72         my $output = '';
73         $template->process('main.tmpl', $vars, \$output)
74                 or die $template->error();
75
76         print $output;
77 }
78
79 sub user_error {
80         my $msg = shift;
81
82         ccbs::print_header();
83         ccbs::process_template('user-error.tmpl', 'Feil',
84                 { message => $msg });
85
86         exit;
87 }
88
89 $SIG{__DIE__} = sub {
90         # Gosh! Net::Resolver::DNS is brain-damaged.
91         my $msg = shift;
92         return if $msg =~ m#Win32/Registry.pm#;
93
94         ccbs::print_header();
95         ccbs::process_template('error.tmpl', 'Internal Server Error',
96                 { message => HTML::Entities::encode_entities($msg) });
97 };
98
99 1;