|
|
#!perl
chdir "bin";
require qwikimain;
main();
#print "Content-type: text/html\n";
#print "\n";
#print "<br>cwd='", `cd`;
#
#foreach (sort keys %ENV)
# {
# print "<br>'$_' = '$ENV{$_}'\n";
# }
#print "<br>done\n";
|
|
|
#!perl -w
use strict;
#-------------------------
package App;
use Logger;
require qwcfg; # QwikWiki config
require WikiPage;
use Response;
use Request;
use PageRevision;
use Socket; # for gethostbyaddr
use CGI qw(:standard);
use qwiki;
#-------------------------
sub new
{
my $class = shift;
my $self = {};
$self->{mCGI} = new CGI;
$self->{mCurPage} = '';
bless($self, $class);
return $self;
}
#-------------------------
sub Init
{
my $self = shift;
$qwenv::htmlOut = '';
$qwenv::sessioninfo = '';
Response::CgiInit($self->getCGI());
Request::CgiInit($self->getCGI());
$qwenv::goodExit = 0; #undef; # END{} block prints err message if not set on exit
$qwenv::clientAddr = defined($ENV{'HTTP_CLIENT_ADDR'})?$ENV{'HTTP_CLIENT_ADDR'} : $ENV{'REMOTE_ADDR'};
$qwenv::clientAddr = "unknown" unless($qwenv::clientAddr);
$qwenv::referrerPage = GetReferrerPage();
$qwenv::clientHostName = _getHostName($qwenv::clientAddr);
$qwenv::clientName = '';
#$Global::gDebugger->DumpParameters($self->getCGI());
PageRevision::InitDB();
}
#------------
sub _getHostName
{
my $ip = shift;
return "unknown" unless ($ip && $ip ne "unknown");
my $iaddr = inet_aton($ip);
return "$ip-unknown" unless defined($iaddr);
my $name = gethostbyaddr($iaddr, AF_INET);
return ($name) ? $name : $ip;
}
#-------------------------
sub Term
{
my $self = shift;
PageRevision::TermDB();
$self->ClearExitFlag();
}
#-------------------------
sub RenderEnd
{
my $self = shift;
Response::Emit();
}
#-------------------------
sub IsGoodExit()
{
return $qwenv::goodExit ? 1 : 0;
}
#-------------------------
sub HandleRequest
{
my $self = shift;
#if require a login for editing, get the session information from the cookie set in the login form
if ($qwcfg::requirelogin)
{
my ($sinfo) = $self->getCGI()->cookie('sessioninfo');
$qwenv::sessioninfo = $sinfo;
my ($username, $ok, $token) = split(":", $qwenv::sessioninfo);
$qwenv::clientName = $username if defined $username;
}
return if $self->HandleLoginForm();
return if $self->HandleSearchResults();
return if $self->HandleSearchForm();
return if $self->HandleEdit();
return if $self->HandleEditCopy();
return if $self->HandleDiff();
return if $self->HandleSavePage();
$self->HandleView();
#Logger::logmsg("HandleRequest sessioninfo='$qwenv::sessioninfo'");
}
#--- PRIVATE
sub getCGI()
{
my $self = shift;
return $self->{mCGI};
}
#-------------------------
# Attempts to determine which Wiki page we came from, if any.
# (Doesn't differentiate between wheter we were viewing, editing, diffing, etc.)
# Note: currently expects any leading query keywords (like search=, edit=, etc.)
# will begin with a lowercase a-z.
sub GetReferrerPage
{
my $url = $ENV{'HTTP_REFERER'};
return "" unless ($url);
if ($url =~ /$qwcfg::qwikiUrl(?:[?]?$|[?](?:[a-z]+\w*=)?((?:[A-Z][a-z0-9]*){2,})\b)/so)
{
return ($1) ? $1 : $qwcfg::FrontPage;
}
return "";
}
#-------------------------
sub ClearExitFlag()
{
$qwenv::goodExit = 1;
}
#-------------------------
sub CurrentPage
{
my $self = shift;
return $self->{mCurPage};
}
#-------------------------
sub GetPageToView
{
my $self = shift;
$self->{mCurPage} = $self->getCGI()->param('keywords') || $qwcfg::FrontPage;
}
#-------------------------
sub IsAction
{
my $self = shift;
my $action = shift;
my $page = $self->getCGI()->param($action);
return 0 if !defined($page);
$self->{mCurPage} = $page;
return 1;
}
#-------------------------
sub InvokePageHandler
{
my $self = shift;
my $actionfunc = shift;
my @parms = @_;
#Logger::logmsg("InvokePageHandler: ", $self->CurrentPage());
my $wikipage = new WikiPage($self->CurrentPage());
$wikipage->$actionfunc(@parms);
}
#-------------------------
sub HandleAction
{
my $self = shift;
my $action = shift;
my $actionfunc = shift;
my @parms = @_;
return 0 if !$self->IsAction($action);
$self->InvokePageHandler($actionfunc, @parms);
return 1;
}
#-------------------------
sub HandleSearchForm
{
my $self = shift;
my $cgi = $self->getCGI();
my $page = $cgi->param('search');
if (defined($page))
{
$self->{mCurPage} = $page;
$self->InvokePageHandler('SearchForm');
return 1;
}
return 0 if !defined($cgi->param('keywords'));
return 0 if $cgi->param('keywords') ne 'search';
$self->InvokePageHandler('SearchForm');
return 1;
}
#-------------------------
sub HandleSearchResults
{
my $self = shift;
return $self->HandleAction('FulltextSearch', 'SearchResults');
}
#-------------------------
sub HandleEdit
{
my $self = shift;
my ($rev) = $self->getCGI()->param('rev');
my ($sinfo) = $self->getCGI()->cookie(-name => 'sessioninfo');
#Logger::logmsg("HandleEdit: getting cookie sessioninfo='$sinfo'");
return $self->HandleAction('edit', 'Edit', $rev);
}
#-------------------------
sub HandleEditCopy
{
my $self = shift;
my ($rev) = $self->getCGI()->param('rev');
$rev = -1 unless ($rev);
return $self->HandleAction('copy', 'EditCopy', $rev);
}
#-------------------------
sub HandleDiff
{
my $self = shift;
my ($oldRev) = $self->getCGI()->param('rev1');
my ($newRev) = $self->getCGI()->param('rev2');
return $self->HandleAction('diff', 'Diff', $oldRev, $newRev);
}
#-------------------------
sub HandleSavePage
{
my $self = shift;
my ($editedText) = $self->getCGI()->param('PageText');
my ($expectedRev) = $self->getCGI()->param('ExpectedRev');
return $self->HandleAction('SavePage', 'SavePage', $editedText, $expectedRev);
}
#-------------------------
sub HandleView
{
my $self = shift;
$self->GetPageToView();
$self->InvokePageHandler('View');
return 1;
}
#-------------------
sub HandleLoginForm
{
my $self = shift;
my $cgi = $self->getCGI();
#don't process login form, if we don't require a login for editing.
return 0 if (!$qwcfg::requirelogin);
#this is the submit button
return 0 if !defined($cgi->param('login'));
#these are the input fields
my ($username) = $cgi->param('username');
my ($password) = $cgi->param('password');
return 0 if !defined($username);
return 0 if !defined($password);
#Logger::logmsg("login: uid='$username' pwd='$password'");
$self->{mCurPage} = $cgi->param('pagetoedit');
Logger::logmsg("login: pagetoedit='$self->{mCurPage}'");
#search the users file for the given username and password
#assumes that the users.txt has unique usernames only,
#takes the password from the first username that matches...
open (USERSFH, "< $qwcfg::usersDbPath/users.txt") or die ("can't open $qwcfg::usersDbPath/users.txt: $!");
my ($u, $p);
while (<USERSFH>)
{
next if /^#/; #skip comments
next if /^\s*$/; #skip empty lines
($u, $p) = /^\s*([^:]*):([^\r\n\t ]+)\s*$/;
chomp $u;
chomp $p;
#Logger::logmsg("login: uid='$u' pwd='$p' not a comment or an empty line");
last if ($u eq $username);
}
close(USERSFH);
#if username or password don't match, ask the user again for them
if ($username ne $u || $password ne $p)
{
Response::DisplayBadLogin($self->CurrentPage());
return 1;
}
$qwenv::clientName = $username;
#generate a random token and put it in the user's file and in the sessioninfo
#used in the edit handler to check the user is logged in.
my $random = int(rand(10000));
$qwenv::sessioninfo = "$username:ok:$random";
open (USESSIONFH, "> $qwcfg::usersDbPath/user.$username\.txt");
print USESSIONFH "$username:$random";
close(USESSIONFH);
Logger::logmsg("login: sessioninfo='$qwenv::sessioninfo'");
Logger::logmsg("login: calling edit: page=", $self->CurrentPage());
$self->InvokePageHandler('Edit');
return 1;
}
1;
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
History:
=cut
package DateTime;
use POSIX qw(strftime);
sub Now
{
my ($y, $m, $d, $h, $mm, $s) = (localtime)[5,4,3,2,1,0];
return sprintf("%4.4d/%2.2d/%2.2d %2.2d:%2.2d:%2.2d", $y+1900, $m+1, $d, $h, $mm, $s) ;
}
sub getSaveDate
{
my ($saveTime) = @_;
return strftime("%b %d %Y", localtime($saveTime));
}
sub getSaveTime
{
my ($saveTime) = @_;
return strftime("%H:%M:%S", localtime($saveTime));
}
sub getDiffTime
{
local($^W) = undef;
my ($old, $new) = @_;
my $sec = abs($new - $old);
my $min = int($sec / 60) % 60;
my $hour = int($sec / 3600) % 24;
my $day = int($sec / 86400) % 7;
my $week = int($sec / (86400*7)) % 52;
my $year = int($sec / (86400*364)); # (52 weeks exactly... close enough :)
$min = 1 if ($sec < 60);
my @comp;
push(@comp, "$year year" . (($year == 1)? "" : "s")) if ($year);
push(@comp, "$week week" . (($week == 1)? "" : "s")) if ($week);
push(@comp, "$day day" . (($day == 1)? "" : "s")) if ($day);
push(@comp, "$hour hour" . (($hour == 1)? "" : "s")) if ($hour);
push(@comp, "$min minute" . (($min == 1)? "" : "s"));
return join(', ', @comp);
}
sub timeSinceRevEdit
{
my ($rev, $revTime, $curTime, $authAddr) = @_;
my $diffTime = getDiffTime($revTime, $curTime);
return qq{<b>}
. qq{Revision $rev was edited $diffTime ago by $authAddr.}
. qq{</b>\n};
}
1;
|
|
|
#!perl -w
use strict;
package Debugger;
use Logger;
sub new
{
my $class = shift;
my $self = {};
$self->{mIsOn} = 0;
bless($self, $class);
return $self;
}
sub On()
{
my $self = shift;
$self->{mIsOn} = 1;
}
sub DumpEnvStrings()
{
my $self = shift;
return if !$self->{mIsOn};
foreach (sort keys %ENV)
{
Logger::rawlogmsg "'$_' = '$ENV{$_}'";
}
Logger::rawlogmsg "done env strings";
# Logger::rawlogmsg "querystring = '$ENV{QUERY_STRING}'";
# Logger::rawlogmsg "contenttype = '$ENV{CONTENT_TYPE}'";
# Logger::rawlogmsg "rqst_method = '$ENV{REQUEST_METHOD}'";
}
sub DumpParameters($)
{
my $self = shift;
return if !$self->{mIsOn};
my $cgi = shift;
if (defined($cgi->param()))
{
Logger::rawlogmsg "num param='",scalar $cgi->param(),"'";
foreach ($cgi->param())
{
Logger::rawlogmsg " param: '$_'='", $cgi->param($_), "'";
}
}
}
1;
|
|
|
=head1 FSDBM_File.pm (V0.0.1)
Simple direct-filesystem tied hash interface.
Usage:
tie(%hash, 'FSDBM_File', 'in_fact/its_really_a_dir');
Keyname restrictions:
(to-do - document)
History:
BWK 6 May 00 -- Written; Bill Kelly <billk@cts.com>
Permission to copy, use, modify, sell and distribute this software
is granted provided this copyright notice appears in all copies.
Copyright (C) 2000 Bill Kelly / Full Body Groove. All Rights Reserved.
This software is released in the hope it will be useful, but please
understand you use it at your own risk.
THIS SOFTWARE IS PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES
OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
=cut
package FSDBM_File;
use strict;
use Fcntl ':flock'; # import LOCK_* constants
use IO::Handle;
use Carp;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = ( );
%EXPORT_TAGS = ( );
@EXPORT_OK = ( );
}
my $m_dbLockFilename = ".FSDBM_File.lock";
# Undefined keys are set to the following kludge-signature.
# (32 bytes consisting of binary-coded-decimal Pi, with a text identifier
# sandwiched in the middle :)
my $m_undefKludgeVal = "\x31\x41\x59\x26\x53\x58\x97\x93"
."FSDBM_File.undef"
."\x23\x84\x62\x64\x33\x83\x27\x95";
sub whowasi { (caller(1))[3] }
sub TIEHASH {
my $proto = shift;
my $class = ref($proto) || $proto;
croak "Usage: @{[&whowasi]} database_root_dir" unless (scalar(@_) == 1);
my $dbRoot = normalizePath(shift);
my $self = {
DBROOT => $dbRoot,
DBLOCK_FH => IO::Handle->new(),
DBLOCK_REF => 0, # reference count
};
bless ($self, $class);
$self->_dbCreateOrOpen();
return $self;
}
sub FETCH {
my $self = shift;
my ($key) = @_;
my $keyPath = $self->_getKeyPath($key);
my $keyVal = undef;
my $fh = IO::Handle->new();
$self->LockDb();
eval {
if (-f $keyPath) {
local($/) = undef;
open($fh, "$keyPath")
or croak "Error: @{[&whowasi]} Couldn't open keyfile $keyPath for read";
$keyVal = <$fh>;
close($fh);
}
};
my $err = $@;
$self->UnlockDb();
undef $fh;
croak "$err" if ($err); # rethrow exception if any
$keyVal = undef if (defined($keyVal) && $keyVal eq $m_undefKludgeVal);
return $keyVal;
}
sub EXISTS {
my $self = shift;
my ($key) = @_;
my $keyPath = $self->_getKeyPath($key);
$self->LockDb(); # lock even here to honor atomic transactions in progress by other processes
my $keyExists = (-f $keyPath);
$self->UnlockDb();
return $keyExists;
}
sub STORE {
my $self = shift;
my ($key, $keyVal) = @_;
$keyVal = $m_undefKludgeVal unless defined($keyVal);
my $keyPath = $self->_getKeyPath($key);
createPathToFile($keyPath); # OK outside of lock
my $fh = IO::Handle->new();
$self->LockDb();
eval {
open($fh, ">$keyPath")
or croak "Error: @{[&whowasi]} Couldn't open keyfile $keyPath for write";
print $fh ($keyVal);
close($fh);
};
my $err = $@;
$self->UnlockDb();
undef $fh;
croak "$err" if ($err); # rethrow exception if any
return $keyVal; # or could return undef(?)
}
sub DELETE {
my $self = shift;
my ($key) = @_;
my $keyPath = $self->_getKeyPath($key);
$self->LockDb();
unlink($keyPath) if (-f $keyPath);
$self->UnlockDb();
# Untied hash semantics returns value-before-deletion, but the docs
# indicate tied hashes don't necessarily have to. Not sure whether
# we should or not, but for now - we won't. (To return the value
# we'd have to read it off disk.)
return undef;
}
sub CLEAR {
my $self = shift;
# Note: Like the example in the perltie docs, we should probably
# disable the clear by default, and only allow it if the user
# specifically requests it be enabled.
# IN FACT, with this operation equating literally to an
# 'rm -rf $dbRoot' I wouldn't want to chance it at all.
croak "Error: @{[&whowasi]} Operation not supported (considered too dangerous)";
}
sub FIRSTKEY {
my $self = shift;
my $dbRoot = $self->{DBROOT};
my @keyList = findFiles($dbRoot);
my $key = shift(@keyList);
$self->{_FIRSTKEY_keyList} = \@keyList if defined($key);
return $key;
}
sub NEXTKEY {
my $self = shift;
my $keyList = $self->{_FIRSTKEY_keyList};
my $key = shift(@$keyList);
$self->{_FIRSTKEY_keyList} = undef unless defined($key);
return $key;
}
sub DESTROY {
my $self = shift;
$self->_dbClose();
}
sub LockDb {
my $self = shift;
if (! $self->{DBLOCK_REF}) {
flock($self->{DBLOCK_FH}, LOCK_EX)
or croak "Error: @{[&whowasi]} flock() failed obtaining master database lock";
}
$self->{DBLOCK_REF}++;
}
sub UnlockDb {
my $self = shift;
if ($self->{DBLOCK_REF}) {
flock($self->{DBLOCK_FH}, LOCK_UN) unless (-- $self->{DBLOCK_REF});
}
else {
carp "Warning: @{[&whowasi]} Unlock with no existing lock(s)";
}
}
sub _dbCreateOrOpen {
my $self = shift;
# Create path to database root if necessary
my $dbRoot = $self->{DBROOT};
createPath($dbRoot);
# Open master database lock file (creating if necessary)
my $dbLock = "$dbRoot/$m_dbLockFilename";
open($self->{DBLOCK_FH}, ">>$dbLock")
or croak "Error: @{[&whowasi]} Couldn't open or create master database lock $dbLock";
}
sub _dbClose {
my $self = shift;
# warn if outstanding locks on db
if ($self->{DBLOCK_REF}) {
carp "Warning: @{[&whowasi]} outstanding database locks at close: $self->{DBLOCK_REF}";
$self->{DBLOCK_REF} = 1; # force next unlock to take
$self->UnlockDb();
}
close($self->{DBLOCK_FH}) if defined($self->{DBLOCK_FH});
}
sub _getKeyPath {
my $self = shift;
my ($key) = @_;
my $dbRoot = $self->{DBROOT};
return "$dbRoot/$key";
}
=head2 normalizePath (string $path)
Return copy of $path with trailing slash removed, if any.
=cut
sub normalizePath {
my ($path) = @_;
$path =~ s{/$}{}; # remove trailing slash, if any
return $path;
}
=head2 createPath (string $path)
Create every directory component in path, when not already existing.
Die if any component exists, but is not a directory.
=cut
sub createPath {
my ($path) = @_;
return if (-d $path);
my $dir = "";
while ($path =~ m{(^|/)[^/]+}g) {
$dir .= $&;
if (-e $dir) {
croak "Error: @{[&whowasi]} existing path component is non-directory"
unless (-d $dir);
}
else {
my $ok = mkdir($dir, 0777);
croak "Error: @{[&whowasi]} mkdir $dir for path $path failed"
unless ($ok);
}
}
}
=head2 createPathToFile (string $fullPath)
Create every directory component in path, when not already existing.
Die if any directory component exists, but is not a directory.
Final component of path is treated as the filename, and is ignored.
=cut
sub createPathToFile {
my ($fullPath) = @_;
createPath($1) if ($fullPath =~ m{^(.*)/.*$});
}
sub findFiles {
my ($rootPath) = @_;
$rootPath = normalizePath($rootPath);
croak "Error: @{[&whowasi]} given path $rootPath is non-directory"
unless (-d $rootPath);
my @fileList = ();
my $hasSubdirs = ((stat($rootPath))[3] != 2);
_recursiveFindFiles($rootPath, "", $hasSubdirs, \@fileList);
return @fileList;
}
sub _recursiveFindFiles {
my ($fullPath, $relPath, $hasSubdirs, $fileList) = @_;
if (! opendir(DIR, $fullPath)) {
carp "Warning: @{[&whowasi]} can't read dir $fullPath";
return;
}
my @entries = readdir(DIR);
closedir(DIR);
my $entry;
foreach $entry (@entries) {
next if ($entry eq '.' || $entry eq '..' ||
$entry eq $m_dbLockFilename);
my $entryFullPath = "$fullPath/$entry";
my $entryRelPath = "$relPath$entry";
if ($hasSubdirs && -d $entryFullPath) {
my $subHasSubdirs = ((stat(_))[3] != 2);
_recursiveFindFiles($entryFullPath, "$entryRelPath/", $subHasSubdirs, $fileList);
}
else {
push(@$fileList, $entryRelPath);
}
}
}
1;
# eof
|
|
|
=head1 FulltextIndexer_Adaptor.pm (V0.0.4)
Incremetal fulltext-indexing tied hash interface.
Usage:
my %ftDatabase;
my %ftIndexer;
tie(%ftDatabase, AnyDBM_File, ...);
tie(%ftIndexer, FulltextIndexer_Adaptor,
\%ftDatabase, 0, "stopwords.txt", \&myWordStemmer);
$ftIndexer{documentName} = $documentText; # index document text
$resultsHash = $ftIndexer{someword}; # return all documents containing someword
($docName, $numOccurrances) = each(%$resultsHash);
Keyname restrictions:
(to-do - document)
=cut
package FulltextIndexer_Adaptor;
use strict;
use porter;
use IO::Handle;
use Carp;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = ( );
%EXPORT_TAGS = ( );
@EXPORT_OK = ( );
}
sub whowasi { (caller(1))[3] }
sub TIEHASH {
my $proto = shift;
my $class = ref($proto) || $proto;
croak "Usage: @{[&whowasi]} \\\%storage_hashref use_locking_flag stopwords_file [stemmer_func]\n"
.'Example: tie(%interfaceHash, FulltextIndexer_Adaptor, \%storageDatabase, 1, "stopwords.txt", \&myStemmer);'
unless (scalar(@_) == 3 || scalar(@_) == 4); # stemmer optional
my ($storage, $useLocking, $stopFile, $stemmer) = @_;
my %stopwords;
loadStopwordsFile($stopFile, \%stopwords);
my $self = {
STORAGE => $storage,
LOCKING => $useLocking,
STOPWORDS => \%stopwords,
STEMMER => $stemmer,
};
bless ($self, $class);
return $self;
}
sub FETCH {
my $self = shift;
my ($wordName) = @_;
$wordName = lc($wordName);
my $stemmer = $self->{STEMMER};
$wordName = &$stemmer($wordName) if defined($stemmer);
my $key = wordToKey($wordName);
my $docNames = {};
$self->LockDb();
eval {
$self->_fetchSimpleHash($key, $docNames);
};
my $err = $@;
$self->UnlockDb();
croak "$err" if ($err); # rethrow exception if any
return $docNames; # values are count of occurrances of corresponding key/words in document
}
sub STORE {
my $self = shift;
my ($docName, $fullText) = @_;
# make literal keyname from $docKey
# get stopword-stripped unique wordlist from $fullText
# fetch previous (currently-stored) wordlist from $key
# remove non-new old words
# add non-old new words
my $key = docToKey($docName);
my %newWords;
$fullText = "" unless defined($fullText);
uniqueWordsFromFulltext($fullText, $self->{STOPWORDS},
$self->{STEMMER}, \%newWords);
$self->LockDb();
eval {
my %oldWords;
$self->_fetchSimpleHash($key, \%oldWords);
my $word; # !heh
foreach $word (keys %oldWords) {
next if defined($newWords{$word});
$self->_removeWordRef($word, $docName);
}
foreach $word (keys %newWords) {
next if defined($oldWords{$word});
$self->_addWordRef($word, $docName, $newWords{$word});
}
$self->_storeSimpleHash($key, \%newWords);
};
my $err = $@;
$self->UnlockDb();
croak "$err" if ($err); # rethrow exception if any
return 1; # just so retval isn't 'random'
}
sub EXISTS {
my $self = shift;
my ($docName) = @_;
my $key = docToKey($docName);
return exists $self->{STORAGE}->{$key};
}
sub DELETE {
my $self = shift;
my ($docName) = @_;
$self->LockDb();
eval {
$self->STORE($docName, undef); # remove this doc's word references
my $key = docToKey($docName);
delete $self->{STORAGE}->{$key};
};
my $err = $@;
$self->UnlockDb();
croak "$err" if ($err); # rethrow exception if any
return undef;
}
sub FIRSTKEY {
my $self = shift;
return $self->_nextKey();
}
sub NEXTKEY {
my $self = shift;
# my ($lastKey) = @_;
return $self->_nextKey();
}
sub CLEAR {
my $self = shift;
croak "Error: @{[&whowasi]} Operation not supported (considered too dangerous)";
}
sub DESTROY {
my $self = shift;
# Currently, all allocated resources automatically
# cleaned up when our hash goes away
}
sub LockDb {
my $self = shift;
if ($self->{LOCKING}) {
tied(%{$self->{STORAGE}})->LockDb();
}
}
sub UnlockDb {
my $self = shift;
if ($self->{LOCKING}) {
tied(%{$self->{STORAGE}})->UnlockDb();
}
}
sub IsStopword {
my $self = shift;
my ($word) = @_;
return defined($self->{STOPWORDS}->{$word});
}
sub _nextKey {
my $self = shift;
my $stor = $self->{STORAGE};
my ($key) = each %$stor;
while (defined($key) && ! isDocKey($key)) {
($key) = each %$stor;
}
$key = keyToDoc($key) if defined($key);
return $key;
}
sub _removeWordRef {
my $self = shift;
my ($word, $docName) = @_;
my $key = wordToKey($word);
my %wordRefs;
$self->_fetchSimpleHash($key, \%wordRefs);
delete $wordRefs{$docName};
if (scalar keys %wordRefs) {
$self->_storeSimpleHash($key, \%wordRefs);
}
else {
delete $self->{STORAGE}->{$key}; # word no longer appears in any indexed document
}
}
sub _addWordRef {
my $self = shift;
my ($word, $docName, $numOccurances) = @_;
my $key = wordToKey($word);
my %wordRefs;
$self->_fetchSimpleHash($key, \%wordRefs);
$wordRefs{$docName} = $numOccurances;
$self->_storeSimpleHash($key, \%wordRefs);
}
sub _fetchSimpleHash {
my $self = shift;
my ($key, $hash) = @_;
my $stor = $self->{STORAGE};
my $hashStr = $$stor{$key};
$hashStr = "" unless defined($hashStr);
%$hash = split("\012", $hashStr, -1); # -1 = split even trailing null field(s)
}
sub _storeSimpleHash {
my $self = shift;
my ($key, $hash) = @_;
my $hashStr = join("\012", %$hash);
my $stor = $self->{STORAGE};
$$stor{$key} = $hashStr;
}
sub docToKey {
my ($docName) = @_;
return ".keys./$docName";
}
sub wordToKey {
my ($wordName) = @_;
$wordName = lc($wordName);
my $sub; # provide two-letter subdirectories for fewer words in each dir
if ($wordName =~ /^(.{1,2})/) {
$sub = $1;
$sub .= '_' if (length($sub) == 1);
}
else {
$sub = "__";
}
return ".words./$sub/$wordName";
}
sub keyToDoc {
my ($key) = @_;
$key =~ s{^\.keys\./}{};
return $key;
}
# sub keyToWord {
# my ($key) = @_;
# $key =~ s{^\.words\./../}{};
# return $key;
# }
sub isDocKey {
my ($key) = @_;
return $key =~ m{^\.keys\./};
}
sub uniqueWordsFromFulltext {
my ($fullText, $stopwords, $stemmer, $keepwords) = @_;
$fullText = lc($fullText);
$fullText =~ s/\b([a-z])[+][+]/uc($1)."PP"/gse; # consider c++, j++ etc. words
my @words = split(/[^a-zA-Z0-9]+/, $fullText); # underscore not included
my $word;
foreach $word (@words) {
$word =~ s/([A-Z])PP/lc($1)."++"/ge; # restore c++, j++, etc.
next if (length($word) < 2);
next if defined ($$stopwords{$word});
$word = &$stemmer($word) if defined($stemmer);
$$keepwords{$word}++; # value will be number of occurances of word in text
}
}
sub loadStopwordsFile {
my ($stopFile, $stopwords) = @_;
my $fh = IO::Handle->new();
open($fh, $stopFile)
or croak "Error: @{[&whowasi]} Couldn't open stopwords file $stopFile";
my $line;
while (defined($line = <$fh>)) {
chomp $line;
$line =~ s/#.*$//; # strip comments
next unless $line =~ /(\w+)/;
my $wd = lc($1);
$$stopwords{$wd} = 1;
}
close($fh);
}
1;
# eof
|
|
|
#!perl -w
use strict;
package Logger;
use DateTime;
sub Init()
{
open (STDERR, ">>qwikilog.txt");
use CGI::Carp qw(carpout);
carpout(*STDERR);
}
sub logmsg
{
rawlogmsg(_MsgHeader(), @_);
}
sub rawlogmsg
{
print STDERR @_, "\n";
}
sub _MsgHeader
{
return "[" . DateTime::Now() . "-" . _ProgName() . "-" . _RemoteHost() . "] ";
}
sub _ProgName
{
my $progName = $0;
$progName =~ s{\\}{/}g;
$progName =~ s{^.*/(.*)$}{$1};
return $progName;
}
sub _RemoteHost
{
return defined($ENV{'HTTP_CLIENT_ADDR'}) ? ENV{'HTTP_CLIENT_ADDR'} : $ENV{'REMOTE_ADDR'};
}
1;
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
History:
=cut
package Markup;
use CGI ':standard';
use Render;
use WikiPageRenderer;
use PageRevision;
use qwdiff;
#------------
sub StripWikiMetaChars
{
my ($textRef) = @_;
$$textRef =~ s/`(`*)/$1/gse; # gobble one back-tick (WikiName`s handler)
}
#------------
sub PageText
{
my ($pagename, $pagetext) = @_;
return "Describe $pagename here" if !defined($pagetext);
return Markup::Page($pagetext);
}
#------------
sub Page
{
my ($plain) = @_;
return _markupWikiPage(_ConvertHtmlTags($plain));
}
#------------
sub PageDiffs
{
my ($old, $new) = @_;
my $diff = qwdiff::hilightPageDiffs(_ConvertHtmlTags($old), _ConvertHtmlTags($new));
return _markupWikiPage($diff);
}
#------------
sub WikiLinksIn
{
my ($pageTextRef) = @_;
{
local($^W) = 0; # warnings off temporarily - the undef values are intentionally used below
# \x60 below is back-tick (`)
$$pageTextRef =~ s{\b(mailto|http|ftp|wiki|embed|viewport):}{lc($&)}gsei;
$$pageTextRef =~ s` (?: \b((?:[A-Z]+[a-z0-9]*){2,})\b ) |
( \b mailto:[^\s]+?[@][^\s)'\x60<]+ ) |
( \b http:[^\s)'\x60<]+ ) |
( \b ftp:[^\s)'\x60<]+ ) |
( \b wiki:[A-Za-z0-9]+ ) |
( \b embed:[A-Za-z0-9]+ ) |
( \b viewport:[A-Za-z0-9]+ )
` ($1) ? WikiLink($1): _markupUrl("$2$3$4$5$6$7")
`gsex;
}
}
#------------
sub WikiLink
{
my ($name) = @_;
my $strippedName = $name;
StripWikiMetaChars(\$strippedName);
# If name exists in database, mark it up (even if non-strict WikiName)
# Only automatically provide edit links for strict WikiNames.
# Names like CLanguage or BASIC must be created manually (via
# the edit URL), but will then be marked up once they exist
# in the database.
return Render::ExistingPageLink($name, $strippedName) if PageRevision::Exists($strippedName);
return Render::NonExistingPageLink($strippedName) if _validStrictWikiName($strippedName);
return $name;
}
#--- PRIVATE ----
sub _ConvertHtmlTags
{
my ($text) = @_;
$text =~ s/</</gs;
$text =~ s/>/>/gs;
return $text;
}
#------------
sub _markupWikiPage
{
my $renderer = new WikiPageRenderer(shift);
return $renderer->Text();
}
#------------
sub _validStrictWikiName
{
my ($name) = @_;
return $name =~ /^(?:[A-Z]+[a-z0-9]+){1,}$/s; # (strict AbCd names)
}
#------------
sub _markupUrl
{
my ($url) = @_;
return _markupInterWikiUrl($1) if ($url =~ m{^wiki:(.*)$}i);
return _markupViewPort($1) if ($url =~ m{^viewport:(.*)$}i);
return _markupEmbedUrl($1) if ($url =~ m{^embed:(.*)$}i);
return _markupMailtoUrl($url) if ($url =~ m{^mailto:(.*)$}i);
return _markupFtpUrl($url) if ($url =~ m{^ftp:(.*)$}i);
return _markupHttpUrl($url) if ($url =~ m{^http:(.*)$}i);
die "unknown markup type: '$url'";
}
sub _markupMailtoUrl
{
return Render::Url(shift);
}
sub _markupFtpUrl
{
my ($url) = @_;
my $dispurl = $url;
$url =~ s{^ftp:([^/])}{$qwcfg::serverUrl/$1}; #adjust for local url
return Render::Url($url, $dispurl);
}
sub _markupHttpUrl
{
my ($url) = @_;
my $dispurl = $url;
$url =~ s{^http:([^/])}{$qwcfg::serverUrl/$1}; #adjust for local url
return Render::Image($url) if ($url =~ m{\.(gif|jpg|jpeg|png)$}i);
return Render::Url($url, $dispurl); # break out of frames
}
sub _markupInterWikiUrl
{
my ($pageName) = @_;
my $url = "$qwcfg::interWikiUrl$pageName";
my $displaytext = qq{<font size='-3'>Wiki:</font>} . $pageName;
return Render::Url($url, $displaytext);
}
sub _markupViewPort
{
my ($pageName) = @_;
my $page = new PageRevision($pageName);
$page->Fetch();
my $dts = $page->SaveTimeAsString();
return Render::ViewPortToolBar($pageName, Markup::PageText($pageName, $page->Text()), $dts);
}
sub _markupEmbedUrl
{
my ($pageName) = @_;
my $page = new PageRevision($pageName);
$page->Fetch();
return Markup::PageText($pageName, $page->Text());
}
1;
|
|
|
#!perl -w
use strict;
=head1 PageBarRenderer
Purpose: Helper class to render the top of the page, the "Page Bar"
=cut
package PageBarRenderer;
use CGI ':standard';
use Render;
#------------------
sub new
{
my $class = shift;
my $self = {};
$self->{mPageName} = shift;
$self->{mDisplayName} = shift;
$self->{mLastEditDate} = shift;
$self->{mReferenceList} = shift;
$self->{mIsEditForm} = 0;
$self->{mIsSearchForm} = 0;
bless($self, $class);
return $self;
}
#------------------
sub Get
{
my $self = shift;
return table
(
{-border=>'0px', -cellspacing=>'0px'},
Tr(
td($self->_RenderLogo()),
td({-width=>'100%'}, $self->_RenderInfoBar())
)
);
}
#------------------
sub GetSearch
{
my $self = shift;
$self->{mIsSearchForm} = 1;
return $self->Get();
}
#------------------
sub GetEditForm
{
my $self = shift;
$self->{mAllowEditCopy} = shift;
$self->{mIsEditForm} = 1;
return $self->Get();
}
#------------------
#-- PRIVATE
#------------------
#------------------
sub _RenderLogo
{
return img({src=>"$qwcfg::qwikiBaseGif"});
}
#------------------
sub _RenderInfoBar
{
my $self = shift;
return table(
{-border=>'0px', -cellspacing=>'0px', -width=>'100%'},
Tr(
[
td( $self->_RenderPageTitle() ),
td( $self->_RenderToolBar() ),
td( $self->{mReferenceList} )
]
)
);
}
#------------------
sub _RenderPageTitle
{
my $self = shift;
my $t1 = Render::Link($self->{mPageName}, $self->{mDisplayName}, 'search');
my $bigtitle = font({-size=>'+3'}, $t1);
return $bigtitle . ' ' . $self->{mLastEditDate};
}
#------------------
sub _RenderToolBar
{
my $self = shift;
return $self->_RenderEditToolBar() if $self->{mIsEditForm} == 1;
return $self->_RenderSearchToolBar() if $self->{mIsSearchForm} == 1;
return $self->_RenderViewToolBar();
}
#------------------
sub _RenderViewToolBar
{
my $self = shift;
my @list;
#don't allow RecentChanges to be edited...
if ($self->{mPageName} ne $qwcfg::RecentChanges)
{
push @list, $self->_RenderChangesLink();
push @list, $self->_RenderEditLink();
}
push @list, $self->_RenderSearchLink();
if ($self->{mPageName} ne $qwcfg::RecentChanges)
{
push @list, $self->_RenderGoodStyleLink();
}
$self->_RenderGenericToolBar(@list);
}
#------------------
sub _RenderEditToolBar
{
my $self = shift;
my @list;
push @list, $self->_RenderEditCopyLink() if $self->{mAllowEditCopy};
push @list, $self->_RenderGoodStyleLink();
$self->_RenderGenericToolBar(@list);
}
#------------------
sub _RenderSearchToolBar
{
my $self = shift;
my @list;
$self->_RenderGenericToolBar(@list);
}
#------------------
sub _RenderGenericToolBar
{
my $self = shift;
my @list = @_;
return table(
{-border=>'1px', -cellspacing=>'0px'},
Tr(
td({-style=>'background-color:lightblue;'}, \@list)
)
);
}
#------------------
sub _RenderGoodStyleLink
{
my $self = shift;
return Render::Link("GoodStyle", "GoodStyle");
}
#------------------
sub _RenderEditCopyLink
{
my $self = shift;
return Render::Link($self->{mPageName}, "EditCopy", "copy");
}
#------------------
sub _RenderChangesLink
{
my $self = shift;
return Render::Link($qwcfg::RecentChanges, $qwcfg::RecentChanges);
}
#------------------
sub _RenderEditLink
{
my $self = shift;
return Render::Link($self->{mPageName}, "Edit", "edit");
}
#------------------
sub _RenderSearchLink
{
my $self = shift;
return Render::Link($self->{mPageName}, "Search", "search");
}
1;
|
|
|
#!perl -w
use strict;
package PageDB;
require FSDBM_File;
sub Init()
{
%qwdbm::pages = ();
%qwdbm::revs = ();
tie(%qwdbm::pages, 'FSDBM_File', $qwcfg::pagesDbPath);
tie(%qwdbm::revs, 'FSDBM_File', $qwcfg::revsDbPath);
}
sub Term()
{
untie(%qwdbm::revs);
untie(%qwdbm::pages);
}
sub LockPages()
{
tied(%qwdbm::pages)->LockDb();
}
sub UnlockPages()
{
tied(%qwdbm::pages)->UnlockDb();
}
sub LockRevs()
{
tied(%qwdbm::revs)->LockDb();
}
sub UnlockRevs()
{
tied(%qwdbm::revs)->UnlockDb();
}
sub FetchLatestText($)
{
my ($page) = @_;
my $meta = FetchMeta(\%qwdbm::pages, $page);
return $$meta{SCRAMBLED} ? _Unscramble($qwdbm::pages{$page}) : $qwdbm::pages{$page};
}
sub FetchLatestMeta($)
{
my ($page) = @_;
return FetchMeta(\%qwdbm::pages, $page);
}
sub FetchMetaForRev($$)
{
my ($page, $rev) = @_;
return FetchMeta(\%qwdbm::revs, $page . '.' . $rev);
}
sub CopyLatestAsRevision($$)
{
my ($page, $rev) = @_;
$qwdbm::revs{$page . '.' . $rev} = $qwdbm::pages{$page};
}
sub CopyLatestMetaAsRevision($$$)
{
my ($page, $rev, $oldMeta) = @_;
PageDB::StoreMeta(\%qwdbm::revs, $page . '.' . $rev, $oldMeta);
}
sub Exists($)
{
my ($page) = @_;
return exists($qwdbm::pages{$page});
}
sub Save($$$)
{
my ($page, $text, $newMeta) = @_;
if (defined($text))
{
PageDB::_Save($page, $text, $newMeta);
}
else
{
PageDB::_Delete($page, $newMeta);
}
}
sub _Save($$)
{
my ($page, $text, $newMeta) = @_;
if ($qwcfg::scramble == 1)
{
$qwdbm::pages{$page} = _Scramble($text);
$$newMeta{SCRAMBLED} = 1;
}
else
{
$qwdbm::pages{$page} = $text;
$$newMeta{SCRAMBLED} = 0;
}
PageDB::StoreMeta(\%qwdbm::pages, $page, $newMeta);
}
sub _Delete($$)
{
my ($page, $newMeta) = @_;
delete $qwdbm::pages{$page};
PageDB::StoreMeta(\%qwdbm::pages, $page, $newMeta);
}
sub _Scramble($)
{
my ($text) = @_;
$text =~ tr/abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/9abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345678/;
return $text;
}
sub _Unscramble($)
{
my ($text) = @_;
$text =~ tr/9abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345678/abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/;
return $text;
}
sub Fetch($)
{
return FetchRevision(shift, 0);
}
sub FetchRevision
{
my ($pageName, $wantRev) = @_;
LockPages();
my $pageMeta = PageDB::FetchMeta(\%qwdbm::pages, $pageName);
my $curRev = $$pageMeta{REV};
my $getRev = ($wantRev < 1)? ($curRev + $wantRev) : $wantRev;
my $pageText;
if ($getRev == $curRev)
{
$pageText = FetchLatestText($pageName); # already have current meta
}
else
{
$pageMeta = PageDB::FetchMeta(\%qwdbm::revs, $pageName . '.' . $getRev);
$pageText = $$pageMeta{SCRAMBLED} ? _Unscramble($qwdbm::revs{$pageName . '.' . $getRev}) : $qwdbm::revs{$pageName . '.' . $getRev};
unless ($$pageMeta{REV} == $getRev)
{
Logger::logmsg("_fetchPageRev: meta rev " . $$pageMeta{REV} ." not equal keyname rev $getRev for page $pageName");
$$pageMeta{REV} = $getRev;
}
}
UnlockPages();
return ($pageText, $pageMeta);
}
sub FetchTwoRevisions($$$)
{
my ($pageName, $oldRev, $newRev) = @_;
LockPages;
my ($oldText, $oldMeta) = PageDB::FetchRevision($pageName, $oldRev);
my ($newText, $newMeta) = PageDB::FetchRevision($pageName, $newRev);
UnlockPages();
return ($oldText, $oldMeta, $newText, $newMeta);
}
sub StoreMeta
{
my ($db, $pageName, $pageMeta) = @_;
$$db{"$pageName.meta"} = _simpleHashToString($pageMeta);
}
sub FetchMeta
{
my ($db, $pageName) = @_;
my $pageMeta = _simpleHashFromString($$db{"$pageName.meta"});
$$pageMeta{REV} = 1 unless defined($$pageMeta{REV});
$$pageMeta{AUTHIP} = "unknown" unless defined($$pageMeta{AUTHIP});
$$pageMeta{AUTHADDR} = "unknown" unless defined($$pageMeta{AUTHADDR});
$$pageMeta{SAVETIME} = 0 unless defined($$pageMeta{SAVETIME});
$$pageMeta{SCRAMBLED} = 0 unless defined($$pageMeta{SCRAMBLED});
return $pageMeta;
}
sub _simpleHashToString
{
my ($hash) = @_;
my $str = "";
my $elem;
foreach $elem (%$hash)
{
if (defined($elem))
{
$elem =~ s/[%]/%25/gs;
$elem =~ s/[\011]/%09/gs; # tab-char used for undef
$elem =~ s/[\012]/%0a/gs; # newline used as field separator below
}
else
{
$elem = "\011";
}
$str .= "$elem\012";
}
return $str;
}
sub _simpleHashFromString
{
local($^W) = 0; # warnings off temporarily - the undef values are intentionally used below
my ($str) = @_;
my $hash = {};
while ($str =~ /([^\012]*)\012([^\012]*)\012/gs)
{
my ($key, $val) = ($1, $2);
_decodeHashStringElem(\$key);
_decodeHashStringElem(\$val);
$$hash{$key} = $val;
}
return $hash;
}
sub _decodeHashStringElem
{
my ($elemRef) = @_;
if ($$elemRef eq "\011")
{
$$elemRef = undef;
}
else
{
$$elemRef =~ s/[%]0a/\012/gsi;
$$elemRef =~ s/[%]09/\011/gs;
$$elemRef =~ s/[%]25/%/gs;
}
}
1;
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
History:
=cut
package PageRevision;
use PageDB;
use DateTime;
use Logger;
#use Searcher;
# 'class methods'
sub InitDB()
{
#logmsg("before tie");
PageDB::Init();
Searcher::Init();
}
sub TermDB()
{
#logmsg("before untie");
Searcher::Term();
PageDB::Term();
}
sub Exists($)
{
return PageDB::Exists(shift);
}
sub FetchTwoRevisions($$$)
{
my ($pageName, $oldRev, $newRev) = @_;
return PageDB::FetchTwoRevisions($pageName, $oldRev, $newRev);
}
sub FetchLatestMeta($)
{
return PageDB::FetchLatestMeta(shift);
}
sub new
{
my $class = shift;
my $self = {};
$self->{mName} = shift;
$self->{mText} = '';
$self->{mMeta} = '';
$self->{mLatestMeta} = '';
bless($self, $class);
return $self;
}
#------------
sub _SaveARevision
{
my ($pageName, $pageText, $newAuthIP, $newAuthAddr, $curTime, $oldMeta, $overwrite) = @_;
my @ctrl = $pageText =~ m/[\x00-\x09\x0B-\x19]/gs;
if (scalar @ctrl)
{
@ctrl = map { $_ = '0x' . ord($_)} @ctrl;
Logger::logmsg "$pageName: ctrl chars: " . join ('-', @ctrl);
}
my %newMeta = %$oldMeta;
my $lastRev = $$oldMeta{REV};
unless ($overwrite)
{
# Copy existing rev to revs db
PageDB::CopyLatestAsRevision($pageName, $lastRev);
PageDB::CopyLatestMetaAsRevision($pageName, $lastRev, $oldMeta);
$newMeta{REV} = ($lastRev + 1);
}
$newMeta{AUTHIP} = $newAuthIP;
$newMeta{AUTHADDR} = $newAuthAddr;
$newMeta{SAVETIME} = $curTime;
PageDB::Save($pageName, $pageText, \%newMeta);
}
sub Save
{
my ($self, $saveTime, $overwriteOK) = @_;
my $meta = $self->{mMeta};
_SaveARevision($self->{mName},
$self->{mText},
$$meta{AUTHIP},
$$meta{AUTHADDR},
$saveTime,
$meta,
$overwriteOK);
}
sub StripTrailingWhite
{
my $self = shift;
$self->{mText} =~ s/^(.*?)\s*$/$1\n/s; # strip extra trailing whitespace
}
sub PrependText
{
my $self = shift;
my $newText = shift;
$self->{mText} = $newText . $self->{mText};
}
sub AppendText
{
my $self = shift;
my $newText = shift;
$self->{mText} = $self->{mText} . $newText;
}
sub Fetch
{
my $self = shift;
my ($pageText, $pageMeta) = PageDB::Fetch($self->{mName});
$self->{mText} = $pageText;
$self->{mMeta} = $pageMeta;
}
sub LockedFetchRevision
{
my $self = shift;
my $rev = shift;
PageDB::LockPages();
my ($pageText, $pageMeta) = PageDB::Fetch($self->{mName});
$self->{mText} = $pageText;
$self->{mMeta} = $pageMeta;
my $latestMeta = {};
if ($rev == 0)
{
%$latestMeta = %$pageMeta;
}
else
{
$latestMeta = PageDB::FetchLatestMeta($self->{mName});
}
$self->{mLatestMeta} = $latestMeta;
PageDB::UnlockPages();
}
sub RevisionExists
{
my $self = shift;
my $meta = $self->{mMeta};
my $latestmeta = $self->{mLatestMeta};
return $$meta{REV} > 0 && $$meta{REV} <= $$latestmeta{REV};
}
sub IsCurrentRevision
{
my $self = shift;
my $meta = $self->{mMeta};
my $latestmeta = $self->{mLatestMeta};
#Logger::logmsg("iscurrent: ", $$meta{REV}, " : ", $$latestmeta{REV});
return $$meta{REV} == $$latestmeta{REV};
}
sub NextRevisionNumber
{
my $self = shift;
my $latestmeta = $self->{mLatestMeta};
return Exists($self->{mName}) ? ($$latestmeta{REV} + 1) : 1;
}
sub RevisionNumber
{
my $self = shift;
my $meta = $self->{mMeta};
return $$meta{REV};
}
sub SaveTime
{
my $self = shift;
my $meta = $self->{mMeta};
return $$meta{SAVETIME};
}
sub AuthorAddress
{
my $self = shift;
my $meta = $self->{mMeta};
return $$meta{AUTHADDR};
}
sub HasBeenEditedBefore
{
my $self = shift;
my $meta = $self->{mMeta};
return ($$meta{REV} > 1 && $$meta{SAVETIME});
}
sub SaveTimeAsString
{
my $self = shift;
my $meta = $self->{mMeta};
return DateTime::getSaveDate($$meta{SAVETIME}) . ' ' . DateTime::getSaveTime($$meta{SAVETIME});
}
sub PageText
{
my $self = shift;
return "Describe $self->{mName} here" if !defined($self->{mText});
return $self->{mText};
}
sub Text
{
my $self = shift;
return $self->{mText};
}
sub Meta
{
my $self = shift;
return $self->{mMeta};
}
1;
|
|
|
# Porter stemmer in Perl. Few comments, but it's easy to follow against the rules in the original
# paper, in
#
# Porter, 1980, An algorithm for suffix stripping, Program, Vol. 14,
# no. 3, pp 130-137,
#
# see also http://www.muscat.com/~martin/stem.html
package porter;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = ( );
%EXPORT_TAGS = ( );
@EXPORT_OK = qw(&stem &porter);
}
my %step2list; # BWK: changed 13 May 00 (local -> my)
my %step3list; # BWK: changed 13 May 00 (local -> my)
my ($c, $v, $C, $V, $mgr0, $meq1, $mgr1, $_v); # BWK: changed 13 May 00 (local -> my)
sub stem
{ my ($stem, $suffix, $firstch);
my $w = shift;
if (length($w) < 3) { return $w; } # length at least 3
# now map initial y to Y so that the patterns never treat it as vowel:
$w =~ /^./; $firstch = $&;
if ($firstch =~ /^y/) { $w = ucfirst $w; }
# Step 1a
if ($w =~ /(ss|i)es$/) { $w=$`.$1; }
elsif ($w =~ /([^s])s$/) { $w=$`.$1; }
# Step 1b
if ($w =~ /eed$/) { if ($` =~ /$mgr0/o) { chop($w); } }
elsif ($w =~ /(ed|ing)$/)
{ $stem = $`;
if ($stem =~ /$_v/o)
{ $w = $stem;
if ($w =~ /(at|bl|iz)$/) { $w .= "e"; }
elsif ($w =~ /([^aeiouylsz])\1$/) { chop($w); }
elsif ($w =~ /^${C}${v}[^aeiouwxy]$/o) { $w .= "e"; }
}
}
# Step 1c
if ($w =~ /y$/) { $stem = $`; if ($stem =~ /$_v/o) { $w = $stem."i"; } }
# Step 2
if ($w =~ /(ational|tional|enci|anci|izer|bli|alli|entli|eli|ousli|ization|ation|ator|alism|iveness|fulness|ousness|aliti|iviti|biliti|logi)$/)
{ $stem = $`; $suffix = $1;
if ($stem =~ /$mgr0/o) { $w = $stem . $step2list{$suffix}; }
}
# Step 3
if ($w =~ /(icate|ative|alize|iciti|ical|ful|ness)$/)
{ $stem = $`; $suffix = $1;
if ($stem =~ /$mgr0/o) { $w = $stem . $step3list{$suffix}; }
}
# Step 4
if ($w =~ /(al|ance|ence|er|ic|able|ible|ant|ement|ment|ent|ou|ism|ate|iti|ous|ive|ize)$/)
{ $stem = $`; if ($stem =~ /$mgr1/o) { $w = $stem; } }
elsif ($w =~ /(s|t)(ion)$/)
{ $stem = $` . $1; if ($stem =~ /$mgr1/o) { $w = $stem; } }
# Step 5
if ($w =~ /e$/)
{ $stem = $`;
if ($stem =~ /$mgr1/o or
($stem =~ /$meq1/o and not $stem =~ /^${C}${v}[^aeiouwxy]$/o))
{ $w = $stem; }
}
if ($w =~ /ll$/ and $w =~ /$mgr1/o) { chop($w); }
# and turn initial Y back to y
if ($firstch =~ /^y/) { $w = lcfirst $w; }
return $w;
}
sub initialise {
%step2list =
( 'ational'=>'ate', 'tional'=>'tion', 'enci'=>'ence', 'anci'=>'ance', 'izer'=>'ize', 'bli'=>'ble',
'alli'=>'al', 'entli'=>'ent', 'eli'=>'e', 'ousli'=>'ous', 'ization'=>'ize', 'ation'=>'ate',
'ator'=>'ate', 'alism'=>'al', 'iveness'=>'ive', 'fulness'=>'ful', 'ousness'=>'ous', 'aliti'=>'al',
'iviti'=>'ive', 'biliti'=>'ble', 'logi'=>'log');
%step3list =
('icate'=>'ic', 'ative'=>'', 'alize'=>'al', 'iciti'=>'ic', 'ical'=>'ic', 'ful'=>'', 'ness'=>'');
$c = "[^aeiou]"; # consonant
$v = "[aeiouy]"; # vowel
$C = "${c}\[^aeiouy]*"; # consonant sequence BWK: 13 May 00 added backslash
$V = "${v}\[aeiou]*"; # vowel sequence BWK: 13 May 00 added backslash
$mgr0 = "^(${C})?${V}${C}"; # [C]VC... is m>0
$meq1 = "^(${C})?${V}${C}(${V})?" . '$'; # [C]VC[V] is m=1
$mgr1 = "^(${C})?${V}${C}${V}${C}"; # [C]VCVC... is m>1
$_v = "^(${C})?${v}"; # vowel in stem
}
# that's the definition. Run initialise() to set things up, then stem($word) to stem $word, as here:
initialise();
# inputs taken from the files on the arg list, output to stdout.
# As an easy speed-up, one might create a hash of word=>stemmed form, and look up each new
# word in the hash, only calling stem() if the word was not found there.
my %stemCache;
sub porter {
my ($word) = @_;
my $stemmed = $stemCache{$word};
return $stemmed if defined($stemmed);
$stemCache{$word} = $stemmed = stem($word);
return $stemmed;
}
1;
|
|
|
=head1 QwikWiki config file
=cut
package qwcfg;
use strict;
$qwcfg::showPageInfo = 1; # 1 or 0; display meta info about the page in the page header
$qwcfg::scramble = 0; # 1 or 0; scramble page contents so external searches do not work
$qwcfg::serverUrl = ($ENV{SERVER_URL})? $ENV{SERVER_URL} : "http://localhost:8080";
$qwcfg::qwikiUrl = "$qwcfg::serverUrl/cgi-bin/jqwiki.cgi";
$qwcfg::interWikiUrl = "http://www.c2.com/cgi/wiki?"; # Wiki:InterWiki links
$qwcfg::qwikiProgRoot = "..";
$qwcfg::qwikiHtmlRoot = "misc";
$qwcfg::pagesDbPath = "$qwcfg::qwikiProgRoot/db/pages";
$qwcfg::revsDbPath = "$qwcfg::qwikiProgRoot/db/revs";
$qwcfg::searchDbPath = "$qwcfg::qwikiProgRoot/db/index";
#protect edits?
#$qwcfg::requirelogin = 0; # 1 or 0; require a login on an edit
$qwcfg::loginadmin = "your_email_address at here.com"; # the admin for the login usernames and passwords
$qwcfg::usersDbPath = "$qwcfg::qwikiProgRoot/db/users";
$qwcfg::stopwordsFile = "$qwcfg::qwikiProgRoot/misc/stopwords.txt";
$qwcfg::qwikiBaseGif = "$qwcfg::qwikiHtmlRoot/radial_red_blue.jpg"; # was wikibase.gif";
#if using windows:
#$qwcfg::diffProg = "diff.exe";
#$qwcfg::qwdiffTmpDir = "c:/temp";
$qwcfg::diffProg = "/usr/bin/diff";
$qwcfg::qwdiffTmpDir = "/tmp";
$qwcfg::FrontPage = "FrontPage"; # default entry-point / home page
$qwcfg::RecentChanges = "RecentChanges"; # auto-updated changes log page
# All QwikWiki pages begin with this header data. It should include
# the HTML header, and finish with an open <BODY> tag.
# The token %%TITLE%% is replaced with the current page title.
$qwcfg::htmlHeader = <<"ENDHTML";
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
<head>
<title>%%TITLE%%</title>
<style type="text/css" media=screen>
<!--
BODY { background: white url($qwcfg::qwikiHtmlRoot/fadeV_mag_white.jpg) no-repeat; background-repeat: repeat-x; color: black }
-->
</style>
<base target="_self">
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#230096" alink="#7f0a5f" vlink="#7f0a5f">
ENDHTML
1;
# eof
|
|
|
package qwdiff;
use strict;
use IO::Handle;
use Carp;
require qwcfg; # QwikWiki config
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw(&hilightPageDiffs);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw(%hilightOn %hilightOff);
}
use vars qw(%hilightOn %hilightOff);
%hilightOn = (
NODIFF => '',
ADD => '<!--qwdiff--><font style="color:black;background-color:#66ff66">', # was: ffff66
DELETE => '<!--qwdiff--><font style="color:black;background-color:#ff99aa"><strike>', # was: ff6666
CHANGEFROM => '<!--qwdiff--><font style="color:black;background-color:#ff99aa"><strike>', # was: ff9966
CHANGETO => '<!--qwdiff--><font style="color:black;background-color:#66ff66">' # was: 66ff66
);
%hilightOff = (
NODIFF => '',
ADD => '<!--qwdiff_end--></font>',
DELETE => '<!--qwdiff_end--></strike></font>',
CHANGEFROM => '<!--qwdiff_end--></strike></font>',
CHANGETO => '<!--qwdiff_end--></font>'
);
sub whowasi { (caller(1))[3] }
sub hilightPageDiffs {
my ($oldText, $newText) = @_;
my $splitOld = wordSplitDiffText($oldText);
my $splitNew = wordSplitDiffText($newText);
my $tmpFile1 = "$qwcfg::qwdiffTmpDir/qwdiff.$$.1";
my $tmpFile2 = "$qwcfg::qwdiffTmpDir/qwdiff.$$.2";
my $fh = IO::Handle->new();
open($fh, ">$tmpFile1")
or croak "Error: @{[&whowasi]} Couldn't open diff tmp file $tmpFile1 ($!)";
print $fh ($splitOld);
close($fh);
open($fh, ">$tmpFile2")
or croak "Error: @{[&whowasi]} Couldn't open diff tmp file $tmpFile2 ($!)";
print $fh ($splitNew);
close($fh);
my $diffList = getDiffList($tmpFile1, $tmpFile2);
unlink $tmpFile1, $tmpFile2;
my $hiText = genHilightDiffHtml($splitOld, $splitNew, $diffList);
return $hiText;
}
sub genHilightDiffHtml {
my ($splitOld, $splitNew, $diffList) = @_;
my @linesOld = split('\n', $splitOld);
my @linesNew = split('\n', $splitNew);
my $html = "";
my $cur = 1;
my $diff;
foreach $diff (@$diffList) {
yank(\$html, \@linesNew, $cur, $$diff{from2} - 1, 'NODIFF');
$cur = $$diff{to2} + 1;
if ($$diff{kind} eq 'c') {
yank(\$html, \@linesOld, $$diff{from1}, $$diff{to1}, 'CHANGEFROM');
yank(\$html, \@linesNew, $$diff{from2}, $$diff{to2}, 'CHANGETO');
}
elsif ($$diff{kind} eq 'a') {
yank(\$html, \@linesNew, $$diff{from2}, $$diff{to2}, 'ADD');
}
elsif ($$diff{kind} eq 'd') {
yank(\$html, \@linesNew, $$diff{from2}, $$diff{to2}, 'NODIFF');
yank(\$html, \@linesOld, $$diff{from1}, $$diff{to1}, 'DELETE');
}
}
yank(\$html, \@linesNew, $cur, scalar(@linesNew), 'NODIFF');
return $html;
}
sub yank {
my ($dest, $lines, $from, $to, $kind) = @_;
$$dest .= $hilightOn{$kind};
for (--$from, --$to ; $from <= $to; $from++) {
my $line = $$lines[$from];
# Form-feed was newline in original. Hilighting is stopped and resumed
# around newlines to simplify things in Markup::Page, which is line-based.
$line =~ s/^[\014]/$hilightOff{$kind} . "\n" . $hilightOn{$kind}/e;
$$dest .= $line;
}
$$dest .= $hilightOff{$kind};
}
sub wordSplitDiffText {
my ($text) = @_;
# Newlines in original are stashed as form-feeds.
# New newlines are inserted at word boundaries for diffing.
# The form-feeds may only appear as the first character these new "diff lines".
# (This makes things easier for yank, and ultimately for Markup::Page)
$text =~ s/[\015][\012]/\014/gs;
$text =~ s/[\015\012]/\014/gs;
$text =~ s/( [\014]?[A-Za-z]+(?:[ ]+)? | [\014]?[^A-Za-z\014]+ | [\014](?:$|(?=[\014])) )/$1\n/gsx;
return $text;
}
sub getDiffList {
my ($file1, $file2) = @_;
my $pipeh = IO::Handle->new();
open($pipeh, "$qwcfg::diffProg $file1 $file2 |")
or croak "Error: @{[&whowasi]} Failed to fork for pipe to $qwcfg::diffProg ($!)";
my $diffList = [];
my $line;
while (defined($line = <$pipeh>)) {
if ($line =~ m/^(\d+)(?:,(\d+))?([acd])(\d+)(?:,(\d+))?/) {
my ($kind, $from1, $to1, $from2, $to2) = ($3, $1, $2, $4, $5);
$to1 = $from1 unless ($to1);
$to2 = $from2 unless ($to2);
push(@$diffList, { kind => $kind, from1 => $from1, to1 => $to1,
from2 => $from2, to2 => $to2 });
}
}
close($pipeh);
# or carp "Error: @{[&whowasi]} Pipe close failed for $qwcfg::diffProg ($? $!)";
return $diffList;
}
# got (4c4) (c) (4) () (4) ()
# got (145a146,197) (a) (145) () (146) (197)
# got (403,454d454) (d) (403) (454) (454) ()
# got (484,487c484,488) (c) (484) (487) (484) (488)
# 145a146,197
# > This
# ...
#
#
# 403,454d454
# < This
# ...
#
#
# 4c4
# < recursive
# ---
# > recursive-matic
#
#
# 484,487c484,488
# < Intransigent
# < Extramarital
# < Insurgencies
# < Romantic
# ---
# > Spreading
# > Activation
# > Model
# > of
# > Semantic
# diff s3y s3 | more
# 4c4
# < recursive-matic
# ---
# > recursive
# 145a146,197
# > This
# > attenuation
# > might
# > be
# > specific
# > to
# > the
# > arc
# > carrying
# > the
# > activation
# > (
# > e
# > .
# > g
# > .,
# > some
# > arcs
# > in
# > the
# > network
# > might
# > be
# > more
# > or
# > less
# > conductive
# > than
# > others
# > ,
# > reflecting
# > their
# > salience
# > )
# > or
# > constant
# > across
# > the
# > network
# > (
# > e
# > .
# > g
# > .,
# > traversing
# > any
# > arc
# > causes
# > 10
# > %
# > attentuation
# > ).
# 403,454d454
# < This
# < attenuation
# < might
# < be
# < specific
# < to
# < the
# < arc
# < carrying
# < the
# < activation
# < (
# < e
# < .
# < g
# < .,
# < some
# < arcs
# < in
# < the
# < network
# < might
# < be
# < more
# < or
# < less
# < conductive
# < than
# < others
# < ,
# < reflecting
# < their
# < salience
# < )
# < or
# < constant
# < across
# < the
# < network
# < (
# < e
# < .
# < g
# < .,
# < traversing
# < any
# < arc
# < causes
# < 10
# < %
# < attentuation
# < ).
# 484,487c484,488
# < Intransigent
# < Extramarital
# < Insurgencies
# < Romantic
# ---
# > Spreading
# > Activation
# > Model
# > of
# > Semantic
# diff s3 s3y
# 4c4
# < recursive
# ---
# > recursive-matic
# 146,197d145
# < This
# < attenuation
# < might
# < be
# < specific
# < to
# < the
# < arc
# < carrying
# < the
# < activation
# < (
# < e
# < .
# < g
# < .,
# < some
# < arcs
# < in
# < the
# < network
# < might
# < be
# < more
# < or
# < less
# < conductive
# < than
# < others
# < ,
# < reflecting
# < their
# < salience
# < )
# < or
# < constant
# < across
# < the
# < network
# < (
# < e
# < .
# < g
# < .,
# < traversing
# < any
# < arc
# < causes
# < 10
# < %
# < attentuation
# < ).
# 454a403,454
# > This
# > attenuation
# > might
# > be
# > specific
# > to
# > the
# > arc
# > carrying
# > the
# > activation
# > (
# > e
# > .
# > g
# > .,
# > some
# > arcs
# > in
# > the
# > network
# > might
# > be
# > more
# > or
# > less
# > conductive
# > than
# > others
# > ,
# > reflecting
# > their
# > salience
# > )
# > or
# > constant
# > across
# > the
# > network
# > (
# > e
# > .
# > g
# > .,
# > traversing
# > any
# > arc
# > causes
# > 10
# > %
# > attentuation
# > ).
# 484,488c484,487
# < Spreading
# < Activation
# < Model
# < of
# < Semantic
# ---
# > Intransigent
# > Extramarital
# > Insurgencies
# > Romantic
1;
# eof
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
History:
=cut
package qwiki;
use CGI ':standard';
use Searcher;
use PageRevision;
use Markup;
use WikiPageSaver;
BEGIN
{
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 0.331;
@ISA = qw(Exporter);
@EXPORT = qw(&CgiInit
&ViewPage
&DiffPage
&EditPage
&EditCopy
&SavePage
&SearchForm
&FulltextSearch
&ValidWikiName
&IndexWikiPage
);
%EXPORT_TAGS = ( );
@EXPORT_OK = ();
}
#------------
sub ValidWikiName
{
my ($name) = @_;
return $name =~ /^(?:[A-Z]+[a-z0-9]*){2,}$/s; # (allows CLanguage, BASIC, etc.)
}
#------------
sub IndexWikiPage
{
my ($pageName, $pageText) = @_;
return if ($pageName eq $qwcfg::RecentChanges);
Markup::StripWikiMetaChars(\$pageText);
my $sepWords = join(" ", _splitWikiWords($pageText));
Searcher::Save($pageName, $pageText . " " . $sepWords);
}
#------------
sub ViewPage
{
my ($pageName) = @_;
Logger::logmsg("view $pageName");
return if _detectNonWikiName($pageName);
my $page = new PageRevision($pageName);
$page->Fetch();
my $html = Markup::PageText($pageName, $page->Text());
my $lastEdited = "";
if ($page->HasBeenEditedBefore())
{
$lastEdited = "(Last Edit: "
. Render::Link($pageName, $page->SaveTimeAsString(), 'diff') . ")";
}
my $displayName = _separateWikiWord($pageName);
Response::StartHtml($displayName);
_showPage($pageName, $displayName, $html, $lastEdited);
}
#------------
sub DiffPage
{
my ($pageName, $oldRev, $newRev) = @_;
Logger::logmsg("diff $pageName");
return if _detectNonWikiName($pageName);
$oldRev = -1 unless ($oldRev);
$newRev = 0 unless ($newRev);
unless ($oldRev =~ /^-?\d+$/)
{
Response::DisplayRequestFailure("Unable to parse '$oldRev' as a number. (rev1=$oldRev)");
return;
}
unless ($newRev =~ /^-?\d+$/)
{
Response::DisplayRequestFailure("Unable to parse '$newRev' as a number. (rev2=$newRev)");
return;
}
my ($oldText, $oldMeta, $newText, $newMeta) = PageRevision::FetchTwoRevisions($pageName, $oldRev, $newRev);
my @reason;
push(@reason, "Revision $oldRev of $pageName not found") unless defined($oldText);
push(@reason, "Revision $newRev of $pageName not found") unless defined($newText);
if (scalar @reason)
{
Response::DisplayRequestFailure(join('; ', @reason));
return;
}
my $html = Markup::PageDiffs($oldText, $newText);
my $displayName = _separateWikiWord($pageName);
Response::StartHtml("$displayName Differences");
my $infobar;
my $curTime = time;
unless ($newRev == 0 && $oldRev == -1)
{
$infobar = DateTime::timeSinceRevEdit($$oldMeta{REV}, $$oldMeta{SAVETIME}, $curTime, $$oldMeta{AUTHADDR}) . br;
}
$infobar .= DateTime::timeSinceRevEdit($$newMeta{REV}, $$newMeta{SAVETIME}, $curTime, $$newMeta{AUTHADDR}) . br;
_showPage($pageName, $displayName, $html, "", $infobar);
}
#------------
sub EditCopy
{
my ($pageName, $rev) = @_;
Logger::logmsg("edit_copy $pageName");
return if _detectNonWikiName($pageName);
EditPage($pageName, $rev);
}
#------------
sub EditPage
{
my ($pageName, $rev) = @_;
Logger::logmsg("edit: $pageName rev='$rev' sinfo='$qwenv::sessioninfo'");
return if _detectNonWikiName($pageName);
$rev = 0 unless ($rev);
unless ($rev =~ /^-?\d+$/)
{
Response::DisplayRequestFailure("Unable to parse '$rev' as a number. (rev=$rev)");
return;
}
#Logger::logmsg("edit: sessioninfo='$qwenv::sessioninfo'");
if ($qwcfg::requirelogin)
{
if ($qwenv::sessioninfo eq '')
{
return Response::DisplayLoginForm($pageName);
}
else
{
my ($username, $ok, $token) = split(":", $qwenv::sessioninfo);
if (!defined $username || !defined $ok || !defined $token
|| $ok ne "ok"
|| $username =~ /^\s*$/
|| $token =~ /^\s*$/)
{
Logger::logmsg("edit: error in format of session info='$qwenv::sessioninfo'");
return Response::DisplayLoginForm($pageName);
}
if (!-e "$qwcfg::usersDbPath/user.$username\.txt")
{
Logger::logmsg("edit: can't find file: $qwcfg::usersDbPath/user.$username\.txt");
return Response::DisplayLoginForm($pageName);
}
open (USESSIONFH, "< $qwcfg::usersDbPath/user.$username\.txt");
my ($u, $t) = split ":", <USESSIONFH>;
close(USESSIONFH);
if ($u ne $username || $t ne $token)
{
Logger::logmsg("edit: usernames ('$u' != '$username') or tokens ('$t' != '$token') don't match");
return Response::DisplayLoginForm($pageName);
}
$qwenv::clientName = $username;
}
}
my $page = new PageRevision($pageName);
$page->LockedFetchRevision($rev);
if (!$page->RevisionExists())
{
Response::DisplayRequestFailure("Revision $rev of $pageName not found");
return;
}
my $editLabel = ($page->IsCurrentRevision()) ? "Edit $pageName" : "Copy of Prior $pageName";
Response::StartHtml($editLabel);
Response::docprint DateTime::timeSinceRevEdit($page->RevisionNumber(), $page->SaveTime(), time, $page->AuthorAddress())
unless ($page->IsCurrentRevision());
my $expectedRev = $page->NextRevisionNumber();
my $allowEditCopy = ($rev == 0);
Response::DisplayEditForm($pageName, $page->PageText(), $expectedRev, $editLabel, $allowEditCopy);
}
#------------
sub SavePage
{
my ($pageName, $editedText, $expectedRev) = @_;
Logger::logmsg("save $pageName");
return if _detectNonWikiName($pageName);
my $saver = new WikiPageSaver($pageName, $editedText, $expectedRev);
$saver->Save();
}
#------------
sub SearchForm
{
my ($pageName) = @_;
Logger::logmsg("search_form $pageName");
Searcher::DisplaySearchForm($pageName);
}
#------------
sub SearchResults
{
my ($searchQuery) = @_;
chomp $searchQuery;
Logger::logmsg("searchresults '$searchQuery'");
Searcher::SearchResults($searchQuery);
}
#--- PRIVATE from here on -------------------------------------------------------------------
#------------
sub _detectNonWikiName
{
my ($pageName) = @_;
return undef if ValidWikiName($pageName);
Response::DisplayRequestFailure("Unable to parse '$pageName' as a WikiName.");
return 1;
}
#------------
sub _showPage
{
my ($pageName, $displayName, $pageHtml, $lastEdited, $infobar) = @_;
Response::DisplayPage($pageName, $displayName, $pageHtml, $lastEdited, _ReferencesOfPage($pageName), $infobar);
}
#------------
sub _ReferencesOfPage
{
my ($pageName) = @_;
my $pageRefs = Searcher::GetReferencesOf($pageName);
return '' if (scalar(keys(%$pageRefs)) == 0) ;
my $pageRefText = join(", ", sort keys %$pageRefs);
Markup::WikiLinksIn(\$pageRefText);
return "Referenced By: $pageRefText";
}
#------------
# Somewhat of a kludge for the fulltext search. Since it's a literal
# keyword search, we're helping it out by breaking up WikiNames into
# their component words. (The full WikiNames are also indexed, elsewhere.)
# -given
# "NormalWikiWord WordIMARSEmbedded PLAINCAPS CLanguage BlaZEE DEDBoeCON"
# -returns (unordered)
# CON ZEE Language Wiki Boe Normal Embedded PLAINCAPS Word IMARS DED Bla
#
sub _splitWikiWords
{
my ($pageText) = @_;
my %words;
while ($pageText =~ /\b((?:[A-Z][a-z0-9]*){2,})\b/gs)
{
my $wikiWord = $&;
while ($wikiWord =~ /[A-Z](?:[a-z0-9]+|(?:[A-Z](?![a-z0-9]))+)/g)
{
$words{"$&"} = 1;
}
}
return keys(%words);
}
#------------
sub _separateWikiWord
{
my ($wikiWord) = @_;
my $sep = "";
while ($wikiWord =~ /[A-Z](?:[a-z0-9]+|(?:[A-Z](?![a-z0-9]))+)/g)
{
$sep .= ' ' if ($sep);
$sep .= $&;
}
return $sep;
}
1;
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
main line.
=cut
package main;
use Logger;
use Debugger;
use App;
use Response;
my $gDebugger = new Debugger;
#$gDebugger->On(); #uncomment to get debug info.
my $gApp = new App;
BEGIN
{
umask(000);
Logger::Init();
Logger::logmsg("begin");
}
sub main
{
Response::Init();
$gDebugger->DumpEnvStrings();
$gApp->Init();
$gApp->HandleRequest();
$gApp->RenderEnd();
$gApp->Term();
}
END
{
Response::DisplayError() if (!$gApp->IsGoodExit);
Logger::logmsg("end");
}
1;
|
|
|
#!perl -w
use strict;
=head1 Render
Purpose: Renders most items on a page
Modify these routines to change the look and feel
=cut
package Render;
use CGI ':standard';
my $ViewPort_ToolBar_Color = 'background-color:linen;';
my $Generic_ToolBar_Color = 'background-color:lightblue;';
my $ThinBorderStyle = 'border-style:solid; border-width:thin; margin=0px;';
#---------
sub Url
{
my ($url, $displaytext) = @_;
$displaytext = $url if (!defined $displaytext);
# the target=>top breaks out of frames
return a({-href=>$url, -target=>"_top"}, $displaytext);
}
#---------
sub Image
{
my ($url) = @_;
return img({src=>$url});
}
#---------
sub Link
{
my ($page, $text, $cmd) = @_;
return a({href=>"$qwcfg::qwikiUrl?$cmd=$page"}, $text) if defined($cmd);
return a({href=>"$qwcfg::qwikiUrl?$page"}, $text);
}
#---------
sub NonExistingPageLink
{
my ($pagename) = @_;
return $pagename . Link($pagename, '?', 'edit');
}
#---------
sub ExistingPageLink
{
my ($pagename, $displayname) = @_;
return Link($pagename, $displayname);
}
#---------
sub ViewPortToolBar
{
my ($pagename, $pagetext, $datetimestamp) = @_;
return br .
table(
{ -width=>'100%', -cellspacing=>'0px', -style=>$ThinBorderStyle},
Tr(
td(
{-style=>$ViewPort_ToolBar_Color},
font({-size=>'-3'},
Render::Link($pagename, $pagename),
Render::Link($pagename, 'edit', 'edit'),
$datetimestamp,
)
)
),
Tr(
td
(
$pagetext
)
),
);
}
#---------
sub GenericToolBar
{
my @list = @_;
return table(
{-border=>'1px', -cellspacing=>'0px'},
Tr(
td({-style=>$Generic_ToolBar_Color}, \@list)
)
);
}
1;
|
|
|
#!perl -w
use strict;
use Logger;
package Request;
use vars qw( $mCGI );
sub CgiInit
{
my ($query) = @_;
$mCGI = $query;
}
1;
|
|
|
#!perl -w
use strict;
package Response;
use Logger;
use CGI ':standard';
use vars qw( $mCGI );
use PageBarRenderer;
use PageRevision;
$Response::emitout = 1;
#------------
sub Init
{
$SIG{'PIPE'} = 'IGNORE';
$| = 1; # enable autoflush
#Logger::logmsg("Response::Init");
$qwenv::htmlOut = ""; # output appended here, and printed if script successful
#don't use CGI here...
print "Content-type:text/html\n"; # do this immediately - some http servers time out quickly?
$Response::emitout = 1;
}
#------------
sub docprint
{
local($") = '';
$qwenv::htmlOut .= "@_";
}
#------------
sub CgiInit
{
my ($query) = @_;
$mCGI = $query;
}
#------------
sub Emit
{
#Logger::logmsg("emit: htmlout='$qwenv::htmlOut'");
if ($qwcfg::requirelogin)
{
Logger::logmsg("emit: saving cookie sessioninfo='$qwenv::sessioninfo'");
if (defined $qwenv::sessioninfo && $qwenv::sessioninfo ne '')
{
my $cookie = $mCGI->cookie(-name=>'sessioninfo', -value=> "$qwenv::sessioninfo", -expires=>"+2h");
print $mCGI->header(-type=>'text/html', -cookie=>$cookie ), "\n";
}
}
#Logger::logmsg("emit: emitout='$Response::emitout'");
print $qwenv::htmlOut if ($Response::emitout);
print $mCGI->end_html, "\n\n";
}
#------------
sub StartHtml
{
my ($title) = @_;
#Logger::logmsg("Response::StartHtml");
docprint "\n";
my $head = $qwcfg::htmlHeader;
$head =~ s/%%TITLE%%/$title/gs;
docprint $head;
}
#------------
sub Refresh
{
my ($newurl) = @_;
Logger::logmsg("Response::Refresh");
#don't use CGI here! it will generate extra lines of html
print "Refresh: 0; url=$newurl\n";
$Response::emitout = 0;
}
#------------
sub DisplayError
{
print qq{<head><title>Wiki Server Error</title></head>\n};
print qq{<h1><font color="FF0000">Wiki Server Error</font> <small>(QwikWiki V$qwiki::VERSION)</small></h1>\n};
print qq{<h2>An Error Occurred While Processing Your Request</h2>\n};
print qq{<p>This information has been logged.<br>\n};
print qq{We are sorry for any inconvenience.</p>\n};
Logger::logmsg("bad exit ($! $? $@)");
}
#------------
sub DisplayRequestFailure
{
my ($reason) = @_;
StartHtml("QwikWiki V$qwiki::VERSION");
docprint h2("The Wiki Server Can't Process Your Request");
docprint p("<tt> $reason</tt>", br, br,
"We are sorry for any inconvenience.", br, br, br, hr, br,
Render::Link('search', 'FindPage'),
" by searching or browsing");
}
#------------
sub WarningPageNotSaved
{
my ($pageName) = @_;
StartHtml("$pageName Not Saved");
docprint h1(qq{<font color="FF7700">Alert - Page Not Saved</font>});
docprint p("The page data received was entirely blank. ",
"As a precaution, the blank page was not saved.", br, br,
em("Tip: In order to save a completely blank page, ",
"delete the text and enter just a single back-quote ",
"(`) character, then save."));
}
#------------
sub WarningSavedPageIsBlank
{
my ($pageName) = @_;
StartHtml("Thanks For Editing $pageName");
docprint br, br,
"Since the text of the saved page was blank, and ",
"$pageName was not currently linked-to from any other page, ",
"$pageName has removed (hidden) from the database. ",
"The prior revision of the page, if any, is still accessible using ",
Render::Link($pageName, 'EditCopy', 'copy') . ".",
br, br, hr, br,
Render::Link($pageName, 'FindPage', 'search'),
" by searching or browsing", br, "</p>";
}
#------------
sub DisplayPage
{
my ($pageName, $displayName, $pageHtml, $lastEdited, $refs, $infobar) = @_;
my $r = new PageBarRenderer($pageName, $displayName, $lastEdited, $refs);
my $pageinfo;
if ($qwcfg::showPageInfo)
{
my $pageMeta = PageRevision::FetchLatestMeta($pageName);
$pageinfo = "<i>PageInfo: ";
$pageinfo .= "rev=$$pageMeta{REV} ";
$pageinfo .= "authip=$$pageMeta{AUTHIP} ";
$pageinfo .= "authaddr=$$pageMeta{AUTHADDR} ";
my $dts = DateTime::getSaveDate($$pageMeta{SAVETIME}) . ' ' . DateTime::getSaveTime($$pageMeta{SAVETIME});
$pageinfo .= "savetime=$dts ";
$pageinfo .= "scrambled=$$pageMeta{SCRAMBLED}<br>";
$pageinfo .= "Current: clientAddr=$qwenv::clientAddr ";
$pageinfo .= "clientName=$qwenv::clientHostName ";
$pageinfo .= "referrer=$qwenv::referrerPage ";
$pageinfo .= "</i>";
}
my $sep = br;
$sep = hr if defined($infobar) || defined($pageinfo);
docprint $r->Get(), $infobar, $pageinfo, $sep, $pageHtml;
}
#--------------------------
sub DisplayLoginForm
{
my ($pageName) = @_;
Logger::logmsg("DisplayLoginForm: page='$pageName'");
StartHtml("Login");
Response::docprint _GetLoginForm($pageName);
}
#---------------------------------------
sub DisplayBadLogin
{
my ($pageName) = @_;
Logger::logmsg("DisplayBadLogin: page='$pageName'");
StartHtml("Incorrect login");
my $html = $mCGI->h1("Try again or press Back to continue browsing.")
. $mCGI->br
. $mCGI->br
. _GetLoginForm();
Response::docprint $html;
}
#---------------------------------------
sub _GetLoginForm
{
my ($pageName) = @_;
my $html =
$mCGI->h1("Login")
. $mCGI->br
. $mCGI->br
. $mCGI->startform
. $mCGI->p("Please enter your user name and password.")
. $mCGI->br
. $mCGI->p("If you do not have a user name and password, contact <strong>$qwcfg::loginadmin</strong> via email to request them.")
. $mCGI->br
. "User Name: "
. $mCGI->textfield( -name => 'username',
-default => '',
-override => 1,
-size => 50,
-maxlength => 40)
. $mCGI->br
. "Password : "
. $mCGI->password_field( -name => 'password',
-default => '',
-override => 1,
-size => 50,
-maxlength => 40)
. $mCGI->br
. $mCGI->br
. $mCGI->hidden(-name => 'pagetoedit', -default => $pageName, -override => 1)
. $mCGI->submit(-name => 'login', -value => "login", -override => 1)
. $mCGI->br
. $mCGI->br
. $mCGI->p("<i>If the logon doesn't work, check if you have cookies enabled. You must have cookies enabled to edit!</i>")
. $mCGI->p("<i>Do not use a primary password! Security of passwords is not guarenteed.</i>")
. $mCGI->br
. $mCGI->endform;
}
#---------------------------------------
sub DisplayEditForm
{
my ($pageName, $pageText, $expectedRev, $editLabel, $allowEditCopy) = @_;
my $html =
$mCGI->startform
. $mCGI->submit(-name => 'FormSave', -value => "Save", -override => 1)
. $mCGI->hidden(-name => 'SavePage', -default => $pageName, -override => 1)
. $mCGI->hidden(-name => 'ExpectedRev', -default => $expectedRev, -override => 1)
. br
. $mCGI->textarea(-name=>'PageText',
-default=>$pageText,
-override=>1,
-rows=>20,
-columns=>76,
-style=>'width:100%',
-wrap=>'virtual')
. $mCGI->endform;
my $r = new PageBarRenderer("$pageName", $editLabel, '', '');
Response::docprint $r->GetEditForm($allowEditCopy), $html;
}
#---------------------------------------
sub DisplaySearchForm
{
my ($pageName) = @_;
StartHtml("Fulltext Search");
my $r = new PageBarRenderer("Fulltext Search", "Fulltext Search", '', '');
my $html =
$mCGI->startform
. br
. p("Enter words and PageNames, or leave blank to list all WikiPages")
. _RenderSearchBox($pageName)
. $mCGI->endform;
Response::docprint $r->GetSearch(), $html;
}
#---------------------------------------
sub DisplaySearchResultsForm
{
my ($searchQuery) = @_;
StartHtml("Search Results");
my $r = new PageBarRenderer("Search Results", "Search Results", '', '');
my $html =
$mCGI->startform
. "Search again? "
. _RenderSearchBox($searchQuery)
. $mCGI->endform
. hr;
Response::docprint $r->GetSearch(), $html;
}
#---------------------------------------
sub DisplaySearchBox
{
my ($defaultQuery) = @_;
docprint _RenderSearchBox($defaultQuery);
}
#---------------------------------------
sub _RenderSearchBox
{
my ($defaultQuery) = @_;
return $mCGI->textfield(
-name => 'FulltextSearch',
-default => $defaultQuery,
-override => 1,
-size => 50,
-maxlength => 127)
. $mCGI->submit(
-name => 'FormSubmit',
-value => "Search",
-override => 1);
}
#---------------------------------------
sub ShowCollisionEditForm
{
my ($origText, $editedText) = @_;
docprint $mCGI->startform;
docprint p("This is your edited page, followed by a summary of the changes you made.");
docprint br, $mCGI->textarea(-name => 'EditedText', -default => $editedText,
-override => 1, -rows => 8, -columns => 76,
-style => 'width:100%', -wrap => 'virtual' );
my $html = Markup::PageDiffs($origText, $editedText);
docprint h2("<tt><b><u>Change Summary:</u></b></tt>");
docprint $html;
docprint $mCGI->endform, hr;
docprint p("Copy or merge your changes into the newer page here.");
# Response::docprint DateTime::timeSinceRevEdit($$collisionMeta{REV}, $$collisionMeta{SAVETIME}, $curTime,
# $$collisionMeta{AUTHADDR});
}
1;
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
History:
=cut
package Searcher;
require FulltextIndexer_Adaptor;
use CGI ':standard start_table end_table';
use Response;
use Markup;
use PageRevision;
sub Init()
{
%qwdbm::searchDb = ();
%qwdbm::search = ();
tie(%qwdbm::searchDb, 'FSDBM_File', $qwcfg::searchDbPath);
tie(%qwdbm::search, 'FulltextIndexer_Adaptor', \%qwdbm::searchDb, 1, $qwcfg::stopwordsFile, \&porter::porter);
}
sub Term()
{
untie(%qwdbm::search);
untie(%qwdbm::searchDb);
}
sub Unlock()
{
tied(%qwdbm::search)->UnlockDb();
}
sub Lock()
{
tied(%qwdbm::search)->LockDb();
}
sub Save($$)
{
my ($page, $text) = @_;
$qwdbm::search{$page} = $text;
}
sub GetReferencesOf($)
{
my ($page) = @_;
my $refs = $qwdbm::search{$page};
delete $$refs{$page}; # ignore self-references
return $refs;
}
sub IsReferenced($)
{
my ($page) = @_;
my $pageRefs = GetReferencesOf( $page );
return defined($pageRefs ) && scalar(keys(%$pageRefs)) != 0;
}
sub DisplaySearchForm
{
my ($pageName) = @_;
Response::DisplaySearchForm($pageName);
}
sub SearchResults
{
my ($searchQuery) = @_;
Response::DisplaySearchResultsForm($searchQuery);
if ($searchQuery =~ /^\s*$/s)
{
_ListAllPages();
return;
}
_ListSearchHits(_performSearch($searchQuery));
}
sub _ListAllPages
{
Response::docprint CGI::b("All Wiki pages (alphabetically):");
Response::docprint CGI::start_table({-border=>'1px', -style=>'border-style:single'});
Response::docprint CGI::Tr(CGI::th({-align=>'LEFT'}, '#References'),
CGI::th({-align=>'CENTER'}, 'Page')
);
my $page;
foreach $page (sort keys %qwdbm::pages)
{
next unless qwiki::ValidWikiName($page); # weed out metadata files
next unless PageRevision::Exists($page);
my $pageRefs = $qwdbm::search{$page};
my $hitCount = scalar keys %$pageRefs;
Response::docprint CGI::Tr(CGI::td({-align=>'CENTER'}, $hitCount),
CGI::td({-align=>'LEFT'}, Markup::WikiLink($page))
);
}
Response::docprint CGI::end_table();
}
#------------
sub _performSearch
{
my ($searchQuery) = @_;
return _GetHitsOn(_GetUniqueTermsFrom($searchQuery));
}
#------------
sub _GetHitsOn
{
my (@terms) = @_;
my $term;
my %pageHits;
foreach $term (@terms)
{
_GetHitsOnTerm($term, \%pageHits);
}
return \%pageHits;
}
#------------
sub _GetHitsOnTerm
{
my ($term, $rPageHits) = @_;
my $pageRefs = $qwdbm::search{$term};
my $page;
foreach $page (keys %$pageRefs)
{
$$rPageHits{$page}++;
}
}
#------------
sub _GetUniqueTermsFrom
{
my ($searchQuery) = @_;
my @terms = split('\s+', $searchQuery);
my %uniqueTerms;
my $term;
foreach $term (@terms)
{
$uniqueTerms{$term} = 1;
}
@terms = keys(%uniqueTerms);
return @terms;
}
#------------
sub _ListSearchHits
{
my ($pageHits) = @_;
if (scalar (keys(%$pageHits)) == 0)
{
#To-do: display any terms that were stopwords.
Response::docprint CGI::p("None of the search terms were found in the database."), CGI::br;
return;
}
my %hitRanks;
my ($page, $termHits);
while (($page, $termHits) = each %$pageHits)
{
$hitRanks{$termHits} = [] unless defined($hitRanks{$termHits});
push(@{$hitRanks{$termHits}}, $page);
}
Response::docprint CGI::b("One or more search terms found on the following pages:");
Response::docprint CGI::start_table({-border=>'1px'} );
Response::docprint CGI::Tr(CGI::th({-align=>'LEFT'}, '#Terms Found'),
CGI::th({-align=>'CENTER'}, 'Page')
);
my $rankLevel;
foreach $rankLevel (sort {$b <=> $a} keys %hitRanks)
{
foreach $page (sort @{$hitRanks{$rankLevel}})
{
Response::docprint CGI::Tr(CGI::td({-align=>'CENTER'}, $rankLevel),
CGI::td({-align=>'LEFT'}, Markup::WikiLink($page))
);
}
}
Response::docprint CGI::end_table();
}
1;
|
|
|
#!perl -w
use strict;
use qwiki;
#-------------------------
package WikiPage;
#-------------------------
sub new($$)
{
my $class = shift;
my $self = {};
my $page = shift;
die "WikiPage::new() requires page name" if !defined($page);
$self->{mCurPage} = $page;
bless($self, $class);
return $self;
}
#-------------------------
sub SearchResults
{
my $self = shift;
qwiki::SearchResults($self->{mCurPage}, @_);
}
#-------------------------
sub SearchForm
{
my $self = shift;
qwiki::SearchForm($self->{mCurPage}, @_);
}
#-------------------------
sub Edit
{
my $self = shift;
qwiki::EditPage($self->{mCurPage}, @_);
}
#-------------------------
sub EditCopy
{
my $self = shift;
qwiki::EditCopy($self->{mCurPage}, @_);
}
#-------------------------
sub Diff
{
my $self = shift;
qwiki::DiffPage($self->{mCurPage}, @_);
}
#-------------------------
sub SavePage
{
my $self = shift;
qwiki::SavePage($self->{mCurPage}, @_);
}
#-------------------------
sub View
{
my $self = shift;
qwiki::ViewPage($self->{mCurPage}, @_);
}
#-------------------------
#--- PRIVATE
#-------------------------
#-------------------------
sub CurrentPage
{
my $self = shift;
return $self->{mCurPage};
}
1;
|
|
|
#!perl -w
use strict;
=head1 QwikWiki
History:
##jaa:
# for <ol type=A> A,B,C
# for <ol type=a> a,b,c
# for <ol type=I> I,II,III
# for <ol type=i> i,ii,iii
# for <ol type=1> 1,2,3
##
=cut
package WikiPageRenderer;
sub new
{
my $class = shift;
my $self = {};
$self->{mPlain} = shift;
$self->{mOutHtml} = '';
$self->{mPrevWasTextLine} = 0;
$self->{mPrevWasBlankLine} = 0;
$self->{mPrevWasListItem} = 0;
$self->{mListLevel} = [''];
pop(@{$self->{mListLevel}}); #kludge to force a defined and empty array
$self->{mOlTypeLevel} = -1;
$self->{mOlType} = ['1','a', 'i', 'A', 'I', '1'];
$self->{mPlainLine} = '';
$self->{mOutLine} = '';
$self->{mInParaType} = '';
$self->{mOpenParaMap} = { 'p' => "<p>", 'pre' => "<pre style=\"color: blue; padding-left:1em; margin:0em 0em 2px 2em;\">" };
$self->{mCloseParaMap} = { 'p' => "</p>", 'pre' => "</pre>" };
$self->{mTagPattern} = '(?:<[^>]*>)*'; # "gobble tags"
bless($self, $class);
return $self;
}
sub Text
{
my ($self) = @_;
## a line is one of:
## a) 'xx' textline
## b) '---' divider
## c) '[' prebegin
## d) ']' preend
## e) ' ' blankline
## f) '*' listitem (buletted or numbered)
$self->_InitPage();
while ($self->{mPlain} =~ /(.*?)(\n|$)/gs)
{
next if $1 eq '' and $2 eq '';
$self->_InitLine($1);
$self->{mPlainLine} =~ s/($self->{mTagPattern})//gso;
if ($self->_InPreformattedBlock())
{
$self->_HandlePreformattedLine();
}
elsif ($self->_isBlank)
{
$self->_HandleBlankLine();
}
elsif ($self->_isDivider)
{
$self->_HandleDivider();
}
elsif ($self->_isPreformattedBegin)
{
$self->_HandlePreformattedBegin();
}
elsif ($self->_isItem)
{
$self->_HandleListItem();
}
else
{
$self->_HandleNormalLine();
}
}
$self->_ClosePage();
return $self->{mOutHtml};
}
#------- PRIVATE _________________
sub _InitPage
{
my $self = shift;
$self->{mOutHtml} = '';
$self->{mOlTypeLevel} = -1;
$self->{mOutLine} = "";
$self->{mPlainLine} = "";
$self->{mInParaType} = "";
$self->{mListLevel} = [''];
pop(@{$self->{mListLevel}}); #kludge
$self->_ClearFlags();
}
sub _ClosePage
{
my $self = shift;
$self->_CloseAllLists();
$self->_closePara;
}
sub _InitLine
{
my ($self, $line) = @_;
chomp $line;
$self->{mPlainLine} = $self->{mOutLine} = $line;
}
sub _doEmphasis
{
my $self = shift;
$self->{mOutLine} =~ s{`\+}{\x01}gs; #save the escaped plus temporarily
$self->{mOutLine} =~ s{\+\+\+(.*?)\+\+\+}{<b><i>$1</i></b>}gs;
$self->{mOutLine} =~ s{\+\+(.*?)\+\+}{<b>$1</b>}gs;
$self->{mOutLine} =~ s{\+(.*?)\+}{<i>$1</i>}gs;
$self->{mOutLine} =~ s{\x01}{\+}gs; #restore the escaped plus as a plus
Markup::WikiLinksIn(\$self->{mOutLine});
$self->_StripWikiMetaCharsInHtml(\$self->{mOutLine});
}
sub _InPreformattedBlock
{
my $self = shift;
return $self->{mInParaType} eq 'pre';
}
sub _isBlank
{
my $self = shift;
return $self->{mPlainLine} =~ /^\s*$/s;
}
sub _isDivider
{
my $self = shift;
return $self->{mPlainLine} =~ /^---/;
}
sub _isPreformattedBegin
{
my $self = shift;
return $self->{mPlainLine} =~ /^[\[]\s*$/;
}
sub _isPreformattedEnd
{
my $self = shift;
return $self->{mPlainLine} =~ /^[\]]\s*$/;
}
sub _isItem
{
my $self = shift;
return $self->{mPlainLine} =~ /^(( )+)([*1])/s;
}
sub _closePara
{
my $self = shift;
return unless ($self->{mInParaType});
$self->AppendLine(${$self->{mCloseParaMap}}{$self->{mInParaType}});
$self->{mInParaType} = "";
}
sub _ClearFlags
{
my $self = shift;
$self->{mPrevWasTextLine} = 0;
$self->{mPrevWasBlankLine} = 0;
$self->{mPrevWasListItem} = 0;
}
sub _SetFlagsForBlankLine
{
my $self = shift;
$self->{mPrevWasTextLine} = 0;
$self->{mPrevWasBlankLine} = 1;
}
sub _SetFlagsForListItem
{
my $self = shift;
$self->{mPrevWasListItem} = 1;
$self->{mPrevWasTextLine} = 0;
$self->{mPrevWasBlankLine} = 0;
}
sub _SetFlagsForNormalLine
{
my $self = shift;
$self->{mPrevWasListItem} = 0;
$self->{mPrevWasTextLine} = 1;
$self->{mPrevWasBlankLine} = 0;
}
sub _AdjustListLevel
{
my ($self, $spaces, $listType) = @_;
my $itemLvl = length($spaces) / 3; #match number of spaces in the pattern!
while ($self->_CurrentListLevel() > $itemLvl ||
($self->_CurrentListLevel() == $itemLvl && $self->_ListTypesHaveChanged($itemLvl, $listType))
)
{
$self->_EndCurrentListLevel();
}
while ($self->_CurrentListLevel() < $itemLvl)
{
$self->_StartListLevelOfType($listType);
}
}
sub _ListTypesHaveChanged
{
my ($self, $itemLvl, $listType) = @_;
return 0 if $itemLvl <= 0;
return !$self->_ListTypesMatch($self->_ListTypeAt($itemLvl), $listType);
}
sub _ListTypesMatch
{
my ($self, $type1, $type2) = @_;
return ( ($type1 eq '*' and $type2 eq '*') or ($type1 ne '*' and $type2 ne '*') );
}
sub _ListTypeAt
{
my ($self, $level) = @_;
return ${$self->{mListLevel}}[$level-1];
}
sub _CurrentListLevel
{
my ($self) = @_;
return scalar @{$self->{mListLevel}};
}
sub _StartListLevelOfType
{
my ($self, $listType) = @_;
if ($listType eq '*')
{
$self->_StartNewUlLevel();
}
else
{
$self->_StartNewOlLevel();
}
}
sub _EndCurrentListLevel
{
my ($self) = @_;
my $type = pop(@{$self->{mListLevel}});
if ($type eq '*')
{
$self->_EndUlLevel();
}
else
{
$self->_EndOlLevel($type);
}
}
sub _StartNewUlLevel
{
my ($self) = @_;
$self->_PushUlListLevel();
$self->AppendLine("<ul compact>");
}
sub _EndUlLevel
{
my ($self) = @_;
$self->AppendLine("</ul>");
}
sub _StartNewOlLevel
{
my ($self) = @_;
$self->_PushOlListLevel();
$self->AppendLine("<ol compact type=" . $self->_OlListTypeAt($self->{mOlTypeLevel}) . ">");
}
sub _EndOlLevel
{
my ($self, $level) = @_;
$self->{mOlTypeLevel} = $level - 1;
$self->{mOlTypeLevel} = -1 if $self->{mOlTypeLevel} < -1;
$self->AppendLine("</ol>");
}
sub _PushUlListLevel
{
my ($self) = @_;
$self->{mOlTypeLevel} = -1;
$self->_PushListLevel('*');
}
sub _PushOlListLevel
{
my ($self) = @_;
$self->{mOlTypeLevel}++;
$self->_PushListLevel($self->{mOlTypeLevel});
}
sub _PushListLevel
{
my ($self, $level) = @_;
#level could be a number or a '*'
push(@{$self->{mListLevel}}, $level);
}
sub _NumListTypes
{
my $self = shift;
return scalar $self->{mOlType};
}
sub _OlListTypeAt
{
my ($self, $index) = @_;
$index = 0 if $index < 0;
$index = $self->_NumListTypes() - 1 if $index >= $self->_NumListTypes();
return ${$self->{mOlType}}[$index];
}
sub _CloseCurrentLists
{
my ($self) = @_;
$self->_CloseAllLists("") if $self->{mPrevWasListItem};
}
sub _CloseAllLists
{
my ($self) = @_;
$self->_AdjustListLevel("");
}
sub _HandlePreformattedLine
{
my $self = shift;
if ($self->_isPreformattedEnd)
{
$self->_closePara;
}
else
{
$self->AppendCurrentLine();
}
$self->_ClearFlags();
}
sub _HandleBlankLine
{
my $self = shift;
$self->_CloseAllLists();
if ($self->{mOutLine} =~ /<!--qwdiff-->/s)
{
my $sp = $self->{mPrevWasTextLine} ? '' : ' ';
$self->{mOutLine} =~ s/<!--qwdiff_end-->.*?$/$sp<br>$&/s;
$self->AppendCurrent();
}
else
{
$self->Append("<br>");
$self->Append("<br>") if ($self->{mPrevWasTextLine} and !$self->{mPrevWasBlankLine});
}
$self->_SetFlagsForBlankLine();
}
sub _HandleDivider
{
my $self = shift;
$self->_CloseCurrentLists();
$self->AppendLine('<hr>');
$self->_ClearFlags();
}
sub _HandlePreformattedBegin
{
my $self = shift;
$self->_CloseCurrentLists();
my $pType = 'pre';
$self->{mInParaType} = $pType;
$self->AppendLine(${$self->{mOpenParaMap}}{$pType});
$self->_ClearFlags();
}
sub _HandleListItem
{
my $self = shift;
$self->{mOutLine} =~ s/^($self->{mTagPattern})((?: )+)([*1])/$self->_AdjustListLevel($2, $3); "$1<li>"/eo;
$self->_doEmphasis;
$self->AppendCurrentLine();
$self->_SetFlagsForListItem();
}
sub _HandleNormalLine
{
my $self = shift;
$self->_CloseCurrentLists();
$self->_doEmphasis;
$self->AppendCurrentLine();
$self->_SetFlagsForNormalLine();
}
sub AppendCurrent
{
my $self = shift;
$self->Append($self->{mOutLine});
}
sub AppendCurrentLine
{
my $self = shift;
$self->AppendLine($self->{mOutLine});
}
sub AppendLine
{
my $self = shift;
my @text = @_;
$self->Append(@text,"\n");
}
sub Append
{
my $self = shift;
my @text = @_;
$self->{mOutHtml} .= join ('', @text);
}
#------------
sub _StripWikiMetaCharsInHtml
{
my ($self, $textRef) = @_;
{
local($^W) = 0; # warnings off temporarily - the undef values are intentionally used below
my ($text, $tag);
# Don't modify content between html < tags >.
$$textRef =~ s{ ([^<]*) (<[^>]*> | $ ) }
{ ($text, $tag) = ($1, $2);
Markup::StripWikiMetaChars(\$text);
"$text$tag";
}gsex;
}
}
1;
|
|
|
#!perl -w
use strict;
package WikiPageSaver;
use PageRevision;
use CGI ':standard';
use Response;
use Searcher;
use PageDB;
#-------------------------
sub new
{
my $class = shift;
my $self = {};
$self->{mPageName} = shift;
$self->{mNewText} = shift;
$self->{mExpectedRev} = shift;
$self->{mLatestRev} = 0;
$self->{mLatestMeta} = {};
$self->{mNewAuthIp} = '';
$self->{mNewAuthAddr} = '';
$self->{mNewUserName} = '';
$self->{mIsNewPage} = 0;
$self->{mIsBlankAndUnreferenced} = 0;
$self->{mUpdateType} = '';
$self->{mSaveTime} = '';
bless($self, $class);
return $self;
}
#-------------------------
sub Save
{
my $self = shift;
$self->_CleanUpEditedText();
if ($self->_IsPageBlank())
{
Response::WarningPageNotSaved($self->{mPageName});
return;
}
# Name lookup may take some time - perform before database lock
$self->{mNewAuthIp} = $qwenv::clientAddr;
$self->{mNewAuthAddr} = $qwenv::clientHostName;
$self->{mNewUserName} = $qwenv::clientName;
$self->_LockPages();
$self->_CheckIfNewPage();
$self->_CheckIfBlankAndUnreferenced();
$self->_GetUpdateType();
$self->_GetCurrentTime();
$self->{mLatestMeta} = PageRevision::FetchLatestMeta($self->{mPageName});
$self->{mLatestRev} = ${$self->{mLatestMeta} } {REV};
if ($self->_CollisionOccurred())
{
$self->_UnlockPages();
return;
}
$self->_SavePageAsRevision();
# Atomic transaction for page+search update
Searcher::Lock();
$self->_UnlockPages();
qwiki::IndexWikiPage($self->{mPageName}, $self->{mNewText}); # Index page text for searching
Searcher::Unlock();
$self->_ShowNewPage();
}
#-------------------------
#----- PRIVATE ----
#-------------------------
#-------------------------
sub _IsPageBlank
{
my $self = shift;
return $self->{mNewText} =~ /^\s*$/s;
}
#-------------------------
sub _GetCurrentTime
{
my $self = shift;
$self->{mSaveTime} = time;
}
#-------------------------
sub _ShowNewPage
{
my $self = shift;
if ($self->{mIsBlankAndUnreferenced})
{
Response::WarningSavedPageIsBlank($self->{mPageName});
return;
}
#jaa: replaced this line
# qwiki::ViewPage($self->{mPageName});
#<--
my $newurl = "$qwcfg::qwikiUrl?$self->{mPageName}";
Response::Refresh($newurl);
}
#-------------------------
sub _CheckIfNewPage
{
my $self = shift;
$self->{mIsNewPage} = ! PageRevision::Exists($self->{mPageName} );
}
#-------------------------
sub _GetUpdateType
{
my $self = shift;
$self->{mUpdateType} = ($self->{mIsBlankAndUnreferenced})? " (removed)" : (($self->{mIsNewPage})? " (new)" : "");
}
#------------
sub _CleanUpEditedText
{
my $self = shift;
$self->{mNewText} = "" unless($self->{mNewText});
$self->{mNewText} =~ s/[\015][\012]/\n/gs;
$self->{mNewText} =~ s/[\015\012]/\n/gs;
$self->{mNewText} =~ s/%0$//; #JAA HACK
$self->{mNewText} =~ s/%0\n$//; #JAA HACK
$self->{mNewText} =~ s/[\n]+$/\n/s;
}
#-------------------------
sub _CollisionOccurred
{
my $self = shift;
# Allow same author to save older edits over newer revs (which will
# happen if author has used 'back' button in browser to re-save a page.)
my $collisionMeta = undef;
unless ($self->{mIsNewPage})
{
my $rev;
for ($rev = $self->{mExpectedRev}; $rev <= $self->{mLatestRev} && ! defined($collisionMeta); $rev++)
{
my $revMeta = ($rev == $self->{mLatestRev}) ?
$self->{mLatestMeta} :
PageDB::FetchMetaForRev($self->{mPageName}, $rev);
$collisionMeta = $revMeta unless ($$revMeta{AUTHIP} eq $self->{mNewAuthIp} ||
$$revMeta{AUTHADDR} eq $self->{mNewAuthAddr});
}
}
if (defined($collisionMeta))
{
my $origRev = $self->{mExpectedRev} - 1;
$self->_handleSaveCollision($origRev, $collisionMeta);
return 1;
}
return 0;
}
#-------------------------
sub _CheckIfBlankAndUnreferenced
{
my $self = shift;
$self->{mIsBlankAndUnreferenced} =
($self->{mNewText} =~ /^\s*[`]\s*$/s) && !Searcher::IsReferenced( $self->{mPageName} );
}
#-------------------------
sub _SavePageAsRevision
{
my $self = shift;
$self->{mNewText} = undef if $self->{mIsBlankAndUnreferenced};
PageRevision::_SaveARevision($self->{mPageName}, $self->{mNewText}, $self->{mNewAuthIp}, $self->{mNewAuthAddr}, $self->{mSaveTime}, $self->{mLatestMeta}, $self->{mIsNewPage});
$self->_addRecentChange();
}
#-------------------------
sub _LockPages
{
my $self = shift;
PageDB::LockPages();
PageDB::LockRevs();
}
#-------------------------
sub _UnlockPages
{
my $self = shift;
PageDB::UnlockPages();
PageDB::UnlockRevs();
}
#------------
sub _addRecentChange
{
my $self = shift;
my $page = new PageRevision($qwcfg::RecentChanges);
$page->Fetch();
$page->StripTrailingWhite();
$page->PrependText($self->_GetNewEntryLine());
$page->Save($self->{mSaveTime}, 1);
}
#------------
sub _GetNewEntryLine
{
my $self = shift;
#Logger::logmsg("getnewentryline: u='$self->{mNewUserName}' a='$self->{mNewAuthAddr}'");
my $timetxt = $self->_GetSaveDateTime();
my $txt = $self->{mPageName} . $self->{mUpdateType};
my $name = $self->{mNewUserName} ne '' ? $self->{mNewUserName} : $self->{mNewAuthAddr};
my $textlen = length($timetxt) + length($txt) + length($name);
my $filllen = 100 - $textlen;
my $fill = $filllen < 3 ? '' : ' . ' x (int($filllen) / 3);
my $fill2 = length($fill) < 1 ? '' : ' ' x (100 - length($fill) - $textlen);
return " * $timetxt: $txt $fill2$fill $name\n";
}
#------------
sub _GetSaveDateTime
{
my $self = shift;
return DateTime::getSaveDate($self->{mSaveTime}) . ' ' . DateTime::getSaveTime($self->{mSaveTime});
}
#------------
# Passing latestMeta into _handleSaveCollision is just an (ugly) optimization
# (SavePage already had had to fetch it... so not re-fetching it here)
sub _handleSaveCollision
{
my $self = shift;
my ($origRev, $collisionMeta) = @_;
Response::StartHtml("$self->{mPageName} Save Collision");
Response::docprint h1(qq{<font color="FF7700">Alert - Save Collision</font> <small>($self->{mPageName} Not Saved)</small>});
my $timeAgo = DateTime::getDiffTime($$collisionMeta{SAVETIME}, $self->{mSaveTime});
Response::docprint p("While you were editing, $self->{mPageName} was saved by <i>$$collisionMeta{AUTHADDR}</i> "
. "$timeAgo ago. To keep your changes, you'll need to copy them into "
. "the "Newer $self->{mPageName}" edit form below.", br, br, hr);
my ($origText, $origMeta) = PageDB::FetchRevision($self->{mPageName}, $origRev);
Response::ShowCollisionEditForm($origText, $self->{mNewText});
my $latestText = PageDB::FetchLatestText($self->{mPageName});
$latestText = "" unless ($latestText);
my $expectedRev = $self->{mLatestRev} + 1;
my $editLabel = "Edit Newer $self->{mPageName}";
my $allowEditCopy = 0;
Response::DisplayEditForm($self->{mPageName}, $latestText, $expectedRev, $editLabel, $allowEditCopy);
}
1;
|
|
|
#!/usr/bin/perl -w
BEGIN { umask(000); open (STDERR, ">>qwiki-log.txt"); }
print STDERR (scalar(localtime)." $0 for ".($ENV{'HTTP_CLIENT_ADDR'} || $ENV{'REMOTE_ADDR'})."\n");
use strict;
require FSDBM_File;
require FulltextIndexer_Adaptor;
require porter; # word stemmer
require qwcfg; # QwikWiki config
$| = 1; # enable autoflush
print "Content-type:text/html\n\n<pre>\n";
# stupidity to quell damnable 'only used once' warning :-((
$dev::null = $qwcfg::pagesDbPath . $qwcfg::revsDbPath
. $qwcfg::searchDbPath . $qwcfg::stopwordsFile;
undef $dev::null;
# end stupidity
%qwdbm::pages = ();
%qwdbm::revs = ();
%qwdbm::searchDb = ();
%qwdbm::search = ();
tie(%qwdbm::pages, 'FSDBM_File', $qwcfg::pagesDbPath);
tie(%qwdbm::revs, 'FSDBM_File', $qwcfg::revsDbPath);
tie(%qwdbm::searchDb, 'FSDBM_File', $qwcfg::searchDbPath);
tie(%qwdbm::search, 'FulltextIndexer_Adaptor',
\%qwdbm::searchDb, 1, $qwcfg::stopwordsFile, \&porter::porter);
my $bak = "db.bak.tar";
my $bak2 = "db.bak2.tar";
my $bak_gz = "$bak.gz";
my $bak2_gz = "$bak2.gz";
chdir $qwcfg::qwikiProgRoot or die "can't chdir to $qwcfg::qwikiProgRoot! Aborting. ($!)";
if (-f $bak_gz) {
print "Preserving previous backup as $bak2_gz...\n";
unlink $bak2_gz if (-f $bak2_gz);
rename ($bak_gz, $bak2_gz) or die "rename ($bak_gz, $bak2_gz) failed! Aborting. ($!)";
}
print "Locking all databases...\n";
tied(%qwdbm::pages)->LockDb();
tied(%qwdbm::revs)->LockDb();
tied(%qwdbm::search)->LockDb(); # locking search handles locking its searchDb
print "Tarring to $bak...\n";
`tar cf $bak db`;
print "Unlocking all databases...\n";
tied(%qwdbm::search)->UnlockDb();
tied(%qwdbm::revs)->UnlockDb();
tied(%qwdbm::pages)->UnlockDb();
print "Zipping to $bak_gz...\n";
`gzip $bak`;
print "Finished.\n";
untie(%qwdbm::search);
untie(%qwdbm::searchDb);
untie(%qwdbm::revs);
untie(%qwdbm::pages);
# eof
|
|
|
#!/usr/bin/perl -w
$| = 1; # I, uh, want my pipes to be piping hot? (autoflush on)
print "Content-type:text/html\n\n";
print qq{<title>Wiki Down For Maintenance</title>\n};
print qq{<font color="FF0000"><h1>Wiki temporarily offline</h1></font>\n};
print qq{<p>Should be back in about 15 minutes . . .<br>We are sorry for any inconvenience.</p>};
|
|
|
#!/usr/local/bin/perl -w
use strict;
use qwcfg;
use File::Copy;
#print "cfg: $qwcfg::revsDbPath\n";
my $pagename = $ARGV[0];
die "usage: recover pagename" if (! defined $pagename);
my @revs = <$qwcfg::revsDbPath/$pagename/*.>;
my $maxrev = -1;
foreach (@revs)
{
my ($dir, $rev) = /\/([^\/]+)\/([^\/]+)$/;
#print "rev: $rev\n";
$maxrev = $rev if ($rev > $maxrev);
}
print "maxrev: $maxrev\n";
copy "$qwcfg::revsDbPath/$pagename/$maxrev", "$qwcfg::pagesDbPath/$pagename";
copy "$qwcfg::revsDbPath/$pagename/$maxrev\.meta", "$qwcfg::pagesDbPath/$pagename\.meta";
|
|
|
#!/usr/bin/perl -w
BEGIN { umask(000) }
use strict;
require FSDBM_File;
require FulltextIndexer_Adaptor;
require porter; # word stemmer
require qwcfg; # QwikWiki config
use qwiki qw( &IndexWikiPage &ValidWikiName );
%qwdbm::pages = ();
%qwdbm::searchDb = ();
%qwdbm::search = ();
print "Tying...\n";
tie(%qwdbm::pages, 'FSDBM_File', $qwcfg::pagesDbPath);
tie(%qwdbm::searchDb, 'FSDBM_File', $qwcfg::searchDbPath);
tie(%qwdbm::search, 'FulltextIndexer_Adaptor',
\%qwdbm::searchDb, 1, $qwcfg::stopwordsFile, \&porter::porter);
print "Locking pages...\n";
tied(%qwdbm::pages)->LockDb();
print "Locking index...\n";
tied(%qwdbm::search)->LockDb();
# Delete existing search indicies
print "Deleting old indicies...\n";
my $docName;
foreach $docName (sort keys %qwdbm::search) {
print " $docName\n";
delete $qwdbm::search{$docName};
}
# Rebuild index
print "Re-indexing pages...\n";
foreach $docName (sort keys %qwdbm::pages)
{
next unless validWikiName($docName); # weed out metadata files
print " $docName\n";
my $docText = $qwdbm::pages{$docName};
IndexWikiPage($docName, $docText);
}
print "Re-index complete.\n";
tied(%qwdbm::search)->UnlockDb();
tied(%qwdbm::pages)->UnlockDb();
untie(%qwdbm::search);
untie(%qwdbm::searchDb);
untie(%qwdbm::pages);
# eof
|