ND.pm

   1 #!/usr/bin/perl -w -T
   2 #**************************************************************************
   3 #   Copyright (C) 2006 by Michael Andreen <harvATruinDOTnu>               *
   4 #                                                                         *
   5 #   This program is free software; you can redistribute it and/or modify  *
   6 #   it under the terms of the GNU General Public License as published by  *
   7 #   the Free Software Foundation; either version 2 of the License, or     *
   8 #   (at your option) any later version.                                   *
   9 #                                                                         *
  10 #   This program is distributed in the hope that it will be useful,       *
  11 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  12 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  13 #   GNU General Public License for more details.                          *
  14 #                                                                         *
  15 #   You should have received a copy of the GNU General Public License     *
  16 #   along with this program; if not, write to the                         *
  17 #   Free Software Foundation, Inc.,                                       *
  18 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  19 #**************************************************************************/
  20
  21 package ND;
  22 use CGI qw/:standard/;
  23 use DBI;
  24 use DBD::Pg qw(:pg_types);
  25 use Apache2::Request;
  26 use Apache2::Response;
  27 use Apache2::RequestUtil;
  28 use ND::DB;
  29 use NDWeb::Page;
  30 use strict;
  31 use warnings;
  32
  33 $SIG{__WARN__} = sub {$ND::ERROR .= p $_[0]};
  34
  35 chdir '/var/www/ndawn';
  36
  37 sub handler {
  38         my $r = shift;
  39         my $req = Apache2::Request->new($r, POST_MAX => "1M");
  40         local $ND::DBH = ND::DB::DB();
  41         local $ND::UID;
  42         local $ND::ERROR;
  43         my $page = $req->param('page');
  44         $r->no_cache;
  45
  46         if ($ENV{'SCRIPT_NAME'} =~ /(\w+)(\.(pl|php|pm))?$/){
  47                 $page = $1 unless $1 eq 'index' and $3 eq 'pl';
  48         }
  49         $page = NDWeb::Page->new(PAGE => $page, DBH => $ND::DBH, URI => $ENV{REQUEST_URI}, USER_AGENT => $ENV{HTTP_USER_AGENT}, HTTP_ACCEPT => $ENV{HTTP_ACCEPT}, R => $r);
  50         $page->render;
  51
  52         $ND::DBH->rollback unless $ND::DBH->{AutoCommit};
  53         $ND::DBH->disconnect;
  54
  55         if ($page->{RETURN}){
  56                 if($page->{RETURN} eq 'REDIRECT'){
  57                         $r->headers_out->set(Location => $page->{REDIR_LOCATION});
  58                         $r->status(Apache2::Const::REDIRECT);
  59                         $r->rflush;
  60                 }
  61         }
  62         return Apache2::Const::OK;
  63 }
  64
  65 1;