Added a simple flag in ccbs.pm to make the system suitable for public viewing (ie...
[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 # Set this flag to disable any admin tasks -- it's quite crude, but hey :-)
12 our $ccbs_noadmin = 0;
13         
14 sub print_header {
15         print CGI::header(-type=>'text/html; charset=utf-8');
16 }
17 sub print_see_other {
18         my $location = shift;
19
20         print CGI::header(-status=>'303 See other',
21                           -location=>'http://ccbs.sesse.net/' . $location,
22                           -type=>'text/html; charset=utf-8');
23 }
24
25 sub db_connect {
26         $ccbs_dbdebug = defined(shift) ? 1 : 0;
27
28         my $dbh = DBI->connect("dbi:Pg:dbname=ccbs;host=altersex.samfundet.no", "ccbs", "GeT|>>B_")
29                 or die "Couldn't connect to database";
30         $dbh->{RaiseError} = 1;
31         return $dbh;
32 }
33
34 sub db_fetch_all {
35         my ($dbh, $sql, @parms) = @_;
36         my $q = $dbh->prepare($sql)
37                 or die "Could not prepare query: " . $dbh->errstr;
38         $q->execute(@parms)
39                 or die "Could not execute query: " . $dbh->errstr;
40
41         if ($ccbs_dbdebug) {
42                 warn $sql;
43                 warn "params=" . join(', ', @parms);
44         }
45         
46         my @ret = ();
47         while (my $ref = $q->fetchrow_hashref()) {
48                 if ($ccbs_dbdebug) {
49                         my $dbstr = "";
50                         for my $k (sort keys %$ref) {
51                                 $dbstr .= " " . $k . "=" . $ref->{$k};
52                         }
53                         warn $dbstr;
54                 }
55                 push @ret, $ref;
56         }
57
58         $q->finish;
59         return \@ret;
60 }
61         
62 sub process_template {
63         my ($page, $title, $vars) = @_;
64         $vars->{'page'} = $page;
65         $vars->{'title'} = $title;
66         $vars->{'public'} = $ccbs_noadmin;
67         
68         my $config = {
69                 INCLUDE_PATH => 'templates/',
70                 INTERPOLATE  => 1,
71                 POST_CHOMP   => 1,
72                 EVAL_PERL    => 1,
73         };
74         my $template = Template->new($config);
75
76         my $output = '';
77         $template->process('main.tmpl', $vars, \$output)
78                 or die $template->error();
79
80         print $output;
81 }
82
83 sub user_error {
84         my $msg = shift;
85
86         ccbs::print_header();
87         ccbs::process_template('user-error.tmpl', 'Feil',
88                 { message => $msg });
89
90         exit;
91 }
92 sub admin_only {
93         user_error("Beklager, databasen står i no-admin-mode.") if ($ccbs_noadmin);
94 }
95
96 $SIG{__DIE__} = sub {
97         # Gosh! Net::Resolver::DNS is brain-damaged.
98         my $msg = shift;
99         return if $msg =~ m#Win32/Registry.pm#;
100
101         ccbs::print_header();
102         ccbs::process_template('error.tmpl', 'Internal Server Error',
103                 { message => HTML::Entities::encode_entities($msg) });
104 };
105
106 1;