Cogito, ergo sum
Legacy:Moo/Script
From Unreal Wiki, The Unreal Engine Documentation Site
< Legacy:Moo
Revision as of 00:12, 1 June 2007 by 71-17-22-38.regn.hsdb.sasknet.sk.ca (Talk) (zee revert... pweese lock?)
#!/usr/bin/perl
###############################################################################
# UseMOO
#
# $Id: moo.cgi,v 1.32 2005/07/05 09:23:47 tarquin Exp $
#
# a sort of perl disaster by Tarquin
# based on UseModWiki (C) 2000-2001 Clifford A. Adams
# <caadams@frontiernet.net> or <usemod@usemod.com>
# ...which was based on
# the GPLed AtisWiki 0.3 (C) 1998 Markus Denker
# <marcus@ira.uka.de>
# the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
# and The Original WikiWikiWeb (C) Ward Cunningham
# <ward@c2.com> (code reused with permission)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
# Free Software Foundation, Inc.
# 59 Temple Place, Suite 330
# Boston, MA 02111-1307 USA
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use strict 'refs';
use strict 'vars';
###############################################################################
# POD: Intro
=head1 MooWiki=
UseMoo is a free wiki engine based on UseModWiki by Clifford A. Adams (in turn
based on AtisWiki, and so on back to Ward's Wiki).
The core idea is that the code from UseModWiki is refactored to OO code,
hence the name 'Moo' substituted for 'Mod'.
I plan to bundle it with Mychaeel's Wookee wiki-to-html parser,
which would make the name of the complete thing UseMooWookee.
However, I'm not too fussed about names at this stage.
The goals for this script are:
* modularity
* extensibility
* reduce spaghetti code
* reduce tag soup
* compatibility with UseModWiki
=head2 Modularity=
This script should be able to run just like UseModWiki with one set of modules,
and with some other modules use an SQL or XML database with
a modern XHTML-compatible parser.
=head2 Extensibility=
It should be easy to add extra functionality to the script, without delving
too far into the existing script.
At the same time, the core script is self-contained, just as UseMod is.
This file alone will run a wiki.
=head2 Despaghettification=
UseMod's code can be confusing to work with. A script of this complexity
is always going to involve the chain of execution being hard to follow, but it
is my hope that OO makes this less of an issue.
=head2 Better and smarter HTML and XHTML=
Clean HTML is produced from Wiki source by the Wookee parser.
The OO approach makes it easier to wrap each part of the complete HTML page
in DIVs for easy formatting and layout with CSS.
Other features such as Accesskeys and LINK elements based on site-wide options
and wiki page content are in the pipeline.
=cut=
###############################################################################
# POD: Class hierarchy
=head1 Class hierarchy=
Moo uses several disjoint class hierarchies. The most important of these is
the Page hierarchy. Others behave like modules that add functionality.
This list should also be available via the URL ?action=classreport (it partially is so far).
+ Database - abstract base class. implements database access
++ DatabaseMono - stupidly simple example
++ DatabaseFlat - all pages in a single flat file
++ DatabaseCliff - reworking of UseModWiki's DB system
+ Cache - cache system
+ Parser - wiki parser
++ ParserCliff - the UseModWiki parser
++ ParserWookee
+ Generator - classes that add generated content to wiki pages
++ GeneratorRecentChanges
++ GeneratorCategory
+ SaveAction - things that happen when a page is saved
++ SaveActionSpellcheck
++ SaveActionSpamcheck
++ SaveActionThankyou
+ Page - displays an HTML page
++ WikiPage - displays a wiki page from the database
+++ WikiPageHistory - displays the history list for a wiki page
+++ RevisionPage - displays a particular revision of a page
+++ WikiEdit - edits a wiki page
++++ WikiEditConflict
++++ WikiEditPreview
+++ WikiPageSave
+++ MagicPage
++++ RCPage
++ WikiAdmin - parent of admin pages
++ WikiVersion - shows script version number
++ PageClassReport - outputs the list of all loaded classes
=cut=
###############################################################################
# POD: Bundled plug-in modules
=head1 Bundled plug-in modules=
Moo has a plug-in system. It will load any perl modules in the same directory
as itself whose names begin with 'moo-'. This allows the system's modularity
to work at a different level to classes. You can choose whether to enable or
not a set of features simply by whether a file is in your cgi directory or not.
The modules bundled with Moo are:
=head2 moo-debug.pm=
General debugging and testing tools. ModuleTestPage just tests that the module
has loaded. PageClassReport outputs the list of all loaded classes.
=head2 moo-generators.pm=
Generator classes that aren't core features.
=head2 moo-usemod.pm=
Set of classes for backwards-compatibility with UseModWiki.
This will include the UseMod database system, the UseMod parser, and support
for the action=rc type URLs.
=cut=
###############################################################################
#
# class Database
#
# This is an abstract class. It serves only to set out the methods.
# Subclasses must implement these in some appropriate manner.
#
# Any instance of a Database must be owned by another object.
# This will almost certainly be some sort of Page object.
# A reference to the owner is set as SELF->{owner} on creation, provided the
# constructor has been called correctly... like this:
# Database->new($someobject)
#
# Several things can go wrong when working with the database, and the DB
# class needs to report these back to the Page instance so the user is alerted.
{
package Database;
###########################################################
# Class properties
our $initialized;
# true if the DB system has been initialized
sub isInitialized {
# accessor function for the $initialized property
shift;
$initialized = shift if @_;
return $initialized;
};
###########################################################
# Database Constructor and initializer
#
# It is only necessary to initialize the DB system once;
# but we might need more than one DB instance (eg diff pages)
#
# The new() method creates and returns a new DB instance and
# takes responsibility for initializing the DB system if necessary
#
# It returns a reference to the Database object if all goes well.
# Otherwise, returns a string containing the error message.
# Test the return of this with ref().
# (Note – new() this tolerates a return of 1 from initDatabase()
# as a success. This is a pre-emptive bug tolerance,
# since it's possible to forget the return statement and finish with
# setting isInitialized to 1)
#
# The new() method should not be overridden in child classes.
# Use the initDatabase() to do things specific to the database implementation.
sub new {
my $class = shift;
my $owner = shift;
my $result = $class->initDatabase()
unless $class->isInitialized;
# if $result is non-empty, an error has occured
# (unless $result is 1, in which case a programmer is probably being lazy)
return $result
if $result and $result != 1;
my $newDB = { owner => $owner };
return bless $newDB, $class;
}
sub initDatabase {
# unlike UseMod...
# returns nothing if successful (but sets isInitialized to a TRUE value)
# returns an explanation if something goes wrong
my $class = shift;
# Things the initializer should do:
# check the datadir specified in config exists.
# If it is not found, try to create it.
$class->isInitialized(1);
return;
}
###########################################################
# Access
sub loadWikiFromDB {}
# loads the content of the wiki page into its owner
sub saveWikiToDB {}
# saves the content of the wiki page from its owner
sub fetchRClist { 'This Database system does not appear to support a Recent Changes list.' }
# returns list of RC lines
sub fetchHistory { 'This Database system does not appear to support page histories.' }
# returns list of history lines
}
###############################################################################
#
# class DatabaseMono
#
# DatabaseMono is a primitive database system that only loads one
# page, no matter what title it is given.
# This is just to see how it interacts with the rest of the script
# Move this to moo.debug.pm eventually.
{
package DatabaseMono;
our @ISA = qw(Database);
# for testing only
our $filename = 'db.txt';
###########################################################
# DatabaseMono::initDatabase
#
sub initDatabase {
my $self = shift;
my $datadir = Page->getConfiguration('DataDir');
unless ( -d $datadir || CreateDir($datadir) ) {
return qq[Can't create directory $datadir];
# return an error message
}
$self->isInitialized(1);
return;
}
#--------------------------------------
# these are not proper OO methods
# from UseMod
# consider moving these up to the base Database class to be inherited
sub CreateDir {
my $newdir = shift;
mkdir($newdir, 0775) if (!(-d $newdir)); # returns true if succeeds.
}
sub ReadFile {
my $fileName = shift;
my $data;
local $/ = undef; # Read complete files
if (open(IN, '<' . Page->getConfiguration('DataDir') . "/$fileName")) {
$data=<IN>;
close IN;
return (1, $data);
}
return (0, "");
# should be a more elegant way of doing this
# return undef perhaps if data not found?
}
sub WriteStringToFile {
my ($file, $string) = @_;
open (OUT, '>' . Page->getConfiguration('DataDir') . "/$file") or
die(Ts('cant write %s', $file) . ": $!");
print OUT $string;
close(OUT);
}
#--------------------------------------
# public methods
###########################################################
#
# DatabaseMono::loadWikiFromDB
#
# Consider interface:
# - for serious errors, stash an error message in $page->{error}
# - for no such page error, place '' in $page->{wiki}
sub loadWikiFromDB {
my $self = shift;
my $page = $self->{owner};
my $revision = $page->{revision} || 0;
# could have a GiveMeDatabase method in Page that
# calls new, hands over the owner object ref
# and sorts all this out – then any child of Page that
# requires DB access just needs to say $self->GiveMeDatabase()
my ($status, $data ) = ReadFile($filename);
$page->{wiki} = $data;
#join '',
#$data || 'no data!'; #,
#"<BR>\n",
#'The name of this page is: ',
#$page->{title},
#"<BR>\n",
#'The revision of this page is: ',
#$revision
#;
# page not found scenarios are handled by Page children: just stash '' if there is no data
# NotFoundPg => 'PageDoesNotExist',
# NewPageEdit => 'BlankEdit',
return 1; # load successful
}
sub saveWikiToDB {
my $self = shift;
my $data = shift;
my $page = $self->{owner};
$data = $page->wiki;
#$self->initDatabase() or return 0;# unless $databaseIntialized;
WriteStringToFile( $filename, $data);
}
}
###############################################################################
# POD: Generators
=head1 Generators=
Generators are classes that create content to display in wiki pages based on something other than wiki source.
A good example is the Category listing that Unreal Wiki uses.
Another example, though perhaps not an obvious one, is the Recent Changes page.
=cut=
###############################################################################
#
# class Generator
#
# Base class to hold registry
{
package Generator;
our @registered;
sub registeredChildClasses { @registered }
###########################################################
# Registration
#
# Child classes call this method on themselves
# and are registered into an array
sub register {
my $class = shift; $class = (ref $class or $class);
push @registered, $class
if $class->isa(Generator)
and not grep /^\Q$class\E$/, @registered;
}
}
###############################################################################
#
# class GeneratorRecentChanges
#
# Lists Recent Changes to the wiki
# It's up to the Database object to actually maintain and produce a list of recent changes
# This class requests it and formats it nicely
{
package GeneratorRecentChanges;
###########################################################
# Registration
#
our @ISA = Generator;
GeneratorRecentChanges->register();
sub propPlacement { 'foot' }
sub generateText {
my $self = shift;
my $page = shift;
return join '',
'<div class="rc">',
$page->DBref->fetchRClist,
'</div>';
}
}
###############################################################################
#
# class Page
#
# The base class for pages. This is where most of the work happens.
# This should:
# open an HTML scaffold file
# hold a default HTML page scaffold
# determine what sort of page has been requested
{
package Page;
###########################################################
# Static
our @registered;
sub registeredChildClasses { @registered }
###########################################################
# Registration
#
# Child classes call this method on themselves
# and are registered into an array
sub register {
my $class = shift; $class = (ref $class or $class);
push @registered, $class
if $class->isa(Page)
and not grep /^\Q$class\E$/, @registered;
}
###########################################################
# Class properties: inheritable defaults
sub propConditions { 0 } # conditions a class must satisfy to handle a browse request. Returns false by default
sub pageAccess { 'user' } # user status required to view this class's page
sub bodyCSSclass { '' } # the CSS class added to the BODY HTML tag for this class's page
sub titlePrefix { '' } # prefix added to the displayed page name
sub propPageTitle { } # title if none supplied dynamically
sub thisPageTools { '' }
#sub usesGenerators { 0 } # no good.
###########################################################
# Class properties: CGI
sub getScriptName { $ENV{SCRIPT_NAME} } # Name used in links (absolute) – Mychaeel
###############################################################################
# POD: Configuration
=head1 Configuration=
Configuration options for Moo are set in a Big Fat Hash within the Page class.
They are accessed with the getConfiguration() method, which takes the name of the key.
If you don't yet have access to a Page object, then the dirty way to do it is
$Page::configuration{propertyname}, but this should only be an issue at the very start of
the UseMooWiki package, where a Page has not yet been created.
Configuration defaults are overridden in a seperate file that is executed when the Moo script loads.
A configuration file sample follows:
----
# do not touch this line:
%configuration = ( (%configuration),
ConfigName => Number,
ConfigName => 'String',
ConfigName => [ list, list, list ],
and so on
do not forget the comma at the end of each line!
----
=cut=
###########################################################
# Configuration
#
# Default settings are overriden by the config file
our %configuration = (
ConfigFile => 'configlist.pl',
DataDir => 'data',
# site configuration
SiteName => 'Moo Wiki',
HttpCharset => '',
FreeLinks => 1,
FreeUpper => 1, # put [[Legacy:Free Links|free links]] into [[Legacy:Title Case|Title Case]]
# CGI
RunCGI => 1,
# special pages names
# these should be in the form the database uses, not the URL or the display
HomePage => 'WelcomePage',
RecentChanges => 'RecentChanges',
AccessDenied => 'AccessDenied',
NoSpam => 'NoSpam',
SampleLink => 'TheWeatherInLondon',
Search => 'SearchResults',
NotFoundPg => 'PageDoesNotExist',
NewPageEdit => 'BlankEdit',
# ugly. remove!
BuiltInGenerators => {
RecentChanges => 'RecentChanges',
},
# LINK elements in HTML HEAD
HtmlLinks => { },
# appearance
DefaultStyleSheet => '', # http://localhost/wiki-ext/moo/moodev.css', # for use with built-in template
# replace this with built-in stylesheet and override it if this value is not ''
PageTemplates => { },
# user groups
UserGroups => ['user', 'editor', 'admin'],
# place these in increasing order of authority
# code modules
Hello => 'HelloSub',
# debug
DebugMode => 1,
);
###################
# read in configuration file
if ( $configuration{ConfigFile} ) {
do "$configuration{ConfigFile}";
# this does not yet report errors!
}
sub getConfiguration {
# consider changing this to accept a list of keynames and
# return a list of values
my $class = shift; $class = (ref $class or $class);
my $wantedkey = shift;
return $configuration{$wantedkey};
}
###############################################################################
# POD: Built-in template
=head1 Built-in template=
The Moo script contains its own template for HTML pages.
This should be sufficient for most uses: with a little CSS styling you can
make your wiki pages distinctive if you so wish.
You can however supply your own: see configuration.
=cut=
###################
# Built-in template
our $builtInTemplate = <<"EOT";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html><head><title>%windowtitle%</title>
%styles%
%link%
</head>
<body class="%bodyclass%">
<h1>%title%</h1>
<div class="wiki">
%wiki%
</div>
<div class="footer">
%footer%
</div>
</body>
</html>
EOT
sub getTemplate {
# do some config checking:
# has the user requested a template?
# does the config request a template?
# do they exist?
return $builtInTemplate;
# consider embedding the template in this sub instead.
}
###################
# Built-in CSS
# what would be terribly cunning might be to hide the two here-docs
# behind a quick check of the relevant %configuration keys
# so they're not even loaded if not required
our $builtInStyles = <<"EOT";
/* main structure */
div {
border:solid 2px;
margin:1em;
padding:0.5em;
}
.footer {
border-color:red;
}
.edit {
border-color:green;
}
.preview {
border-color:yellow;
}
.savemessage {
border-color:#fb0;
}
.debug {
border-color:red;
border-style:dashed;
}
.debug h1 {
margin:0em;
padding:0em;
font-size:1.5em;
}
.debug h2 {
margin:0em;
padding:0em;
font-size:1.2em;
}
/* forms */
.editbutton {
width: 5em;
height: 2em;
}
EOT
sub getStyles {
# return either a LINK to a stylesheet or a STYLE block of the built-in stylesheet
# do some config checking:
#<link rel="stylesheet" type="text/css" media="screen" href="">
return qq[<style type="text/css">$builtInStyles</style>];
}
###################
# testing plugin modules
sub DummyHello {
#if (Page->can('HelloSub')) {}
&{ Page->can($configuration{'Hello'}) or 'HelloSub'}(@_)
#if (Page->can($configuration{'Hello'})) {
# &{$configuration{'Hello'}}(@_);
#}
}
sub HelloSub {
# a fallback default module
print "Hello!!!!!\n";
}
#DummyHello();
# end test
###################
###########################################################
# Instance properties
#
# Accessors to these are generated with a closure.
# Use any of the following:
# - $object->name('value'); # assign and return
# - $object->name = 'value'; # lvalue assignment
# - $object->name; # plain return
#
# These COULD BE capable of consulting the holder if no value is found
# However, this code is commented out because I think this could
# lead to problems with embeddings that rely on a property NOT being there
# to test something.
# Consider as an alternative to both this "consulting the holder" method
# and repetitive stuffing of an embedded instance with copies of vars:
# an "embedding creator" method, which takes a list of properties to
# bestow upon the new object.
# closure templates
for my $field (qw[now cgiref DBref browserequest DBid
error holder embed
title wiki text revision generators]) {
no strict 'refs'; # allow symbol table manipulation
*$field = sub : lvalue {
my $self = shift;
# with input, set the property
$self->{$field} = shift if @_;
# if property empty, try holder
#if( !$self->{$field} and $self->{holder} ) {
# return $self->{holder}->$field;
#}
$self->{$field};
}
}
###############################################################################
# POD: Instance data
=head1 Instance data=
UseMoo stores data that relates to the current page as instance data.
This avoids globals, lengthy parameter lists passed to subroutines,
and means that it's safe to create further instances as embedded pages,
for example.
Here is the list of data stored, in approximate order of storage:
now => the time of the request
cgiref=> reference to a CGI object for HTML tag creation etc
DBref => reference to a Database object
browserequest
=> a reference to the hash of the browse request variables
(instead of UseMod's &GetParam)
DBid => name of page as the database will need to see it
embed => embedded page (subject to refactoring)
holder
=> for an embedded page, a reference to the page it is embedded within
title => name of page as the user should see it in the browser
revision
=> the requested revision number of a page
wiki => wiki source text
text => HTML text to be output to the browser
error => holds error text passed around at various times. If true at page display time, requests debug mode.
=cut =
###########################################################
# Instance properties: building up text
#
# Text eventually output to the browser is stored as an instance variable
# This makes it easily accessible
# and specialized modules can access what earlier modules have stored (if needed)
sub getText {
my $self = shift;
return unless ref $self; # this is only for instances, not classes
return $self->{text};
}
sub appendText {
my $self = shift;
my $text = shift;
return unless ref $self; # this is only for instances, not classes
$self->{text} .= $text;
}
sub prependText {
my $self = shift;
my $text = shift;
return unless ref $self; # this is only for instances, not classes
$self->{text} = $text . $self->{text};
}
###########################################################
# User access levels
sub compareUserGroups {
my ($self, $actualAbility, $requiredAbility) = @_;
return 1 if ( $actualAbility eq $requiredAbility );
# failsafe: what to do if the values received don't figure in the array?
# not ideal but:
# if actualAbility is bad, suppose user is LOW
# $actualAbility = $groups[0];
# if requiredAbility is bad, suppose actual ability is HIGH
foreach ( @{$self->getConfiguration('UserGroups')} ) {
# walk through the UserGroups array
# and compare current user and requirement to each entry
return 1 if ( $_ eq $requiredAbility);
# we got to required ability first: user is overqualified
return 0 if ( $_ eq $actualAbility);
# we got to actual ability first: user is not up to it
}
}
###############################################################################
# POD: Page Constructors
=head1 Page Constructors=
The constructor for Page objects isn't actually a constructor, it's a blesser, because it's given
a reference to bless (and return the blessed instance), rather than creating one from nothing.
The reason for this is that the soon-to-be instance sometimes needs to begin loading itself with data to
find out what it will be. For example, this allows the wiki content to be loaded from the database and then examined
to influence the choice of class to bless as. It could be done without stashing the loaded data inside
the hash reference, but then we'd have two copies of the data floating around, and this seems messy.
(Other constructors, such as for the Database, are passed the reference of the Page
object that is to be their owner, but more on this elsewhere.)
The creation of a Page object begins in the UseMooWiki package, which creates a hash reference, puts
some values in it such as the time of the request, and passes it to Page::chooseClass.
=head2 Page::chooseClass =
Page::chooseClass is the principal constructor method. It does the following:
# tests each registered class against the browse parameters, trying to find a class whose conditions are satisfied
## if a suitable class is found, it tests the user access level required.
### if the user fails, the instance is blessed as WikiPage instead and goes to the 'AccessDenied' page
### if the user succeeds, the instance is passed to the blessPage method of the suitable class.
(The blessPage method will bless the instance and return it,
but may make its own decisions about what class to bless as!)
## if chooseClass has not found a suitable class, it blesses the reference as PageError
# the blessed reference is returned
UseMooWiki how has an instance of some class (WikiPage, for example).
It calls makePage on this instance, which and the prints the instance's text property.
That's it!
=head2 Page::blessPage =
This does pretty much nothing. It just blesses the reference.
The real work happens in WikiPage::blessPage, but Page::blessPage exists
so it can be inherited if need be.
=cut=
#####################################
#
# Page::chooseClass
#
# Called by UseMooWiki. Begins the process of deciding which class
# to bless the passed reference as.
# Considers all the registered children of Page, evaluating and
# testing the string propConditions for each one.
# This is done in *reverse* order of registration: this gives later classes
# the chance to specialize the conditions (eg RevisionPage specializes WikiPage).
# Classes also have the chance to 'intercept' and completely replace handling
# of a certain condition: see moo-delay.pm's WikiPageDelayed for an example.
sub chooseClass {
my $class = shift; $class = (ref $class or $class);
if ($class ne __PACKAGE__) { die 'Illegal subclass calling constructor'; }
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift; # ref to hash
# consider putting initDatabase here and making a PageError -
# but we lose the feature of some actions not requiring the DB (eg version)
##############################
# Cancel
# catch Cancel button presses and clean up the parameters
# this could be moved to a class that then calls Page::chooseClass
# a second time with new params
if( $browseParameters->{Cancel} ) {
my %acceptableParameters = map { $_, '' } qw( title );
# may be a problem with id vs title params
foreach (keys %$browseParameters) {
delete $browseParameters->{$_}
unless $acceptableParameters{$_};
}
}
# dummy variables for testing
my $userStatus = 'user';
##############################
# Class testing
#
# Consider each child class in the registered list
TESTCLASSES: foreach my $consideredclass ( reverse registeredChildClasses() ) {
if( eval $consideredclass->propConditions ) {
# grab its condition statement
if ( $class->compareUserGroups( $userStatus, $consideredclass->pageAccess )) {
blessPage $consideredclass $instance, $browseParameters;
#$childclass->childcreatePage( $instance, $browseParameters );
}
else {
$$browseParameters{keywords} = $class->getConfiguration('AccessDenied');
blessPage WikiPage $instance, $browseParameters;
}
last TESTCLASSES; # don't test anything else now we've found something
}
}
if (ref $instance eq 'HASH') {
# $instance is still unblessed?
# if we get here then we've not properly handled the cases
# PageError will tell us what went wrong
blessPage PageError $instance,
q[No page type matched the parameters passed by the browser.];
}
}
#####################################
# Page::blessPage
#
# This is the generic blessing method for Page child classes.
# This is never called directly, but some classes that do nothing
# special here may inherit it.
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref to bless
bless $instance, $class;
}
###########################################################
# Making output text
# These methods produce HTML text for output
#
# makePage
# The main method.
# Calls makePageContent and wrapPageContent to make all the html.
# Then adds HTTP headers to the front of the html text
#
# makePageContent
# creates the dynamically-generated content and stores it
#
# wrapPageContent
# wraps the stored text in a template, including
# link footer and debug footer
# consider more levels of OO here:
# Page
# +- HtmlPage
# +- TemplatedPage
sub makePage {
my $self = shift; # should verify $self is an instance if we're really being clean
$self->makePageContent(); # create the dynamic stuff
$self->wrapPageContent(); # wrap it up in template and header and footer etc
# make HTTP header using the CGI object header method
my @headerProperties = ( -Content_length => length $self->text );
if ( 1 ) { # if charset set
push @headerProperties, -type => 'text/html charset=$HttpCharset';
}
if ( 0 ) { # if cookie need to be set
push @headerProperties, -cookie => 'cookie!!!';
}
$self->prependText( $self->cgiref->header( @headerProperties ));
return;
}
sub makePageContent {
my $self = shift;
$self->appendText("Default Page object\n"); # we should never actually be here
return;
}
sub makePageFooter {
# The generic footer: a bar of site-wide links and a note about the engine.
my $self = shift;
my $text ;
my $urlroot = $self->getScriptName;
$text .= $self->cgiref->p(
join ' | ',
# this soup will be simplified with standard footer links system
$self->cgiref->a({-href=>$urlroot .'?' . $self->getConfiguration('RecentChanges')},'Recent Changes'),
$self->cgiref->a({-href=>$urlroot .'?' . $self->getConfiguration('HomePage')},'Home Page'),
( ( $self->getConfiguration('DebugMode') or $self->error )
and $self->cgiref->a({-href=>$urlroot .'?action=classreport'},'Class Listing' ) )
);
$text .= $self->cgiref->p(
q[Footer Text: this site runs Moo! (And it's great!)</p>]);
$self->appendText($text);
return;
}
sub makePageDebugListing {
my $self = shift;
# some local copies of references to simplify the arrow soup
my $tagmaker = $self->cgiref; # CGI object
my $browserequest = $self->browserequest; # the hash of browser request params
my $text = join '',
$tagmaker->h1('Debug information'),
$tagmaker->p("Class is $self"),
$tagmaker->h2('Browser parameters'),
$tagmaker->ul(
$tagmaker->li([ map {"$_ => $browserequest->{$_}"} keys %$browserequest ])
), # making an anonymous list makes li() distribute over it
$tagmaker->h2('Instance data'),
# note that we cheat and access instance properties directly
$tagmaker->ul(
$tagmaker->li([ map( {
my $output = "$_ => $self->{$_}";
ref($self->{$_}) eq 'HASH' and
$output .= "; hash: " . join ',', %{$self->{$_}};
$output;
} grep !/text|wiki/, keys %$self )])
), # we don't want to print $self->{text} or {wiki}
;
if( $self->generators ) {
$text .= join '',
$tagmaker->h2('Generator parameters'),
$tagmaker->ul(
map { qq[<LI> @{$_} </LI>] } @{$self->generators}
);
}
$self->appendText(qq[<DIV class="debug">$text</DIV>]);
}
sub wrapPageContent {
my $self = shift;
# gets a template, splits and wraps the text generated so far inside it.
# a default template exists in this script
# at this point, $self->{text} should contain:
# * the rendered wiki text when we get here
# * any 'magic' content
my $template = $self->getTemplate;
my $pagetitle = ($self->titlePrefix . $self->title or $self->propPageTitle);
# consider doing all these on $splittext[0]
for ($template) {
s[%styles%][$self->getStyles]e;
s[%link%][]; # for now
s[%windowtitle%]{join '' ,
$self->getConfiguration('SiteName') , ' - ' ,
$pagetitle}e;
s[%title%]{$pagetitle};
#$self->titlePrefix . $self->title or $self->propPageTitle}e; # check precedence here!
s[%bodyclass%]{
$self->bodyCSSclass}e;# not yet fully implemented
}
my @splittext = split m[%wiki%|%footer%], $template;
$self->prependText( $splittext[0] );
$self->appendText( $splittext[1] );
$self->makePageFooter();
$self->makePageDebugListing()
if $self->getConfiguration('DebugMode') or $self->error;
# debug mode can be requested site-wide (by the developer)
# or by the script if something goes wrong.
$self->appendText( $splittext[2] );
}
}
###############################################################################
#
# class WikiPage
#
# Base class for wiki pages.
# should:
# load and parse wiki text
# determine if extra elements are needed: preview, diff, etc
{
package WikiPage;
###########################################################
# Static
our @ISA = Page;
our @registered;
WikiPage->register();
###########################################################
# WikiPage Class conditions
#
sub propConditions { q[
!%$browseParameters
or $browseParameters->{keywords}
or $browseParameters->{action} eq 'browse'
] }
# wiki.cgi - no parameters at all
# wiki.cgi?pagename (works out as {keywords}=pagename)
# wiki.cgi?action=browse
###########################################################
# WikiPage Class defaults
#
sub thisPageTools { 'Edit this page', 'View other revisions' }
=pod =
how does this work?
eg:
OldRevision page needs to change 'Edit this page' and
add 'view current revision', but keep the last one
possibly use a pseudohash, so there is name access and also an order built-in?
=cut=
sub displayTitleFromURL {
my $class = shift;
my $title = shift;
$title =~ s/_/ /g;
return $title;
}
###########################################################
# Class constructor
#
# WikiPage::blessPage
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift; # ref to hash
bless $instance, $class;
##################
# get the page id and title
$instance->{DBid} = $browseParameters->{keywords}
|| $browseParameters->{id}
|| $class->getConfiguration('HomePage');
$instance->{title} = $class->displayTitleFromURL($instance->{DBid}); # but translated to human
#unless ( $instance->{DBid} ) {
# # no page specified? we want the HomePage
# $instance->{title} = $class->getConfiguration('HomePage');
# $instance->{DBid} = $instance->{title}; # but translated to DB
#}
##################
# Database object creation
# Attempt to create a DB object (the Database->new method will initialize the DB if needed)
# Then load text from the database, handle errors and mishaps
# UNLESS the instance already holds some wiki text
# (it will have been placed there by something embedding this instance eg Preview)
unless ( $instance->{wiki} ) {
# pass the page object to the Database constructor
# 'new' is a REALLY BAD NAME to use!
# the constructor will return an object or an error string
my $database = DatabaseMono->new($instance);
# new() has failed to create a DB object?
ref $database or do {
my $errormessage = $database
|| q[No details supplied.];
blessPage PageError $instance, qq[Database initialization error: $errormessage];
return;
};
$instance->{DBref} = $database; # only put it in here once we know it's ok
$database->loadWikiFromDB();
# loadWikiFromDB() has stored an error message?
$instance->error and do {
blessPage PageError $instance,
q[Error loading the page from the database.];
return;
};
# the wiki text stored by loadWikiFromDB() is blank?
$instance->wiki =~ /^\s*$/ and do {
$instance->DBid( Page->getConfiguration('NotFoundPg'));
$database->loadWikiFromDB();
};
}
##################
# Generator request handling
# handle MAGIC
#
if ($class eq __PACKAGE__ or 1 ) {
# only calls in WikiPage use Generators
# consider the cleaner way of having WikiPage abstract
# and creating a WikiPageDisplay class
# set up the array ref unless already there
$instance->generators = []
unless $instance->generators;
# each entry in this array is itself an array, holding:
# [0] - the name of the module
# [1] - the parameter line
# make a list of lowercased module names, with link to the real name
my %registeredGenerators = map { lc $_, $_ } Generator->registeredChildClasses;
my @magicrequestlines = $instance->wiki =~ m[^\#MAGIC\s+(.*)\s+\n]mg;
MAGICLINES: foreach my $line ( @magicrequestlines ) {
# separate module from params
my ($modulename, $parameters) = split /\s+/, $line, 2;
# discard a line that does not correspond to a Generator module in this script
# and get the REAL module name from the hash (wiki text might have wrong case)
$modulename = $registeredGenerators{lc qq[Generator$modulename]} or
next MAGICLINES;
# checking output
$instance->wiki .= qq[REAL GENERATOR:'$modulename'];
push @{$instance->generators}, [$modulename, $parameters];
#$modulename = qq[Generator$modulename];
#$magicrequests{lc qq[Generator$key]} = $value;
}
# %magicrequests = { lowercased module name from wiki, rest of magic line }
# %registeredGenerators = { lowercased registered class, real name of class }
#foreach my $request (keys %magicrequests) {
#
# $registeredGenerators{$request} and do {
# $instance->wiki .= qq[REAL GENERATOR:'$request'];
#
# }
#
#
#}
#
#${$instance->generators}{foo} = 'bnar' ;
#push @{$instance->generators}, 'foo';
# REPORT
}
# strip initial #MAGIC lines, whatever the situation
$instance->wiki =~ s/\A(\#MAGIC.*\n)+//m;
# parse beginning of wiki text for ^#COMMAND eg #MAGIC or #REDIRECT
# if #REDIRECT:
# change $instance = { title }
# and store instance = { oldtitle }
# if #MAGIC:
# neuter the MAGIC parameters for security aspects
# stash the MAGIC parameters in %$browseParameters
# look at the registered Generator Modules
}
#####################################
# WikiPage content making
sub setupGenerators {
my $self = shift;
# This method draws up a list of any requested Generated Content Modules.
# These can be requested:
# - by the name of the page itself, eg 'RecentChanges'
# - by the wiki content, eg '#MAGIC (modulename)' at the head of markup
=pod =
my $id = $self->DBid;
# Check the configuration property BuiltInGenerators
foreach my $foo ( values %{Page->getConfiguration('BuiltInGenerators')} ) {
#$id eq $foo and push
}
=cut=
#return 'foo';
}
sub makePageContent {
my $self = shift;
my $text;
$self->runGenerators
if $self->generators;
$text .= $self->wiki;
$self->appendText($text);
return;
}
sub runGenerators {
my $self = shift;
for my $generator (@{$self->generators}) {
$self->wiki .= $generator->[0]->generateText($self);
}
}
sub makePageFooter {
my $self = shift;
my $text ;
# stash some things locally to avoid many lookups
my $tagmaker = $self->cgiref; # copy of ref to CGI object
my $id = $self->DBid; # remember to mangle spaces etc
my $urlroot = $self->getScriptName;
$text = $tagmaker->p(
join ' | ',
$tagmaker->a({-href=>$urlroot . "?action=edit&id=$id"},'Edit this page'),
$tagmaker->a({-href=>$urlroot . "?action=history&id=$id"},'View other revisions'),
);
$self->appendText($text);
$self->SUPER::makePageFooter;
return;
}
}
###############################################################################
#
# class RevisionPage
#
# Display an old revision of a page
# how this class works really depends on the DB implementation
#
# This should
# * alter the "edit" link
# * prefix the text with a notice giving the revision number
{
package RevisionPage;
our @ISA = WikiPage;
RevisionPage->register();
###########################################################
# Class conditions
sub propConditions { q[$browseParameters->{revision} ] }
###########################################################
# RevisionPage::blessPage
#
# Check requested revision is a valid number
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift; # ref to hash
$instance->{revision} = $browseParameters->{revision} ;
unless ( $instance->{revision} =~ m/^\d+$/ ) {
blessPage PageError $instance,
qq['$instance->{revision}' is not a valid revision number.];
return;
}
$class->SUPER::blessPage($instance, $browseParameters); # will bless
# now check with the dabase that the number exists
}
###########################################################
# RevisionPage::Content
#
sub makePageContent {
my $self = shift;
my $revision = $self->browserequest->{revision};
my $text = join '',
'<p><em>',
"Showing revision $revision",
'</em></p>';
$self->appendText($text);
$self->SUPER::makePageContent;
}
}
###############################################################################
#
# class WikiPageHistory
#
# Display the page history: the list of revisions
# how this class works really depends on the DB implementation
#
# This should
{
package WikiPageHistory;
our @ISA = Page;
WikiPageHistory->register();
###########################################################
# Class conditions
sub propConditions { q[$browseParameters->{action} eq 'history' ] }
###########################################################
# Class defaults
sub titlePrefix {q[History of ]}
#####################################
# WikiPageHistory::blessPage
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift;
unless ( $$browseParameters{id} ) {
# no id given! Error!
blessPage PageError $instance,
q[No id parameter given. Don't know which page's history to display.];
return;
}
$instance->{title} = ( $$browseParameters{id} ); # move up!
bless $instance, $class;
return;
}
###########################################################
# Content
# WikiPageHistory::makePageContent
sub makePageContent {
my $self = shift;
my $revision = $self->browserequest->{revision};
my $text = join '',
'<p><em>',
"History",
'</em></p>';
$self->appendText($text);
}
}
###############################################################################
#
# class RecentChangesPage
#
# consider keeping this
# as it's a lot easier than going through config in setupGenerators
{
package RecentChangesPage;
our @ISA = WikiPage;
RecentChangesPage->register();
###########################################################
# Class conditions
#
# wiki pages have wiki.cgi?pagename or wiki.cgi/pagename
# this works out as {keywords}=pagename or $ENV{PATH_INFO}
#sub propConditions { q[$browseParameters->{keywords} eq 'RecentChangesPage'] }
sub propConditions { q[$browseParameters->{keywords} eq $class->getConfiguration('RecentChanges')] }
#####################################
# RecentChangesPage::blessPage
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift;
bless $instance, $class;
$instance->generators = []
unless $instance->generators;
push @{$instance->generators}, ['GeneratorRecentChanges', ''];
$instance->SUPER::blessPage($instance,$browseParameters);
}
###########################################################
# RecentChangesPage::Content#
=pod =
sub makePageContent {
my $self = shift;
my $text = join '',
'<div class="rc">',
$self->DBref->fetchRClist,
'</div>';
$self->SUPER::makePageContent;
$self->appendText($text);
return;
}
=cut =
}
###############################################################################
#
# class WikiAdmin
#
# just some generic admin page to figure out how to handle user permissions
{
package WikiAdmin;
our @ISA = Page;
WikiAdmin->register();
###########################################################
# Class conditions
sub propConditions { q[$$browseParameters{action} eq 'admin'] }
sub pageAccess { 'admin' }
#####################################
# WikiAdmin::blessPage
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
$instance->{title} = 'An admin page';
bless $instance, $class;
}
###########################################################
# Content
sub makePageContent {
my $self = shift;
$self->appendText("An admin page");
}
}
###############################################################################
#
# class WikiPageSave
#
{
package WikiPageSave;
our @ISA = Page; # is not WikiPage because it doesn't handle reading the DB
WikiPageSave->register();
###########################################################
# Class conditions
sub propConditions { q[$$browseParameters{Save} eq 'Save'] }
#####################################
# WikiPageSave::blessPage
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift;
# disallow creation of the sample link
if ( $browseParameters->{title} eq $class->getConfiguration('SampleLink') ) {
blessPage PageError $instance,
q[That was just a link to show you how it's done. You can't create this page!];
# even smarter would be auto-wipe it after x days
return;
}
$instance->{wiki} = ( $browseParameters->{text} );
# disallow spam text
if ( $instance->{wiki} =~ m/spam/ ) {
blessPage PageError $instance,
q[Some of the text you entered contained phrases that matched our Spam Blacklist.];
return;
}
# disallow blank page
if ( $instance->{wiki} =~ m/^\s*$/ ) {
blessPage PageError $instance,
q(Please don't save a blank page. To delete a page, mark it with "[[Legacy:DeletedPage|DeletedPage]]");
return;
}
# also disallow saving of NewPageEdit text unchanged
$instance->{title} = ( $browseParameters->{title} );
bless $instance, $class;
}
=pod=
page save is a little problematic.
embedding approach:
* makePageContent creates an embedding.
* This allows a "save message" which could later on become a spellchecker.
* unfortunately, we don't get the WikiPage footer
(unless we hack around and have this makepageFooter() call WikiPage->makepageFooter(),
which is hard-coding a class...
though we *COULD* call
$myembedding->makepageFooter()
which is a nice way round it... nice we have access to a WikiPage class via the embedding
that means we have to stash the embedding in instance data...
$instance->{embedded} = $myembedding;
so we can grab it later
recasting approach
* blessPage blesses as a WikiPage
* no further class content
* unfortunately, we don't get the save message
#sub makePage {
# override Page
#doPost in some way
#check for edit conflict
#or should that be done at the new() stage?
# reset title of $self
# call make header
# now display the result
my %EmbeddedPageVariables = ...
# recreate page variables
# create a new page object
# note: can join the new() tree at WikiPage!
$embeddedPage->makePage();
my $embeddedText $embeddedPage->getText;
$self->appendText($embeddedText);
=cut =
#}
###########################################################
# Content
# WikiPageSave::makePageContent
sub makePageContent {
my $self = shift;
my $text;
$self->DBref( DatabaseMono->new($self) ); # create a DB instance and store ref
$self->DBref->saveWikiToDB(); # save wiki text
# save message
$text = q[<DIV class="savemessage">Your text has been saved and the result of your edit is shown below. Thanks for editing!</DIV>];
# consider making this text a config property,
# or better, stored in a wiki page
# this could later do things like spellchecking
# add a "clear message" link.
# embed an instance of WikiPage to make the preview
# fake some browser parameters
my %embeddedParameters;
$embeddedParameters{keywords} = $self->title;
# create the instance here
#my $displayInstance = {};
# for later footer... stash the embedded instance WITHIN our main instance
$self->{embed} = {}; # for OO niceness, should obtain an lvalue with a method
my $displayInstance = $self->{embed};
# give the embedding some of the references and data we have
$displayInstance->{holder} = $self;
$displayInstance->{cgiref} = $self->cgiref;
$displayInstance->{DBref} = $self->DBref;
$displayInstance->{wiki} = $self->wiki; # give it the save text
blessPage WikiPage $displayInstance, \%embeddedParameters; # bless it
$displayInstance->makePageContent; # have it work its stuff
# now retrieve the text and put it into the "real" page
$text .= $displayInstance->text;
$self->appendText($text);
return;
}
sub makePageFooter {
my $self = shift;
# some convoluted stuff to get the makePageFooter() of the embedded display instance
# blank the text, get the embedding to make a footer and then grab it back.
# this could be made a lot cleaner if makePageFooter() could detect context
# and return text if defined wantarray, and embed text if not.
$self->embed->text('');
$self->embed->makePageFooter();
my $text = $self->embed->text;
$self->appendText($text);
return;
}
}
###############################################################################
#
# class WikiEdit
#
# Displays a page for editing by the user.
# An instance of this class checks wiki text stored in itself before
# accessing the database: text may have been placed there already
# (eg WikiEditPreview)
{
package WikiEdit;
our @ISA = Page; # might need to be child of WikiPage
WikiEdit->register();
###########################################################
# Class conditions
sub propConditions { q[$$browseParameters{action} eq 'edit'] }
###########################################################
# Class defaults
sub titlePrefix {q[Editing ]}
#####################################
# WikiEdit::blessPage
sub blessPage {
# this is an inheritable constructor
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift;
bless $instance, $class;
$instance->{title} = $browseParameters->{id};
unless ( $instance->{title} ) {
# no page title given! Error!
blessPage PageError $instance,
q[No 'id' parameter given. Don't know which page to edit.];
return;
}
##################
# initialize DB, load text from it, handle errors and mishaps
# UNLESS the instance already holds some wiki text
# (it will have been placed there by something embedding this instance)
unless ( $instance->wiki ) {
my $database = $instance->{DBref} = DatabaseMono->new($instance);
# new() has failed to create a DB object?
ref $database or do {
blessPage PageError $instance,
q[Unable to load the page database or create one.];
return;
};
$database->loadWikiFromDB();
# loadWikiFromDB() has stored an error message?
$instance->error and do {
blessPage PageError $instance,
q[Error loading the page from the database.];
return;
};
# the wiki text stored by loadWikiFromDB() is blank?
$instance->wiki =~ /^\s*$/ and do {
$instance->title( Page->getConfiguration('NewPageEdit'));
# TODO: correct value must be restored for save!
$database->loadWikiFromDB();
};
}
}
###########################################################
# Content
# WikiEdit::makePageContent
#
# wiki content is already placed in the instance property
sub makePageContent {
my $self = shift;
# this needs major work inserting variables and making better use of CGI methods
my $editbox = << "EOT";
<div class="edit">
<form method="post" action="@{[$self->getScriptName]}"
enctype="application/x-www-form-urlencoded">
<input type="hidden" name="title" value="@{[$self->title]}">
<input type="hidden" name="oldtime" value="">
<input type="hidden" name="oldconflict" value="0">
<textarea name="text"
rows="15" cols="65" style="width: 100%;" accesskey="E"
tabindex="1" wrap="virtual">
@{[$self->wiki]}
</textarea>
<p>
<b>Summary:</b>
<input type="text" name="summary" value="*" size="60" maxlength="200" tabindex="2"><br />
<input type="checkbox" name="recent_edit" value="on">
This change is a minor edit. (Select this only for small changes like spelling or layout fixes.)
</p>
<p>
<input type="submit" name="Save" value="Save" class="editbutton" />
<input type="submit" name="Cancel" value="Cancel" class="editbutton" />
<input type="submit" name="Preview" value="Preview" class="editbutton" />
<input type="hidden" name=".cgifields" value="recent_edit"></form>
</p>
</div>
EOT
#$editbox .= $UseMooWiki::q->submit(-name=>'Preview', -value=>'Preview', -class=>"editbutton"), "\n";
$self->appendText($editbox);
return;
}
}
###############################################################################
#
# class WikiEditPreview
#
# Displays the Preview of a page.
# Uses the makePageContent() method of its parent, WikiEdit to make the edit
# box, and then creates an embedded instance to display the preview
# (the instance is force-fed the wikisource and then fooled into thinking
# it is a real page).
#
# BEWARE:
# Due to weirdness, Preview uses 'title' and Edit uses 'id'.
# This is a UseModWiki legacy glitch. According to Cliff it's a quirk :)
{
package WikiEditPreview;
our @ISA = WikiEdit;
WikiEditPreview->register();
###########################################################
# Class conditions
sub propConditions { q[$$browseParameters{Preview} eq 'Preview'] }
###########################################################
# Class defaults
sub titlePrefix {q[Previewing ]}
#####################################
# WikiEditPreview::blessPage
#
# Loads up the instance with the title and the wiki text
# for makePageContent to find.
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $browseParameters = shift;
bless $instance, $class;
$instance->{wiki} = ( $browseParameters->{text} );
$instance->{title} = ( $browseParameters->{title} );
unless ( $instance->{title} ) {
# no page title given! Error!
# not even sure it's POSSIBLE to get here, since these are POST params.
blessPage PageError $instance,
q[No 'title' parameter given. Don't know which page to preview.];
return;
}
}
###########################################################
# Content
# WikiEditPreview::makePageContent
sub makePageContent {
my $self = shift;
# edit box and buttons
$self->SUPER::makePageContent();
# embed an instance of WikiPage to make the preview
my %embeddedParameters;
$embeddedParameters{keywords} = $self->title;
# $embeddedParameters{embed} = 1;
# this is probably not needed.
# Setting $previewInstance->{wiki} should suffice to indicate
# that beatify is given an embedded instance
my $previewInstance = {};
# give the embedding some of the references and data we have
$previewInstance->{holder} = $self;
$previewInstance->{cgiref} = $self->cgiref;
$previewInstance->{wiki} = $self->wiki;
blessPage WikiPage $previewInstance, \%embeddedParameters;
# Preview does not need a database, but some previed pages might.
# consider making it the responsibility of page objects to check
# consider making the DBref accessor create a DB if none exists
$previewInstance->{DBref} = DatabaseMono->new($previewInstance);
$previewInstance->makePageContent;
my $previewText = $previewInstance->getText;
$self->appendText('<div class="preview">');
$self->appendText($previewText);
$self->appendText('</div>');
}
}
###############################################################################
#
# class WikiVersion
# Displays the version of the script
{
package WikiVersion;
our @ISA = Page;
WikiVersion->register();
###########################################################
# Class conditions
sub propConditions { q[$$browseParameters{action} eq 'version'] }
sub propPageTitle { q[Version information] }
###########################################################
# Content
sub makePageContent {
my $self = shift;
$self->appendText(q[<p>UseMOO version number</p>]);
return;
}
}
###############################################################################
#
# class PageError (non-registering)
#
# The special error-reporting page.
# This displays an error message and forces debug output.
{
package PageError;
our @ISA = Page;
###########################################################
# Class conditions
sub pageAccess { 'user' } # shouldn't be called, but anyway...
sub propPageTitle { q[Error page] }
#####################################
# PageError::blessPage
sub blessPage {
my $class = shift; $class = (ref $class or $class);
my $instance = shift; # a ref we will be blessing
my $message = shift; # error message passed to us
$instance->{error} = $message ||
q[Sorry, the lazy programmer hasn't even provided a decent error message to report!];
$instance->{title} = ''; # forces use of propPageTitle later.
bless $instance, $class;
}
###########################################################
# Content
sub makePageContent {
my $self = shift;
my $text = join '',
$self->cgiref->p(
q[Something's gone wrong with MooWiki.],
q[There should be an explanation below followed by the browser parameters for debugging.],
),
$self->cgiref->p(
$self->cgiref->b(
$self->error
)
);
$self->appendText($text);
}
}
###############################################################################
#
# package UseMooWiki
#
# The 'main' package. This:
#
# reads in additional modules
# initializes CGI
# puts some values (such as the request time) into a hash reference to be blessed
# sends it through the "Blessing Chain"
# Calls MakePage() on the resulting object
# prints to the browser the text property of the object
{
package UseMooWiki ;
use CGI;
use vars qw( $q $MaxPost $ThisPage );
#############################################################################
#
# Load plug-ins
#
# Plug-ins for Moo are modules named moo-*.pm
# These should contain classes that should register themselves appropriately
#
# Consider letting module filenames optionally say what type of classes
# they contain, eg moo-db-*.pm.
# Moo could then decide whether to load them or not later on.
# Consider allowing config to specify an order for certain modules... but YAGNI
my @modulefiles = <moo-*.pm>;
foreach (@modulefiles) {
require $_;
}
#############################################################################
#
# Log
# open LOG, ">> moologfile.txt" or die "can't open logfile: $!";
#############################################################################
#
# Handle CGI request
do {
# handle cache at this level, probably
#####################################
# Initialize CGI and get variables
$q = new CGI;
my %PageVariables = $q->Vars;
if( $ENV{PATH_INFO} && $ENV{PATH_INFO} ne '/' ) {
$PageVariables{keywords} = substr($ENV{PATH_INFO}, 1);
# stuff the path into the variables hash
# but if the path is just '/'
# DON'T bring the has into existence just for an empty string!
# this would muck up the !%$browseParameters condition in WikiPage
}
###############################################################################
# POD: Script URLs
=head1 Script URLs=
Order of precedence for URL is as follows.
The following go to the HomePage:
wiki.cgi
wiki.cgi/
wiki.cgi/?(anything) – because why put the / in unless you mean it?
The following go to the page named Foo
wiki.cgi/Foo?Bar – again, why say /Foo if you don't mean it?
wiki.cgi/Foo?(any actions)
wiki.cgi?Foo
=cut=
#
###############################################################################
# Equivalent (mostly) to UseMod's InitRequest
# create a hash reference that will become the page object
my $requestedPage = {
now => time,
cgiref => $q,
browserequest => { $q->Vars },
# consider accessing %PageVariables via this instead
# but remember the tweaking it undergoes for /
};
Page->chooseClass($requestedPage, \%PageVariables); # bless the reference
$requestedPage->makePage(); # make Page content
print $requestedPage->text;
} if ($Page::configuration{RunCGI} && ($_ ne 'nocgi'));
# see http://www.usemod.com/cgi-bin/wiki.pl?PersistentCGI
# load the wiki without running it. This is useful for PersistentCGI environments like mod_perl.
}
# End of script. Bye!
