git.sesse.net Git - ccbs/blob - 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;