Shape text using Pango and HarfBuzz; gives us nice ligatures and exotic scripts.
[ccbs] / html / ccbs.pm
1 package ccbs;
2 use Template;
3 use CGI;
4 use CGI::Cookie;
5 use DBI;
6 use HTML::Entities;
7 use Time::HiRes;
8 use Locale::gettext;
9 use POSIX;
10 use strict;
11 use warnings;
12 require '../intl/Sesse::GettextizeTemplates.pm';
13
14 require '../config.pm';
15 -r '../config.local.pm' and require '../config.local.pm';
16
17 # Check for language settings
18 my %cookies = fetch CGI::Cookie;
19 my $lang = defined($cookies{'language'}) ? $cookies{'language'}->value : undef;
20 if (defined($lang) && ($lang eq 'nb_NO' || $lang eq 'nn_NO' || $lang eq 'en_US')) {
21         POSIX::setlocale( &POSIX::LC_CTYPE , $lang . ".UTF-8" );
22         POSIX::setlocale( &POSIX::LC_MESSAGES , $lang . ".UTF-8" );
23 } else {
24         POSIX::setlocale( &POSIX::LC_CTYPE , $ccbs::config::lang );
25         POSIX::setlocale( &POSIX::LC_MESSAGES , $ccbs::config::lang );
26 }
27 Locale::gettext::bindtextdomain("ccbs", "po");
28 Locale::gettext::textdomain("ccbs");
29
30 our $start_time;
31
32 BEGIN {
33         $start_time = [Time::HiRes::gettimeofday()];
34 }
35
36 # Hack to get the non-templatized gettext stuff working
37 *_ = sub {
38         return Locale::gettext::gettext(@_);
39 };
40
41 sub print_header {
42         print CGI::header(-type=>'text/html; charset=utf-8');
43 }
44 sub print_see_other {
45         my $location = shift;
46
47         print CGI::header(-status=>'303 See other',
48                           -location=>$ccbs::config::webroot . $location,
49                           -type=>'text/html; charset=utf-8');
50 }
51
52 sub db_connect {
53         my $dbh = DBI->connect("dbi:Pg:dbname=$ccbs::config::dbname;host=$ccbs::config::dbhost", $ccbs::config::dbuser, $ccbs::config::dbpass)
54                 or die "Couldn't connect to database";
55         $dbh->{RaiseError} = 1;
56         return $dbh;
57 }
58
59 sub db_fetch_all {
60         my ($dbh, $sql, @parms) = @_;
61         my $q = $dbh->prepare($sql)
62                 or die "Could not prepare query: " . $dbh->errstr;
63         $q->execute(@parms)
64                 or die "Could not execute query: " . $dbh->errstr;
65
66         if ($config::ccbs::dbdebug) {
67                 warn $sql;
68                 warn "params=" . join(', ', @parms);
69         }
70         
71         my @ret = ();
72         while (my $ref = $q->fetchrow_hashref()) {
73                 if ($config::ccbs::dbdebug) {
74                         my $dbstr = "";
75                         for my $k (sort keys %$ref) {
76                                 $dbstr .= " " . $k . "=" . $ref->{$k};
77                         }
78                         warn $dbstr;
79                 }
80                 push @ret, $ref;
81         }
82
83         $q->finish;
84         return \@ret;
85 }
86         
87 sub process_template {
88         my ($page, $title, $vars) = @_;
89         $vars->{'page'} = $page;
90         $vars->{'title'} = $title;
91         $vars->{'public'} = $ccbs::config::noadmin;
92         $vars->{'timetogenerate'} = sprintf "%.3f", Time::HiRes::tv_interval($start_time);
93         
94         my $config = {
95                 INCLUDE_PATH => 'templates/',
96                 INTERPOLATE  => 1,
97                 POST_CHOMP   => 1,
98                 EVAL_PERL    => 1,
99                 FACTORY      => 'Sesse::GettextizeTemplates'
100         };
101         my $template = Template->new($config);
102
103         my $output = '';
104         $template->process($ccbs::config::main_template, $vars, \$output)
105                 or die $template->error();
106
107         print $output;
108 }
109
110 sub user_error {
111         my $msg = shift;
112
113         ccbs::print_header();
114         ccbs::process_template('user-error.tmpl', _('Error'),
115                 { message => $msg });
116
117         exit;
118 }
119 sub admin_only {
120         user_error(_("Sorry, the database is in no-admin-mode.")) if ($config::ccbs::noadmin);
121 }
122
123 $SIG{__DIE__} = sub {
124         # Gosh! Net::Resolver::DNS is brain-damaged.
125         my $msg = shift;
126         return if $msg =~ m#Win32/Registry.pm#;
127
128         ccbs::print_header();
129         ccbs::process_template('error.tmpl', _('Internal Server Error'),
130                 { message => HTML::Entities::encode_entities($msg) });
131 };
132
133 1;