OurNet::WebBuilder - Web rendering for BBS-based services
Index
Code Index:
NAME
OurNet::WebBuilder - Web rendering for BBS-based services
SYNOPSIS
use OurNet::WebBuilder;
my $tmpl = {
dir => \%dir,
article => \%article,
cgi_url => CGI->url
};
my $opref = {
'' => sub {
return '!view';
},
'view' => sub {
$tmpl->{'menu'} ||= param('curdir') || $dir{'oin'}[0]{id};
$tmpl->{'curdir'} ||= param('curdir') || $dir{'oin'}[0]{id};
loadboard($tmpl->{'curdir'});
loadarticle(
$_->{'id'},
($tmpl->{'curdir'} eq 'bbs' ? $bbs
: ($oin, $tmpl->{'curdir'})))
foreach @{$dir{$tmpl->{'curdir'}}};
return 'view';
}
};
OurNet::WebBuilder::Display($tmpl, $opref);
DESCRIPTION
the method Display takes $tmpl, which is a variable pool, and $opref,
which is hash of mapping from 'op' to the subroutine for that 'op'.
The op routine fill in the $tmpl with the varialbes it would like the
variable pool to have, and returns the name of the template file that
would be used. or if the return value begins with '!', the variable pool
will be transit to the specified op again.
You may set $OurNet::WebBuilder::Backend to specify a specific
rendering package. Currently, OurNet::Template, Template and
HTML::Template are supported.
SEE ALSO
AUTHORS
Autrijus Tang <autrijus@autrijus.org>
COPYRIGHT
Copyright 2001 by Autrijus Tang <autrijus@autrijus.org>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See http://www.perl.com/perl/misc/Artistic.html
# $File: //depot/OurNet-Query/WebBuilder.pm $ $Author: autrijus $
# $Revision: #1 $ $Change: 1139 $ $DateTime: 2001/06/14 18:46:33 $
package OurNet::WebBuilder;
require 5.005;
$OurNet::WebBuilder::VERSION = '1.21';
use strict;
use CGI;
use CGI::Cookie;
use vars qw/$Backend/;
use fields qw/header template errormsg cache params extension filename/;
use constant LANGS => [{'zh-tw', 1, 'en-us', 2}, 'big5', 'iso-8859-1'];
# ----------------------
# Subroutine new(%param)
# ----------------------
sub new {
my $class = shift;
my $self = ($] > 5.00562) ? fields::new($class)
: do { no strict 'refs';
bless [\%{"$class\::FIELDS"}], $class };
$self->{'cache'} = (defined $ENV{'GATEWAY_INTERFACE'} and
$ENV{'GATEWAY_INTERFACE'} =~ m/PerlEx|CGI-Perl/);
%{$self->{'params'}} = @_;
return $self;
}
# -----------------------
# Subroutine show($self)
# -----------------------
# Outputs the whole page.
# -----------------------
sub show {
my $self = shift;
if (my $lang = $self->dotemplate and $Backend eq 'HTML::Template') {
foreach my $key (%{$self->{'params'}}) {
if (UNIVERSAL::isa($key, "HASH") and exists($key->{$lang})) {
$key = $key->{$lang};
}
}
$self->{'template'}->param(%{$self->{'params'}});
}
if (UNIVERSAL::isa($self, __PACKAGE__) and $self->{'template'}) {
print CGI->header($self->{'header'});
if ($Backend eq 'HTML::Template') {
print $self->{'template'}->output;
}
else {
$self->{'template'}->process(
$self->{'filename'}, $self->{'params'}
) or die $self->{'template'}->error();
}
}
}
# ---------------------------------------------------------
# Subroutine dotemplate($self)
# ---------------------------------------------------------
# Determines and populates the template file/string/object.
# ---------------------------------------------------------
sub dotemplate {
my $self = shift;
my $CGIOBJ = CGI->new();
my ($path, $info, $dir, $filename, $extension);
$extension = $self->{'extension'};
if (defined $self->{'template'}) {
if (UNIVERSAL::isa($self->{'template'}, 'Template')) {
# Template object already specified: populate CGI if must
push(@{$self->{'template'}->{'options'}{'associate'}}, $CGIOBJ);
}
elsif (UNIVERSAL::isa($self->{'template'}, 'HTML::Template')) {
# Template object already specified: populate CGI if must
push(@{$self->{'template'}->{'options'}{'associate'}}, $CGIOBJ);
}
elsif (!ref($self->{'template'})) {
# It's a file name, so put into $info
$info = $self->{'template'};
$self->{'template'} = undef;
$path = $CGIOBJ->path_translated() || $0;
}
else {
# Something else...
die "Unknown type of 'template' field (".
ref($self->{'template'}).
")";
}
}
else {
$path = $CGIOBJ->path_translated() || $0;
}
if (($dir, $filename) = $path =~ m|(.*[\\/])?(.*)\.|) {
$dir ||= '';
$dir =~ tr|\\|/|;
$filename = $info if $info;
$filename =~ tr|\\|/|;
foreach my $lang (map( { ".$_" } $CGIOBJ->param('lang')), '') {
if (-e ($dir.$filename.$extension.$lang)) {
$self->{'header'} = "text/html";
$self->{'header'}.= "; charset=" . LANGS->{substr($lang, 1)}
if exists LANGS->{substr($lang, 1)};
if ($Backend eq 'HTML::Template') {
require HTML::Template;
$self->{'template'} = HTML::Template->new(
filename => $dir.$filename.$extension.$lang,
associate => $CGIOBJ,
cache => $self->{'cache'}
);
}
else {
require Template;
$self->{'template'} = Template->new(
INCLUDE_PATH => $dir,
INTERPOLATE => 1,
POST_CHOMP => 1,
);
$self->{'filename'} = $filename.$extension.$lang;
}
return $lang ? substr($lang, 1) : 1;
}
}
}
$info = $CGIOBJ->path_info() || $filename.'.pl';
if (my @list = <$dir$filename$extension.??-??> and (-e $dir.'error_lang')) {
$self->{'header'} = "Content-Type: text/html; charset=iso-8859-1";
if ($Backend eq 'HTML::Template') {
require HTML::Template;
$self->{'template'} = HTML::Template->new(
filename => $dir.'error_lang',
associate => $CGIOBJ,
cache => $self->{'cache'}
);
}
else {
require Template;
$self->{'template'} = Template->new(
INCLUDE_PATH => $dir,
INTERPOLATE => 1,
POST_CHOMP => 1,
);
$self->{'filename'} = 'error_lang';
}
@{$self->{'params'}}{qw/title url langs/} = (
'Available Languages for: '.$CGIOBJ->param('lang'),
$info,
[map {s|^.*\.||; {code => $_, url => $info}} @list],
);
return 0;
}
elsif (-e $dir.'error_url') {
if ($Backend eq 'HTML::Template') {
require HTML::Template;
$self->{'template'} = HTML::Template->new(
filename => $dir.'error_url',
associate => $CGIOBJ,
cache => $self->{'cache'}
);
}
else {
require Template;
$self->{'template'} = Template->new(
INCLUDE_PATH => $dir,
INTERPOLATE => 1,
POST_CHOMP => 1,
);
$self->{'filename'} = 'error_url';
}
@{$self->{'params'}}{qw/title url/} = (
'Address error', $path,
);
return 0;
}
else {
$self->{'header'} = "text/plain";
print qq{
A Terrible error happened when parsing $info.
Worse yet, nobody is there to help you.
Please mail your complaints to the system administrator.
With sincere apologies,
The Webmaster
};
exit;
}
}
# Display($tmpl_param, $ophashref, [$fail_url], [$session_db, $flavor])
sub Display {
my $tmpl_param = shift;
my $ophashref = shift;
my $fail_url = shift;
my $session_db = shift;
my $flavor = shift || 'WEBBUILDERID';
my $op = CGI::param('op');
my $user;
if ($op and $session_db) {
my $cookie;
if (CGI->path_translated()) {
my %cookies = CGI::Cookie->fetch;
$cookie = $cookies{$flavor} if exists $cookies{$flavor};
}
else {
$cookie = CGI::Cookie->new(-value => 'localhost');
}
if (exists $session_db->{$cookie->value}) {
my $sescook = CGI::Cookie->new(
-name => $flavor,
-value => $cookie->value,
-expires => '+1h',
-domain => $cookie->domain
);
print "Set-Cookie: $sescook\n";
$user = $session_db->{$cookie->value};
}
else {
print CGI->header(-location => ($fail_url || '/'));
return;
}
}
unless (exists $ophashref->{$op}) {
# No such page; panic!
print CGI->header(-location => ($fail_url || '/'));
return;
}
# Found a page
my $ext = do{&{$ophashref->{$op}}($tmpl_param, $user)};
while (substr($ext, 0, 1) eq '!') {
$op = substr($ext, 1);
$ext = eval{&{$ophashref->{$op}}($tmpl_param, $user)};
}
if ($@) {
print CGI->header;
print "Error occured! Op=$op Ext=$ext Errors=$@ $! $^E $? ";
return;
}
my $page = OurNet::WebBuilder->new(%{$tmpl_param});
$page->{'extension'} = $ext ? ".$ext.w" : '.w';
$page->show;
}
sub SetCookie {
my $flavor = shift || 'WEBBUILDERID';
my $sescook = CGI::Cookie->new(
-name => $flavor,
-value => crypt(time, substr(CGI::remote_host(), -2)),
-expires => '+1h'
);
print "Set-Cookie: $sescook\n";
return (CGI::path_translated()) ? $sescook->value : 'localhost';
}
1;