#!/usr/bin/perl ## fora - CGI interface for fora event tracking and process manipulation tool #Copyright Massachusetts Institute of technology, 1999. #Written by Eric Prud'hommeaux BEGIN {unshift@INC,('..');} use strict; require Exporter; require AutoLoader; use W3C::Util::W3CDebugCGI; use W3C::Util::Properties; use W3C::Database::Forum; $chacl::REVISION = '$Id: fora,v 1.1 2000/03/23 04:01:36 eric Exp $ '; package forumCGI; # forum-specific common CGI functions use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO); @ISA = qw(Exporter AutoLoader); @EXPORT = qw(); @EXPORT_OK = qw(); $VERSION = '0.01'; $DSLI = 'adpO'; @TODO = (); # Exceptions $main::EXCEPTION_NEED_REDIRECT = 'Exception: need to redirect to:'; my %scripts = ('issuesList' => 'issuesListCGI', ); sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; $self->{CGI} = new W3C::Util::W3CDebugCGI($0, $ARGV[0] eq 'DEBUG', {-storeIn => '/tmp', -dieNoOpen => 1, -logExt => '.log'}); bless ($self, $class); $self->setForum(); my $script = $self->{SCRIPT_NAME}; my $templateVariables = new W3C::Database::TemplateVariables({TITLE => 'List of Issues in '.$self->{FORUM}.' forum'}); $self->{SCRIPT} = new $script($self, new W3C::Util::Properties('../Conf/forum.prop'), $templateVariables); return $self; } sub catPath { my (@paths) = @_; my $ret = ''; foreach my $path (@paths) { $path =~ s:/+$::; if ($path =~ m:/(.*):) { $ret .= '/'.$1; } else { $ret .= '/'.$path; } } return $ret; } sub setForum { my ($self) = @_; if ($ENV{'PATH_INFO'} =~ m:^/([^/]+)(.*)$:) { $self->{SCRIPT_PATH} = $1; $self->{SCRIPT_NAME} = $scripts{$1}; $self->{FORUM} = $2; # $self->{FORUM} =~ s:^/::; } # look for valid script name if (!$self->{SCRIPT_NAME}) { # make a guess of /issuesList/ my $location = catPath($ENV{'SCRIPT_NAME'}, 'issuesList', $ENV{'PATH_INFO'}).'/'; if ($ENV{'QUERY_STRING'}) { $location .= '?'.$ENV{'QUERY_STRING'}; } die $main::EXCEPTION_NEED_REDIRECT.' '.$location.' '.$ENV{SCRIPT_URI}."\n"; } # insure trailing '/' if ($self->{FORUM} !~ m:/$:) { my $location = catPath($ENV{'SCRIPT_NAME'}, $ENV{'PATH_INFO'}).'/'; if ($ENV{'QUERY_STRING'}) { $location .= '?'.$ENV{'QUERY_STRING'}; } die $main::EXCEPTION_NEED_REDIRECT.' '.$location.' '.$ENV{SCRIPT_URI}."\n"; } # # look for consecutive '/'s in the path # if ($self->{FORUM} =~ s://:/:g) { # my $location = catPath($ENV{'SCRIPT_PATH'}, $self->{FORUM}).'/'; # if ($ENV{'QUERY_STRING'}) { # $location .= '?'.$ENV{'QUERY_STRING'}; # } # die $main::EXCEPTION_NEED_REDIRECT.' '.$location.' '.$ENV{SCRIPT_URI}."\n"; # } # figure out how deep we are and build relative path $self->{FORUM} =~ s:/+:/:g; my @pieces = split ('/', $self->{FORUM}); my $depth = @pieces; $self->{SCRIPT_BASE} = '../' x ($depth+1); return; } sub standardHeaders { my ($self) = @_; $self->{HEADERS} = $self->{CGI}->header(-expires=>'+4h'); } sub mesg { my ($self, $title, $values) = @_; my $ret = ''; $ret .= $self->start_html(-title=>'fora', -BGCOLOR=>"#FFFFFF", -TEXT=>"#000000", -LINK=>"#0000ee", -VLINK=>"#551a8b"); $ret .= "\n

".$title.'

'."\n"; foreach my $key (keys %$values) { $ret .= '

'.$key.'

'.$values->{$key}."

\n"; } return $ret."\n"; } sub render { my ($self) = @_; $self->standardHeaders(); print $self->{HEADERS}; # print $self->mesg('title', {'attr1' => 'value1'}); print $self->{SCRIPT}->render; return; } sub renderTop { my ($self, $templateVariables) = @_; my $ret = $self->{CGI}->start_html(-title=>$templateVariables->{TITLE}, -BGCOLOR=>"#FFFFFF", -TEXT=>"#000000", -LINK=>"#0000ee", -VLINK=>"#551a8b"); $ret .= <

| Event Tracking Agent

List of Issues in Top forum

An issue is the document, bug, request, annotation, discussion item, or anything else that you want to track using ETA.

Issues in other Fora: [Top] [news/] [tools/] [wca/]

EOTOP ; return $ret; } sub renderBottom { my ($self, $templateVariables) = @_; my $ret = <

forum\@w3.org,
\$Date: 2000/03/23 04:01:36 $

EOBOTTOM ; return $ret; } package issuesListCGI; # CGI interface for a forum issuesList use vars qw(@ISA); @ISA = qw(Exporter AutoLoader W3C::Database::issuesList); sub new { my ($proto, $cgi, $properties, $templateVariables) = @_; my $class = ref($proto) || $proto; my $self = $class->SUPER::new($properties, $cgi->{FORUM}, $templateVariables); $self->{CGI} = $cgi; $self->{DATABASE} = $properties->getI('database'); bless ($self, $class); return $self; } sub render { my ($self) = @_; my $ret = $self->{CGI}->renderTop($self->{TEMPLATE_VARIABLES}); $ret .= < Number Summary Category Priority Current State Created on Created by Assigned to Resolution

[Add New Issue] [Unassigned Issues] [New Issues]

EOTABLE ; $ret .= $self->{CGI}->renderBottom($self->{TEMPLATE_VARIABLES}); return $ret; } package forumCGI; # the "main" code eval { my $CGIInterface = new forumCGI; $CGIInterface->render; }; if ($@) { print &redirect($1, $2) if ($@ =~ m/\A \Q$main::EXCEPTION_NEED_REDIRECT\E \s ([^ ]*) \s ([^ ]*) \Z/x); } exit 0; sub redirect { my ($where, $error) = @_; my $redirResponse = < 302 Moved Temporarily

Moved Temporarily

URL \"$error\" can be found at $where.
Squirrely little bastard got away this time.

EOF ; return $redirResponse; }