package WebGUI; our $VERSION = "6.8.0"; our $STATUS = "beta"; #------------------------------------------------------------------- # WebGUI is Copyright 2001-2005 Plain Black Corporation. #------------------------------------------------------------------- # Please read the legal notices (docs/legal.txt) and the license # (docs/license.txt) that came with this distribution before using # this software. #------------------------------------------------------------------- # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- use strict qw(vars subs); use Tie::CPHash; use WebGUI::Affiliate; use WebGUI::Asset; use WebGUI::Cache; use WebGUI::ErrorHandler; use WebGUI::Grouping; use WebGUI::HTTP; use WebGUI::International; use WebGUI::Operation; use WebGUI::Privilege; use WebGUI::Session; use WebGUI::SQL; use WebGUI::Style; use WebGUI::URL; use WebGUI::PassiveProfiling; use Apache2::RequestRec (); use Apache2::RequestIO (); use Apache2::Const -compile => qw(OK DECLINED); #------------------------------------------------------------------- sub handler { my $r = shift; my $s = Apache2::ServerUtil->server; my $config = WebGUI::Config::getConfig($s->dir_config('WebguiRoot'),$r->dir_config('WebguiConfig')); my $extras = $config->{extrasURL}; my $uploads = $config->{uploadsURL}; unless ($r->uri =~ m/^$extras/ || $r->uri =~ m/^$uploads/) { $r->handler('perl-script'); $r->set_handlers(PerlResponseHandler => \&contentHandler);#, PerlTransHandler => \&Apache2::Const::OK); } return Apache2::Const::DECLINED; } #------------------------------------------------------------------- sub contentHandler { my $r = shift; my $s = Apache2::ServerUtil->server; WebGUI::Session::open($s->dir_config('WebguiRoot'),$r->dir_config('WebguiConfig'),$r); $session{wguri} = $r->uri; if ($session{env}{HTTP_X_MOZ} eq "prefetch") { # browser prefetch is a bad thing WebGUI::HTTP::setStatus("403","We don't allow prefetch, because it increases bandwidth, hurts stats, and can break web sites."); $r->print(WebGUI::HTTP::getHeader()); } elsif ($session{setting}{specialState} eq "upgrading") { $r->print(upgrading()); } elsif ($session{setting}{specialState} eq "init") { return $r->print(setup()); } else { my $output = page(); WebGUI::Affiliate::grabReferral(); # process affilliate tracking request if (WebGUI::HTTP::isRedirect()) { $output = WebGUI::HTTP::getHeader(); } else { $output = WebGUI::HTTP::getHeader().$output; if (WebGUI::ErrorHandler::canShowDebug()) { $output .= WebGUI::ErrorHandler::showDebug(); } } $r->print($output); } WebGUI::Session::close(); return Apache2::Const::OK; } #------------------------------------------------------------------- sub page { my $assetUrl = shift; my $output = processOperations(); if ($output eq "") { my $asset = WebGUI::Asset->newByUrl($assetUrl,$session{form}{revision}); if (defined $asset) { $session{asset} = $asset; my $method = "view"; if (exists $session{form}{func}) { $method = $session{form}{func}; unless ($method =~ /^[A-Za-z]+$/) { WebGUI::ErrorHandler::security("tried to call a non-existent method $method on $assetUrl"); $method = "view"; } } $method = "www_".$method; $output = eval{$asset->$method()}; if ($@) { WebGUI::ErrorHandler::warn("Couldn't call method ".$method." on asset for ".$session{wguri}." Root cause: ".$@); $output = $asset->www_view; } else { if ($output eq "" && $method ne "view") { $output = $asset->www_view; } } } else { my $notFound = WebGUI::Asset->getNotFound; $session{asset} = $notFound; $output = $notFound->www_view; } } return $output; } #------------------------------------------------------------------- sub processOperations { my ($cmd, $output); my $op = $session{form}{op}; my $opNumber = shift || 1; if ($op) { $output = WebGUI::Operation::execute($op); } $opNumber++; if ($output eq "" && exists $session{form}{"op".$opNumber}) { my $urlString = WebGUI::URL::unescape($session{form}{"op".$opNumber}); my @pairs = split(/\;/,$urlString); my %form; foreach my $pair (@pairs) { my @param = split(/\=/,$pair); $form{$param[0]} = $param[1]; } $session{form} = \%form; $output = processOperations($opNumber); } return $output; } #------------------------------------------------------------------- sub setup { require WebGUI::Operation::WebGUI; my $output = WebGUI::Operation::WebGUI::www_setup(); return WebGUI::HTTP::getHeader().$output; } #------------------------------------------------------------------- sub upgrading { my $output = WebGUI::HTTP::getHeader(); open(FILE,"<".$session{config}{webguiRoot}."/docs/maintenance.html"); while () { $output .= $_; } close(FILE); return $output; } 1;