tags, 0 = classic wiki
$BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions $UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times $UseIndex = 0; # 1 = use index file, 0 = slow/reliable method $UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting $NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links $BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions $UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only) $FreeUpper = 1; # 1 = force upper case, 0 = do not force case $FastGlob = 1; # 1 = new faster code, 0 = old compatible code $MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse $NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors, # 2 = enable but suppress display $SlashLinks = 0; # 1 = use script/action links, 0 = script?action $UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst $AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar $RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable $ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete $MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking $LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks $HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links $OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line $NumberDates = 0; # 1 = 2003-06-17 dates, 0 = June 17, 2003 dates $ParseParas = 0; # 1 = new paragraph markup, 0 = old markup $AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show $AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins $LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits $MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc $SearchButton = 0; # 1 = search button on page, 0 = old behavior $EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links $UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links $BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img # Names of sites. (The first entry is used for the number link.) @IsbnNames = ('bn.com', 'amazon.com', 'search'); # Full URL of each site before the ISBN @IsbnPre = ('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?isbn=', 'http://www.amazon.com/exec/obidos/ISBN=', 'http://www.pricescan.com/books/BookDetail.asp?isbn='); # Rest of URL of each site after the ISBN (usually '') @IsbnPost = ('', '', ''); # HTML tag lists, enabled if $HtmlTags is set. # Scripting is currently possible with these tags, # so they are *not* particularly "safe". # Tags that must be in
tags, 0 = classic wiki
$BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions $UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times $UseIndex = 0; # 1 = use index file, 0 = slow/reliable method $UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting $NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links $BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions $UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only) $FreeUpper = 1; # 1 = force upper case, 0 = do not force case $FastGlob = 1; # 1 = new faster code, 0 = old compatible code $MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse $NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors, # 2 = enable but suppress display $SlashLinks = 0; # 1 = use script/action links, 0 = script?action $UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst $AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar $RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable $ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete $MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking $LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks $HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links $OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line $NumberDates = 0; # 1 = 2003-06-17 dates, 0 = June 17, 2003 dates $ParseParas = 0; # 1 = new paragraph markup, 0 = old markup $AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show $AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins $LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits $MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc $SearchButton = 0; # 1 = search button on page, 0 = old behavior $EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links $UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links $BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img # Names of sites. (The first entry is used for the number link.) @IsbnNames = ('bn.com', 'amazon.com', 'search'); # Full URL of each site before the ISBN @IsbnPre = ('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?isbn=', 'http://www.amazon.com/exec/obidos/ISBN=', 'http://www.pricescan.com/books/BookDetail.asp?isbn='); # Rest of URL of each site after the ISBN (usually '') @IsbnPost = ('', '', ''); # HTML tag lists, enabled if $HtmlTags is set. # Scripting is currently possible with these tags, # so they are *not* particularly "safe". # Tags that must be in
"; } else { $fullHtml .= '' . Ts('Revision %s not available', $revision) . ' (' . T('showing current revision instead') . ')
'; } } $allDiff = &GetParam('alldiff', 0); if ($allDiff != 0) { $allDiff = &GetParam('defaultdiff', 1); } if ((($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) && &GetParam('norcdiff', 1)) { $allDiff = 0; # Only show if specifically requested } $showDiff = &GetParam('diff', $allDiff); if ($UseDiff && $showDiff) { $diffRevision = $goodRevision; $diffRevision = &GetParam('diffrevision', $diffRevision); # Eventually try to avoid the following keep-loading if possible? &OpenKeptRevisions('text_default') if (!$openKept); $fullHtml .= &GetDiffHTML($showDiff, $id, $diffRevision, $revision, $newText); $fullHtml .= "
\n"; } $fullHtml .= '
\n"; print '
" . Ts('Updates since %s', &TimeToText($starttime)) . "
\n"; } } else { $daysago = &GetParam("days", 0); $daysago = &GetParam("rcdays", 0) if ($daysago == 0); if ($daysago) { $starttime = $Now - ((24*60*60)*$daysago); if ($showHTML) { print "" . Ts('Updates in the last %s day' . (($daysago != 1)?"s":""), $daysago) . "
\n"; } # Note: must have two translations (for "day" and "days") # Following comment line is for translation helper script # Ts('Updates in the last %s days', ''); } } if ($starttime == 0) { if (0 == $rcType) { $starttime = $Now - ((24*60*60)*$RssDays); } else { $starttime = $Now - ((24*60*60)*$RcDefault); } if ($showHTML) { print "" . Ts('Updates in the last %s day' . (($RcDefault != 1)?"s":""), $RcDefault) . "
\n"; } # Translation of above line is identical to previous version } # Read rclog data (and oldrclog data if needed) ($status, $fileData) = &ReadFile($RcFile); $errorText = ""; if (!$status) { # Save error text if needed. $errorText = '' . Ts('Could not open %s log file', $RCName) . ": $RcFile
" . T('Error was') . ":\n
$!\n" . '
' . T('Note: This error is normal if no changes have been made.') . "\n"; } @fullrc = split(/\n/, $fileData); $firstTs = 0; if (@fullrc > 0) { # Only false if no lines in file ($firstTs) = split(/$FS3/, $fullrc[0]); } if (($firstTs == 0) || ($starttime <= $firstTs)) { ($status, $oldFileData) = &ReadFile($RcOldFile); if ($status) { @fullrc = split(/\n/, $oldFileData . $fileData); } else { if ($errorText ne "") { # could not open either rclog file print $errorText; print "
" . Ts('Could not open old %s log file', $RCName) . ": $RcOldFile
" . T('Error was') . ":\n
$!\n"; return; } } } $lastTs = 0; if (@fullrc > 0) { # Only false if no lines in file ($lastTs) = split(/$FS3/, $fullrc[$#fullrc]); } $lastTs++ if (($Now - $lastTs) > 5); # Skip last unless very recent $idOnly = &GetParam("rcidonly", ""); if ($idOnly && $showHTML) { print '(' . Ts('for %s only', &ScriptLink($idOnly, &QuoteHtml($idOnly)), 1) . ')
'; } if ($showHTML) { foreach $i (@RcDays) { print " | " if $showbar; $showbar = 1; print &ScriptLink("action=rc&days=$i", Ts('%s day' . (($i != 1)?'s':''), $i)); # Note: must have two translations (for "day" and "days") # Following comment line is for translation helper script # Ts('%s days', ''); } print "
" . &ScriptLink("action=rc&from=$lastTs", T('List new changes starting from')); print " " . &TimeToText($lastTs) . "
\n"; } $i = 0; while ($i < @fullrc) { # Optimization: skip old entries quickly ($ts) = split(/$FS3/, $fullrc[$i]); if ($ts >= $starttime) { $i -= 1000 if ($i > 0); last; } $i += 1000; } $i -= 1000 if (($i > 0) && ($i >= @fullrc)); for (; $i < @fullrc ; $i++) { ($ts) = split(/$FS3/, $fullrc[$i]); last if ($ts >= $starttime); } if ($i == @fullrc && $showHTML) { print '
' . Ts('No updates since %s', &TimeToText($starttime)) . "
\n"; } else { splice(@fullrc, 0, $i); # Remove items before index $i # Consider an end-time limit (items older than X) if (0 == $rcType) { print &GetRcRss(@fullrc); } else { print &GetRcHtml(@fullrc); } } if ($showHTML) { print '
' . Ts('Page generated %s', &TimeToText($Now)), "
\n";
}
}
sub GetRc {
my $rcType = shift;
my @outrc = @_;
my ($rcline, $date, $newtop, $author, $inlist, $result);
my ($showedit, $link, $all, $idOnly, $headItem, $item);
my ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp);
my ($rcchangehist, $tEdit, $tChanges, $tDiff);
my ($headList, $pagePrefix, $historyPrefix, $diffPrefix);
my %extra = ();
my %changetime = ();
my %pagecount = ();
# Slice minor edits
$showedit = &GetParam("rcshowedit", $ShowEdits);
$showedit = &GetParam("showedit", $showedit);
if ($showedit != 1) {
my @temprc = ();
foreach $rcline (@outrc) {
($ts, $pagename, $summary, $isEdit, $host) = split(/$FS3/, $rcline);
if ($showedit == 0) { # 0 = No edits
push(@temprc, $rcline) if (!$isEdit);
} else { # 2 = Only edits
push(@temprc, $rcline) if ($isEdit);
}
}
@outrc = @temprc;
}
# Optimize param fetches out of main loop
$rcchangehist = &GetParam("rcchangehist", 1);
# Optimize translations out of main loop
$tEdit = T('(edit)');
$tDiff = T('(diff)');
$tChanges = T('changes');
$pagePrefix = $QuotedFullUrl . &ScriptLinkChar();
$diffPrefix = $pagePrefix . &QuoteHtml("action=browse&diff=4&id=");
$historyPrefix = $pagePrefix . &QuoteHtml("action=history&id=");
foreach $rcline (@outrc) {
($ts, $pagename) = split(/$FS3/, $rcline);
$pagecount{$pagename}++;
$changetime{$pagename} = $ts;
}
$date = "";
$all = &GetParam("rcall", 0);
$all = &GetParam("all", $all);
$newtop = &GetParam("rcnewtop", $RecentTop);
$newtop = &GetParam("newtop", $newtop);
$idOnly = &GetParam("rcidonly", "");
$inlist = 0;
$headList = '';
$result = '';
@outrc = reverse @outrc if ($newtop);
foreach $rcline (@outrc) {
($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp)
= split(/$FS3/, $rcline);
next if ((!$all) && ($ts < $changetime{$pagename}));
next if (($idOnly ne "") && ($idOnly ne $pagename));
%extra = split(/$FS2/, $extraTemp, -1);
if ($date ne &CalcDay($ts)) {
$date = &CalcDay($ts);
if (1 == $rcType) { # HTML
# add date, properly closing lists first
if ($inlist) {
$result .= "\n";
$inlist = 0;
}
$result .= "
" . $date . "
\n"; if (!$inlist) { $result .= "- \n";
$inlist = 1;
}
}
}
if (0 == $rcType) { # RSS
($headItem, $item) = &GetRssRcLine($pagename, $ts, $host,
$extra{'name'}, $extra{'id'}, $summary, $isEdit,
$pagecount{$pagename}, $extra{'revision'},
$diffPrefix, $historyPrefix, $pagePrefix);
$headList .= $headItem;
$result .= $item;
} else { # HTML
$result .= &GetHtmlRcLine($pagename, $ts, $host, $extra{'name'},
$extra{'id'}, $summary, $isEdit,
$pagecount{$pagename}, $extra{'revision'},
$tEdit, $tDiff, $tChanges, $all, $rcchangehist);
}
}
if (1 == $rcType) {
$result .= "
\n"; print &GetDiffHTML(&GetParam('defaultdiff', 1), $id, '', '', $newText); } print &GetCommonFooter(); } sub GetMaskedHost { my ($text) = @_; my ($logText); if (!$MaskHosts) { return $text; } $logText = T('(logged)'); if (!($text =~ s/\d+$/$logText/)) { # IP address (ending numbers masked) $text =~ s/^[^\.\(]+/$logText/; # Host name: mask until first . } return $text; } sub GetHistoryLine { my ($id, $section, $canEdit, $row) = @_; my ($html, $expirets, $rev, $summary, $host, $user, $uid, $ts, $minor); my (%sect, %revtext); %sect = split(/$FS2/, $section, -1); %revtext = split(/$FS3/, $sect{'data'}); $rev = $sect{'revision'}; $summary = $revtext{'summary'}; if ((defined($sect{'host'})) && ($sect{'host'} ne '')) { $host = $sect{'host'}; } else { $host = $sect{'ip'}; } $host = &GetMaskedHost($host); $user = $sect{'username'}; $uid = $sect{'id'}; $ts = $sect{'ts'}; $minor = ''; $minor = '' . T('(edit)') . ' ' if ($revtext{'minor'}); $expirets = $Now - ($KeepDays * 24 * 60 * 60); if ($UseDiff) { my ($c1, $c2); $c1 = 'checked="checked"' if 1 == $row; $c2 = 'checked="checked"' if 0 == $row; $html .= "
\n"; return $html; } # ==== HTML and page-oriented functions ==== sub ScriptLinkChar { if ($SlashLinks) { return '/'; } return '?'; } sub ScriptLink { my ($action, $text) = @_; return '$text"; } sub ScriptLinkClass { my ($action, $text, $class) = @_; return '$text"; } sub GetPageLinkText { my ($id, $name) = @_; $id =~ s|^/|$MainPage/|; if ($FreeLinks) { $id = &FreeToNormal($id); $name =~ s/_/ /g; } return &ScriptLinkClass($id, $name, 'wikipagelink'); } sub GetPageLink { my ($id) = @_; return &GetPageLinkText($id, $id); } sub GetEditLink { my ($id, $name) = @_; if ($FreeLinks) { $id = &FreeToNormal($id); $name =~ s/_/ /g; } return &ScriptLinkClass("action=edit&id=$id", $name, 'wikipageedit'); } sub GetDeleteLink { my ($id, $name, $confirm) = @_; if ($FreeLinks) { $id = &FreeToNormal($id); $name =~ s/_/ /g; } return &ScriptLink("action=delete&id=$id&confirm=$confirm", $name); } sub GetOldPageParameters { my ($kind, $id, $revision) = @_; $id = &FreeToNormal($id) if $FreeLinks; return "action=$kind&id=$id&revision=$revision"; } sub GetOldPageLink { my ($kind, $id, $revision, $name) = @_; $name =~ s/_/ /g if $FreeLinks; return &ScriptLink(&GetOldPageParameters($kind, $id, $revision), $name); } sub GetPageOrEditAnchoredLink { my ($id, $anchor, $name) = @_; my (@temp, $exists); if ($name eq "") { $name = $id; if ($FreeLinks) { $name =~ s/_/ /g; } } $id =~ s|^/|$MainPage/|; if ($FreeLinks) { $id = &FreeToNormal($id); } $exists = 0; if ($UseIndex) { if (!$IndexInit) { @temp = &AllPagesList(); # Also initializes hash } $exists = 1 if ($IndexHash{$id}); } elsif (-f &GetPageFile($id)) { # Page file exists $exists = 1; } if ($exists) { $id = "$id#$anchor" if $anchor; $name = "$name#$anchor" if $anchor && $NamedAnchors != 2; return &GetPageLinkText($id, $name); } if ($FreeLinks && !$EditNameLink) { if ($name =~ m| |) { # Not a single word $name = "[$name]"; # Add brackets so boundaries are obvious } } if ($EditNameLink) { return &GetEditLink($id, $name); } else { return $name . &GetEditLink($id, '?'); } } sub GetPageOrEditLink { my ($id, $name) = @_; return &GetPageOrEditAnchoredLink($id, "", $name); } sub GetBackLinksSearchLink { my ($id) = @_; my $name = $id; $id =~ s|.+/|/|; # Subpage match: search for just /SubName if ($FreeLinks) { $name =~ s/_/ /g; # Display with spaces $id =~ s/_/+/g; # Search for url-escaped spaces } return &ScriptLink("back=$id", $name); } sub GetPrefsLink { return &ScriptLink("action=editprefs", T('Preferences')); } sub GetRandomLink { return &ScriptLink("action=random", T('Random Page')); } sub ScriptLinkDiff { my ($diff, $id, $text, $rev) = @_; $rev = "&revision=$rev" if ($rev ne ""); $diff = &GetParam("defaultdiff", 1) if ($diff == 4); return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text); } sub ScriptLinkDiffRevision { my ($diff, $id, $rev, $text) = @_; $rev = "&diffrevision=$rev" if ($rev ne ""); $diff = &GetParam("defaultdiff", 1) if ($diff == 4); return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text); } sub GetUploadLink { return &ScriptLink('action=upload', T('Upload')); } sub ScriptLinkTitle { my ($action, $text, $title) = @_; if ($FreeLinks) { $action =~ s/ /_/g; } return '$text"; } sub GetAuthorLink { my ($host, $userName, $uid) = @_; my ($html, $title, $userNameShow); $userNameShow = $userName; if ($FreeLinks) { $userName =~ s/ /_/g; $userNameShow =~ s/_/ /g; } if (&ValidId($userName) ne "") { # Invalid under current rules $userName = ""; # Just pretend it isn't there. } if (($uid > 0) && ($userName ne "")) { $html = &ScriptLinkTitle($userName, $userNameShow, Ts('ID %s', $uid) . ' ' . Ts('from %s', $host)); } else { $html = $host; } return $html; } sub GetHistoryLink { my ($id, $text) = @_; if ($FreeLinks) { $id =~ s/ /_/g; } return &ScriptLink("action=history&id=$id", $text); } sub GetHeader { my ($id, $title, $oldId, $backlinks) = @_; my $header = ""; my $logoImage = ""; my $result = ""; my $embed = &GetParam('embed', $EmbedWiki); my $altText = T('[Home]'); $result = &GetHttpHeader(''); if ($FreeLinks) { $title =~ s/_/ /g; # Display as spaces } $result .= &GetHtmlHeader("$SiteName: $title", $id); return $result if ($embed); $result .= '
"; } $result .= '
\n"; return $bartext; } # Admin bar contributed by ElMoro (with some changes) sub GetPageLockLink { my ($id, $status, $name) = @_; if ($FreeLinks) { $id = &FreeToNormal($id); } return &ScriptLink("action=pagelock&set=$status&id=$id", $name); } sub GetAdminBar { my ($id) = @_; my ($result); $result = T('Administration') . ': '; if (-f &GetLockedPageFile($id)) { $result .= &GetPageLockLink($id, 0, T('Unlock page')); } else { $result .= &GetPageLockLink($id, 1, T('Lock page')); } $result .= " | " . &GetDeleteLink($id, T('Delete this page'), 0); $result .= " | " . &ScriptLink("action=editbanned", T("Edit Banned List")); $result .= " | " . &ScriptLink("action=maintain", T("Run Maintenance")); $result .= " | " . &ScriptLink("action=editlinks", T("Edit/Rename pages")); if (-f "$DataDir/noedit") { $result .= " | " . &ScriptLink("action=editlock&set=0", T("Unlock site")); } else { $result .= " | " . &ScriptLink("action=editlock&set=1", T("Lock site")); } return $result; } sub GetSearchForm { my ($result); $result = T('Search:') . ' ' . $q->textfield(-name=>'search', -size=>20); if ($SearchButton) { $result .= $q->submit('dosearch', T('Go!')); } else { $result .= &GetHiddenValue("dosearch", 1); } return $result; } sub GetRedirectPage { my ($newid, $name, $isEdit) = @_; my ($url, $html); my ($nameLink); # Normally get URL from script, but allow override. $FullUrl = $q->url(-full=>1) if ($FullUrl eq ""); $url = $FullUrl . &ScriptLinkChar() . &UriEscape($newid); $nameLink = "$name"; if ($RedirType < 3) { if ($RedirType == 1) { # Use CGI.pm # NOTE: do NOT use -method (does not work with old CGI.pm versions) # Thanks to Daniel Neri for fixing this problem. $html = $q->redirect(-uri=>$url); } else { # Minimal header $html = "Status: 302 Moved\n"; $html .= "Location: $url\n"; $html .= "Content-Type: text/html\n"; # Needed for browser failure $html .= "\n"; } $html .= "\n" . Ts('Your browser should go to the %s page.', $newid); $html .= ' ' . Ts('If it does not, click %s to continue.', $nameLink); } else { if ($isEdit) { $html = &GetHeader('', T('Thanks for editing...'), ''); $html .= Ts('Thank you for editing %s.', $nameLink); } else { $html = &GetHeader('', T('Link to another page...'), ''); } $html .= "\n
";
$html .= Ts('Follow the %s link to continue.', $nameLink);
$html .= &GetMinimumFooter();
}
return $html;
}
# ==== Common wiki markup ====
sub RestoreSavedText {
my ($text) = @_;
1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
return $text;
}
sub RemoveFS {
my ($text) = @_;
# Note: must remove all $FS, and $FS may be multi-byte/char separator
$text =~ s/($FS)+(\d)/$2/g;
return $text;
}
sub WikiToHTML {
my ($pageText) = @_;
$TableMode = 0;
%SaveUrl = ();
%SaveNumUrl = ();
$SaveUrlIndex = 0;
$SaveNumUrlIndex = 0;
$pageText = &RemoveFS($pageText);
if ($RawHtml) {
$pageText =~ s/((.|\n)*?)<\/html>/&StoreRaw($1)/ige;
}
$pageText = &QuoteHtml($pageText);
$pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end
if ($ParseParas) {
# Note: The following 3 rules may span paragraphs, so they are
# copied from CommonMarkup
$pageText =~
s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige;
$pageText =~
s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
$pageText =~
s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
$pageText =~ s/((.|\n)+?\n)\s*(\n|$)/&ParseParagraph($1)/geo;
$pageText =~ s/(.*)<\/p>(.+)$/$1.&ParseParagraph($2)/seo;
} else {
$pageText = &CommonMarkup($pageText, 1, 0); # Multi-line markup
$pageText = &WikiLinesToHtml($pageText); # Line-oriented markup
}
while (@HeadingNumbers) {
pop @HeadingNumbers;
$TableOfContents .= "\n\n";
}
$pageText =~ s/<toc>/$TableOfContents/gi;
if ($LateRules ne '') {
$pageText = &EvalLocalRules($LateRules, $pageText, 0);
}
return &RestoreSavedText($pageText);
}
sub CommonMarkup {
my ($text, $useImage, $doLines) = @_;
local $_ = $text;
if ($doLines < 2) { # 2 = do line-oriented only
# The \n/; # Blank lines become tags
}
$pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup
}
while (@htmlStack > 0) { # Clear stack
$pageHtml .= "\n";
}
return $pageHtml;
}
sub EvalLocalRules {
my ($rules, $origText, $isDiff) = @_;
my ($text, $reportError, $errorText);
$text = $origText;
$reportError = 1;
# Basic idea: the $rules should change $text, possibly with different
# behavior if $isDiff is true (no images or color changes?)
# Note: for fun, the $rules could also change $reportError and $origText
if (!eval $rules) {
$errorText = $@;
if ($errorText eq '') {
# Search for "Unknown Error" for the reason the next line is commented
# $errorText = T('Unknown Error (no error text)');
}
if ($errorText ne '') {
$text = $origText; # Consider: should partial results be kept?
if ($reportError) {
$text .= ' $text ";
print T('Contact the wiki administrator for more information.');
} else {
print Ts('Editing not allowed: %s is read-only.', $SiteName);
}
print &GetCommonFooter();
return;
}
# Consider sending a new user-ID cookie if user does not have one
&OpenPage($id);
&OpenDefaultText();
$pageTime = $Section{'ts'};
$header = Ts('Editing %s', $id);
# Old revision handling
$revision = &GetParam('revision', '');
$revision =~ s/\D//g; # Remove non-numeric chars
if ($revision ne '') {
&OpenKeptRevisions('text_default');
if (!defined($KeptRevisions{$revision})) {
$revision = '';
# Consider better solution like error message?
} else {
&OpenKeptRevision($revision);
$header = Ts('Editing revision %s of ', $revision ) . $id;
}
}
$oldText = $Text{'text'};
if ($preview && !$isConflict) {
$oldText = $newText;
}
$editRows = &GetParam("editrows", 20);
$editCols = &GetParam("editcols", 65);
print &GetHeader($id, &QuoteHtml($header), '');
if ($revision ne '') {
print "\n"
. Ts('Editing old revision %s.', $revision) . " "
. T('Saving this page will replace the latest revision with this text.')
. ' ",
T('Someone saved this page after you started editing.'), " ",
T('The top textbox contains the saved text.'), " ",
T('Only the text in the top textbox will be saved.'),
" ", T('Summary:'),
$q->textfield(-name=>'summary',
-default=>$summary, -override=>1,
-size=>60, -maxlength=>200);
if (&GetParam("recent_edit") eq "on") {
print " ", T('This is the text you submitted:'),
" ",
&GetTextArea('newtext', $newText, $editRows, $editCols),
" \n";
}
if ($preview) {
print ' ', T('This operation may take several seconds...'), "\n";
if (&ForceReleaseLock('main')) {
$LockMessage = T('Forced Unlock.');
}
&ForceReleaseLock('cache');
&ForceReleaseLock('diff');
&ForceReleaseLock('index');
print " ' . Ts('Could not open %s log file', $RCName)
. ": $RcFile "
. T('Error was') . ":\n ';
return 0;
}
# Move the old stuff from rc to temp
@rc = split(/\n/, $data);
for ($i = 0; $i < @rc; $i++) {
($ts) = split(/$FS3/, $rc[$i]);
last if ($ts >= $starttime);
}
return 1 if ($i < 1); # No lines to move from new to old
@temp = splice(@rc, 0, $i);
# Write new files and backups
if (!open(OUT, ">>$RcOldFile")) {
print ' ' . Ts('Could not open %s log file', $RCName)
. ": $RcOldFile "
. T('Error was') . ":\n ';
return 0;
}
print OUT join("\n", @temp) . "\n";
close(OUT);
&WriteStringToFile($RcFile . '.old', $data);
$data = join("\n", @rc);
$data .= "\n" if ($data ne ''); # If no entries, don't add blank line
&WriteStringToFile($RcFile, $data);
return 1;
}
sub DoMaintainRc {
print &GetHeader('', T('Maintaining RC log'), '');
return if (!&UserIsAdminOrError());
&RequestLock() or die(T('Could not get lock for RC maintenance'));
if (&TrimRc()) {
print T('RC maintenance done.') . ' ', T('This operation is restricted to site editors only...');
print &GetCommonFooter();
return 0;
}
return 1;
}
sub UserIsAdminOrError {
if (!&UserIsAdmin()) {
print ' ', T('This operation is restricted to administrators only...');
print &GetCommonFooter();
return 0;
}
return 1;
}
sub DoEditLock {
my ($set, $fname);
$set = &GetParam("set", 1) ? 1 : 0;
if ($set) {
print &GetHeader('', T('Set global edit lock'), '');
} else {
print &GetHeader('', T('Remove global edit lock'), '');
}
return if (!&UserIsAdminOrError());
$fname = "$DataDir/noedit";
if ($set) {
&WriteStringToFile($fname, "editing locked.");
} else {
unlink($fname);
}
if (-f $fname) {
print ' ', T('Edit lock created.'), ' ', T('Edit lock removed.'), ' ', T('Missing page id to lock/unlock...');
return;
}
return if (!&ValidIdOrDie($id)); # Consider nicer error?
$fname = &GetLockedPageFile($id);
if ($set) {
&WriteStringToFile($fname, "editing locked.");
} else {
unlink($fname);
}
if (-f $fname) {
print ' ', Ts('Lock for %s created.', $id), ' ', Ts('Lock for %s removed.', $id), ' Each entry is either a commented line (starting with #), ",
"or a Perl regular expression (matching either an IP address or ",
"a hostname). Note: To test the ban on yourself, you must ",
"give up your admin access (remove password in Preferences).";
print " Example: ";
print &GetTextArea('banlist', $banList, 12, 50);
print " ", T('Empty banned list or error.');
print " ", T('Resubmit with at least one space character to remove.');
} elsif ($newList =~ /^\s*$/s) {
unlink($fname);
print " ", T('Removed banned list');
} else {
&WriteStringToFile($fname, $newList);
print " ", T('Updated banned list');
}
print &GetCommonFooter();
}
# ==== Editing/Deleting pages and links ====
sub DoEditLinks {
print &GetHeader('', T('Editing Links'), '');
if ($AdminDelete) {
return if (!&UserIsAdminOrError());
} else {
return if (!&UserIsEditorOrError());
}
print &GetFormStart();
print GetHiddenValue("edit_links", 1), "\n";
print "Editing/Deleting page titles: Enter one command on each line. Commands are: ", T('Empty command list or error.');
} else {
&UpdateLinksList($commandList, $doRC, $doText);
print " ", T('Finished command list.');
}
print &GetCommonFooter();
}
sub EditRecentChanges {
my ($action, $old, $new) = @_;
&EditRecentChangesFile($RcFile, $action, $old, $new, 1);
&EditRecentChangesFile($RcOldFile, $action, $old, $new, 0);
}
sub EditRecentChangesFile {
my ($fname, $action, $old, $new, $printError) = @_;
my ($status, $fileData, $errorText, $rcline, @rclist);
my ($outrc, $ts, $page, $junk);
($status, $fileData) = &ReadFile($fname);
if (!$status) {
# Save error text if needed.
$errorText = " "
. Ts('Could not open %s log file:', $RCName)
. " $fname"
. " " . T('Error was:') . "\n UseModWiki version 1.0.6 ';
print Ts('Confirm deletion of %s by following this link:', $id);
print ' ';
if ($id eq $HomePage) {
print Ts('%s can not be deleted.', $HomePage);
} else {
if (-f &GetLockedPageFile($id)) {
print Ts('%s can not be deleted because it is locked.', $id);
} else {
# Must lock because of RC-editing
&RequestLock() or die(T('Could not get editing lock'));
DeletePage($id, 1, 1);
&ReleaseLock();
print Ts('%s has been deleted.', $id);
}
}
print ' ' . Ts('The current upload size limit is %s.', $MaxPost) . ' '
. Ts('Change the %s variable to increase this limit.', '$MaxPost');
print ' tag wraps the stored text with the HTML
tag
s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
if ($EarlyRules ne '') {
$_ = &EvalLocalRules($EarlyRules, $_, !$useImage);
}
s/\[\#(\w+)\]/&StoreHref(" name=\"$1\"")/ge if $NamedAnchors;
if ($HtmlTags) {
my ($t);
foreach $t (@HtmlPairs) {
s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis;
}
foreach $t (@HtmlSingle) {
s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi;
}
} else {
# Note that these tags are restricted to a single line
s/\<b\>(.*?)\<\/b\>/$1<\/b>/gi;
s/\<i\>(.*?)\<\/i\>/$1<\/i>/gi;
s/\<strong\>(.*?)\<\/strong\>/$1<\/strong>/gi;
s/\<em\>(.*?)\<\/em\>/$1<\/em>/gi;
}
s/\<tt\>(.*?)\<\/tt\>/$1<\/tt>/gis; # (MeatBall)
s/\<br\>/
/gi; # Allow simple line break anywhere
if ($HtmlLinks) {
s/\<A(\s[^<>]+?)\>(.*?)\<\/a\>/&StoreHref($1, $2)/gise;
}
if ($FreeLinks) {
# Consider: should local free-link descriptions be conditional?
# Also, consider that one could write [[Bad Page|Good Page]]?
s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo;
s/\[\[$FreeLinkPattern\]\]/&StorePageOrEditLink($1, "")/geo;
}
if ($BracketText) { # Links like [URL text of link]
s/\[$UrlPattern\s+([^\]]+?)\]/&StoreBracketUrl($1, $2, $useImage)/geos;
s/\[$InterLinkPattern\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2,
$useImage)/geos;
if ($WikiLinks && $BracketWiki) { # Local bracket-links
s/\[$LinkPattern\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos;
s/\[$AnchoredLinkPattern\s+([^\]]+?)\]/&StoreBracketAnchoredLink($1,
$2, $3)/geos if $NamedAnchors;
}
}
s/\[$UrlPattern\]/&StoreBracketUrl($1, "", 0)/geo;
s/\[$InterLinkPattern\]/&StoreBracketInterPage($1, "", 0)/geo;
s/\b$UrlPattern/&StoreUrl($1, $useImage)/geo;
s/\b$InterLinkPattern/&StoreInterPage($1, $useImage)/geo;
if ($UseUpload) {
s/$UploadPattern/&StoreUpload($1)/geo;
}
if ($WikiLinks) {
s/$AnchoredLinkPattern/&StoreRaw(&GetPageOrEditAnchoredLink($1,
$2, ""))/geo if $NamedAnchors;
# CAA: Putting \b in front of $LinkPattern breaks /SubPage links
# (subpage links without the main page)
s/$LinkPattern/&GetPageOrEditLink($1, "")/geo;
}
s/\b$RFCPattern/&StoreRFC($1)/geo;
s/\b$ISBNPattern/&StoreISBN($1)/geo;
if ($ThinLine) {
if ($OldThinLine) { # Backwards compatible, conflicts with headers
s/====+/
/g;
} else { # New behavior--no conflict
s/------+/
/g;
}
s/----+/
/g;
} else {
s/----+/
/g;
}
}
if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented
# The quote markup patterns avoid overlapping tags (with 5 quotes)
# by matching the inner quotes for the strong pattern.
s/('*)'''(.*?)'''/$1$2<\/strong>/g;
s/''(.*?)''/$1<\/em>/g;
if ($UseHeadings) {
s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo;
}
if ($TableMode) {
s/((\|\|)+)/"<\/TD>"/ge;
}
}
return $_;
}
sub EmptyCellsToNbsp {
my ($row) = @_;
$row =~ s/(?<=\|\|)\s+(?=\|\|)/ /g;
$row =~ s/^\s+(?=\|\|)/ /;
$row =~ s/(?<=\|\|)\s+$/ /;
return $row;
}
sub WikiLinesToHtml {
my ($pageText) = @_;
my ($pageHtml, @htmlStack, $code, $codeAttributes, $depth, $oldCode);
@htmlStack = ();
$depth = 0;
$pageHtml = "";
foreach (split(/\n/, $pageText)) { # Process lines one-at-a-time
$code = '';
$codeAttributes = '';
$TableMode = 0;
$_ .= "\n";
if (s/^(\;+)([^:]+\:?)\:/ " . EmptyCellsToNbsp($3) . "<\/TD><\/TR>\n"/e) {
$code = 'TABLE';
$codeAttributes = "BORDER='1'";
$TableMode = 1;
$depth = 1;
} elsif (/^[ \t].*\S/) {
$code = "PRE";
$depth = 1;
} else {
$depth = 0;
}
while (@htmlStack > $depth) { # Close tags as needed
$pageHtml .= "\n";
}
if ($depth > 0) {
$depth = $IndentLimit if ($depth > $IndentLimit);
if (@htmlStack) { # Non-empty stack
$oldCode = pop(@htmlStack);
if ($oldCode ne $code) {
$pageHtml .= "<$code>\n";
}
push(@htmlStack, $code);
}
while (@htmlStack < $depth) {
push(@htmlStack, $code);
$pageHtml .= "<$code $codeAttributes>\n";
}
}
if (!$ParseParas) {
s/^\s*$/
' . T('Local rule error:') . '
'
. &QuoteHtml($errorText);
}
}
}
return $text;
}
sub UriEscape {
my ($uri) = @_;
$uri =~ s/([^\w\-.!~*'()\/\&=#])/sprintf("%%%02X", ord($1))/ge;
$uri =~ s/\&/\&/g;
return $uri;
}
sub ParseParagraph {
my ($text) = @_;
$text = &CommonMarkup($text, 1, 0); # Multi-line markup
$text = &WikiLinesToHtml($text); # Line-oriented markup
return "";
} else {
$text = "[$text]";
}
return &StoreRaw("$text");
}
sub GetBracketUrlIndex {
my ($id) = @_;
my ($index, $key);
# Consider plain array?
if ($SaveNumUrl{$id} > 0) {
return $SaveNumUrl{$id};
}
$SaveNumUrlIndex++; # Start with 1
$SaveNumUrl{$id} = $SaveNumUrlIndex;
return $SaveNumUrlIndex;
}
sub GetSiteUrl {
my ($site) = @_;
my ($data, $status);
if (!$InterSiteInit) {
($status, $data) = &ReadFile($InterFile);
if ($status) {
%InterSite = split(/\s+/, $data); # Consider defensive code
}
# Check for definitions to allow file to override automatic settings
if (!defined($InterSite{'LocalWiki'})) {
$InterSite{'LocalWiki'} = $ScriptName . &ScriptLinkChar();
}
if (!defined($InterSite{'Local'})) {
$InterSite{'Local'} = $ScriptName . &ScriptLinkChar();
}
$InterSiteInit = 1; # Init only once per request
}
return $InterSite{$site} if (defined($InterSite{$site}));
return '';
}
sub StoreRaw {
my ($html) = @_;
$SaveUrl{$SaveUrlIndex} = $html;
return $FS . $SaveUrlIndex++ . $FS;
}
sub StorePre {
my ($html, $tag) = @_;
return &StoreRaw("<$tag>" . $html . "");
}
sub StoreHref {
my ($anchor, $text) = @_;
return "
";
}
return "$name";
}
sub ImageAllowed {
my ($url) = @_;
my ($site, $imagePrefixes);
$imagePrefixes = 'http:|https:|ftp:';
$imagePrefixes .= '|file:' if (!$LimitFileUrl);
return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/i);
return 0 if ($url =~ /"/); # No HTML-breaking quotes allowed
return 1 if (@ImageSites < 1); # Most common case: () means all allowed
return 0 if ($ImageSites[0] eq 'none'); # Special case: none allowed
foreach $site (@ImageSites) {
return 1 if ($site eq substr($url, 0, length($site))); # Match prefix
}
return 0;
}
sub StoreBracketUrl {
my ($url, $text, $useImage) = @_;
if ($text eq "") {
$text = &GetBracketUrlIndex($url);
} elsif ($text =~ /^$InterLinkPattern$/) {
my @interlink = split(/:/, $text, 2);
$text = &GetSiteUrl($interlink[0]) . $interlink[1];
}
if ($BracketImg && $useImage && &ImageAllowed($text)) {
$text = "
";
} else {
$text = "[$text]";
}
return &StoreRaw("$text");
}
sub StoreBracketLink {
my ($name, $text) = @_;
return &StoreRaw(&GetPageLinkText($name, "[$text]"));
}
sub StoreBracketAnchoredLink {
my ($name, $anchor, $text) = @_;
return &StoreRaw(&GetPageLinkText("$name#$anchor", "[$text]"));
}
sub StorePageOrEditLink {
my ($page, $name) = @_;
if ($FreeLinks) {
$page =~ s/^\s+//; # Trim extra spaces
$page =~ s/\s+$//;
$page =~ s|\s*/\s*|/|; # ...also before/after subpages
}
$name =~ s/^\s+//;
$name =~ s/\s+$//;
return &StoreRaw(&GetPageOrEditLink($page, $name));
}
sub StoreRFC {
my ($num) = @_;
return &StoreRaw(&RFCLink($num));
}
sub RFCLink {
my ($num) = @_;
return "RFC $num";
}
sub StoreUpload {
my ($url) = @_;
return &StoreRaw(&UploadLink($url));
}
sub UploadLink {
my ($filename) = @_;
my ($html, $url);
return $filename if ($UploadUrl eq ''); # No bad links if misconfigured
$UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
$url = $UploadUrl . $filename;
$html = '';
if (&ImageAllowed($url)) {
$html .= '
';
} else {
$html .= 'upload:' . $filename;
}
$html .= '';
return $html;
}
sub StoreISBN {
my ($num) = @_;
return &StoreRaw(&ISBNLink($num));
}
sub ISBNALink {
my ($num, $pre, $post, $text) = @_;
return '' . $text . '';
}
sub ISBNLink {
my ($rawnum) = @_;
my ($rawprint, $html, $num, $numSites, $i);
$num = $rawnum;
$rawprint = $rawnum;
$rawprint =~ s/ +$//;
$num =~ s/[- ]//g;
$numSites = scalar @IsbnNames; # Number of entries
if ((length($num) != 10) || ($numSites < 1)) {
return "ISBN $rawnum";
}
$html = &ISBNALink($num, $IsbnPre[0], $IsbnPost[0], 'ISBN ' . $rawprint);
if ($numSites > 1) {
$html .= ' (';
$i = 1;
while ($i < $numSites) {
$html .= &ISBNALink($num, $IsbnPre[$i], $IsbnPost[$i], $IsbnNames[$i]);
if ($i < ($numSites - 1)) { # Not the last site
$html .= ', ';
}
$i++;
}
$html .= ')';
}
$html .= " " if ($rawnum =~ / $/); # Add space if old ISBN had space.
return $html;
}
sub SplitUrlPunct {
my ($url) = @_;
my ($punct);
if ($url =~ s/\"\"$//) {
return ($url, ""); # Delete double-quote delimiters here
}
$punct = "";
if ($NewFS) {
($punct) = ($url =~ /([^a-zA-Z0-9\/\x80-\xff]+)$/);
$url =~ s/([^a-zA-Z0-9\/\x80-\xff]+)$//;
} else {
($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/);
$url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//;
}
return ($url, $punct);
}
sub StripUrlPunct {
my ($url) = @_;
my ($junk);
($url, $junk) = &SplitUrlPunct($url);
return $url;
}
sub WikiHeadingNumber {
my ($depth, $text) = @_;
my ($anchor, $number);
return '' unless --$depth > 0; # Don't number H1s because it looks stupid
while (scalar @HeadingNumbers < ($depth-1)) {
push @HeadingNumbers, 1;
$TableOfContents .= '
\n\n";
}
$HeadingNumbers[$#HeadingNumbers]++;
$number = (join '.', @HeadingNumbers) . '. ';
# Remove embedded links. THIS IS FRAGILE!
$text = &RestoreSavedText($text);
$text =~ s/\
" . &DiffToHTML($diffText);
} else {
if (($diffType != 2) &&
((!defined(&GetPageCache("old$cacheName"))) ||
(&GetPageCache("old$cacheName") < 1))) {
$html = ''
. Ts('No diff available--this is the first %s revision.',
$priorName) . "\n$links";
} else {
$html = ''
. Ts('Difference (from prior %s revision)', $priorName)
. "\n$links
" . &DiffToHTML($diffText);
}
}
@HeadingNumbers = ();
$TableOfContents = '';
return $html;
}
sub GetCacheDiff {
my ($type) = @_;
my ($diffText);
$diffText = &GetPageCache("diff_default_$type");
$diffText = &GetCacheDiff('minor') if ($diffText eq "1");
$diffText = &GetCacheDiff('major') if ($diffText eq "2");
return $diffText;
}
# Must be done after minor diff is set and OpenKeptRevisions called
sub GetKeptDiff {
my ($newText, $oldRevision, $lock) = @_;
my (%sect, %data, $oldText);
$oldText = "";
if (defined($KeptRevisions{$oldRevision})) {
%sect = split(/$FS2/, $KeptRevisions{$oldRevision}, -1);
%data = split(/$FS3/, $sect{'data'}, -1);
$oldText = $data{'text'};
}
return "" if ($oldText eq ""); # Old revision not found
return &GetDiff($oldText, $newText, $lock);
}
sub GetDiff {
my ($old, $new, $lock) = @_;
my ($diff_out, $oldName, $newName);
&CreateDir($TempDir);
$oldName = "$TempDir/old_diff";
$newName = "$TempDir/new_diff";
if ($lock) {
&RequestDiffLock() or return "";
$oldName .= "_locked";
$newName .= "_locked";
}
&WriteStringToFile($oldName, $old);
&WriteStringToFile($newName, $new);
$diff_out = `diff $oldName $newName`;
&ReleaseDiffLock() if ($lock);
$diff_out =~ s/\\ No newline.*\n//g; # Get rid of common complaint.
# No need to unlink temp files--next diff will just overwrite.
return $diff_out;
}
sub DiffToHTML {
my ($html) = @_;
my ($tChanged, $tRemoved, $tAdded);
$tChanged = T('Changed:');
$tRemoved = T('Removed:');
$tAdded = T('Added:');
$html =~ s/\n--+//g;
# Note: Need spaces before
to be different from diff section.
$html =~ s/(^|\n)(\d+.*c.*)/$1
$tChanged $2<\/strong>
/g;
$html =~ s/(^|\n)(\d+.*d.*)/$1
$tRemoved $2<\/strong>
/g;
$html =~ s/(^|\n)(\d+.*a.*)/$1
$tAdded $2<\/strong>
/g;
$html =~ s/\n((<.*\n)+)/&ColorDiff($1, $DiffColor1, 0)/ge;
$html =~ s/\n((>.*\n)+)/&ColorDiff($1, $DiffColor2, 1)/ge;
return $html;
}
sub ColorDiff {
my ($diff, $color, $type) = @_;
my ($colorHtml, $classHtml);
$diff =~ s/(^|\n)[<>]/$1/g;
$diff = &QuoteHtml($diff);
# Do some of the Wiki markup rules:
%SaveUrl = ();
%SaveNumUrl = ();
$SaveUrlIndex = 0;
$SaveNumUrlIndex = 0;
$diff = &RemoveFS($diff);
$diff = &CommonMarkup($diff, 0, 1); # No images, all patterns
if ($LateRules ne '') {
$diff = &EvalLocalRules($LateRules, $diff, 1);
}
1 while $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
$diff =~ s/\r?\n/
/g;
$colorHtml = '';
if ($color ne '') {
$colorHtml = " bgcolor=$color";
}
if ($type) {
$classHtml = ' class=wikidiffnew';
} else {
$classHtml = ' class=wikidiffold';
}
return "
\n";
}
# ==== Database (Page, Section, Text, Kept, User) functions ====
sub OpenNewPage {
my ($id) = @_;
%Page = ();
$Page{'version'} = 3; # Data format version
$Page{'revision'} = 0; # Number of edited times
$Page{'tscreate'} = $Now; # Set once at creation
$Page{'ts'} = $Now; # Updated every edit
}
sub OpenNewSection {
my ($name, $data) = @_;
%Section = ();
$Section{'name'} = $name;
$Section{'version'} = 1; # Data format version
$Section{'revision'} = 0; # Number of edited times
$Section{'tscreate'} = $Now; # Set once at creation
$Section{'ts'} = $Now; # Updated every edit
$Section{'ip'} = $ENV{REMOTE_ADDR};
$Section{'host'} = ''; # Updated only for real edits (can be slow)
$Section{'id'} = $UserID;
$Section{'username'} = &GetParam("username", "");
$Section{'data'} = $data;
$Page{$name} = join($FS2, %Section); # Replace with save?
}
sub OpenNewText {
my ($name) = @_; # Name of text (usually "default")
%Text = ();
if ($NewText ne '') {
$Text{'text'} = T($NewText);
} else {
$Text{'text'} = T('Describe the new page here.') . "\n";
}
$Text{'text'} .= "\n" if (substr($Text{'text'}, -1, 1) ne "\n");
$Text{'minor'} = 0; # Default as major edit
$Text{'newauthor'} = 1; # Default as new author
$Text{'summary'} = '';
&OpenNewSection("text_$name", join($FS3, %Text));
}
sub GetPageFile {
my ($id) = @_;
return $PageDir . "/" . &GetPageDirectory($id) . "/$id.db";
}
sub OpenPage {
my ($id) = @_;
my ($fname, $data);
if ($OpenPageName eq $id) {
return;
}
%Section = ();
%Text = ();
$fname = &GetPageFile($id);
if (-f $fname) {
$data = &ReadFileOrDie($fname);
%Page = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
} else {
&OpenNewPage($id);
}
if ($Page{'version'} != 3) {
&UpdatePageVersion();
}
$OpenPageName = $id;
}
sub OpenSection {
my ($name) = @_;
if (!defined($Page{$name})) {
&OpenNewSection($name, "");
} else {
%Section = split(/$FS2/, $Page{$name}, -1);
}
}
sub OpenText {
my ($name) = @_;
if (!defined($Page{"text_$name"})) {
&OpenNewText($name);
} else {
&OpenSection("text_$name");
%Text = split(/$FS3/, $Section{'data'}, -1);
}
}
sub OpenDefaultText {
&OpenText('default');
}
# Called after OpenKeptRevisions
sub OpenKeptRevision {
my ($revision) = @_;
%Section = split(/$FS2/, $KeptRevisions{$revision}, -1);
%Text = split(/$FS3/, $Section{'data'}, -1);
}
sub GetPageCache {
my ($name) = @_;
return $Page{"cache_$name"};
}
# Always call SavePage within a lock.
sub SavePage {
my $file = &GetPageFile($OpenPageName);
$Page{'revision'} += 1; # Number of edited times
$Page{'ts'} = $Now; # Updated every edit
&CreatePageDir($PageDir, $OpenPageName);
&WriteStringToFile($file, join($FS1, %Page));
}
sub SaveSection {
my ($name, $data) = @_;
$Section{'revision'} += 1; # Number of edited times
$Section{'ts'} = $Now; # Updated every edit
$Section{'ip'} = $ENV{REMOTE_ADDR};
$Section{'id'} = $UserID;
$Section{'username'} = &GetParam("username", "");
$Section{'data'} = $data;
$Page{$name} = join($FS2, %Section);
}
sub SaveText {
my ($name) = @_;
&SaveSection("text_$name", join($FS3, %Text));
}
sub SaveDefaultText {
&SaveText('default');
}
sub SetPageCache {
my ($name, $data) = @_;
$Page{"cache_$name"} = $data;
}
sub UpdatePageVersion {
&ReportError(T('Bad page version (or corrupt page).'));
}
sub KeepFileName {
return $KeepDir . "/" . &GetPageDirectory($OpenPageName)
. "/$OpenPageName.kp";
}
sub SaveKeepSection {
my $file = &KeepFileName();
my $data;
return if ($Section{'revision'} < 1); # Don't keep "empty" revision
$Section{'keepts'} = $Now;
$data = $FS1 . join($FS2, %Section);
&CreatePageDir($KeepDir, $OpenPageName);
&AppendStringToFileLimited($file, $data, $KeepSize);
}
sub ExpireKeepFile {
my ($fname, $data, @kplist, %tempSection, $expirets);
my ($anyExpire, $anyKeep, $expire, %keepFlag, $sectName, $sectRev);
my ($oldMajor, $oldAuthor);
$fname = &KeepFileName();
return if (!(-f $fname));
$data = &ReadFileOrDie($fname);
@kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
return if (length(@kplist) < 1); # Also empty
shift(@kplist) if ($kplist[0] eq ""); # First can be empty
return if (length(@kplist) < 1); # Also empty
%tempSection = split(/$FS2/, $kplist[0], -1);
if (!defined($tempSection{'keepts'})) {
return; # Bad keep file
}
$expirets = $Now - ($KeepDays * 24 * 60 * 60);
return if ($tempSection{'keepts'} >= $expirets); # Nothing old enough
$anyExpire = 0;
$anyKeep = 0;
%keepFlag = ();
$oldMajor = &GetPageCache('oldmajor');
$oldAuthor = &GetPageCache('oldauthor');
foreach (reverse @kplist) {
%tempSection = split(/$FS2/, $_, -1);
$sectName = $tempSection{'name'};
$sectRev = $tempSection{'revision'};
$expire = 0;
if ($sectName eq "text_default") {
if (($KeepMajor && ($sectRev == $oldMajor)) ||
($KeepAuthor && ($sectRev == $oldAuthor))) {
$expire = 0;
} elsif ($tempSection{'keepts'} < $expirets) {
$expire = 1;
}
} else {
if ($tempSection{'keepts'} < $expirets) {
$expire = 1;
}
}
if (!$expire) {
$keepFlag{$sectRev . "," . $sectName} = 1;
$anyKeep = 1;
} else {
$anyExpire = 1;
}
}
if (!$anyKeep) { # Empty, so remove file
unlink($fname);
return;
}
return if (!$anyExpire); # No sections expired
open (OUT, ">$fname") or die (Ts('cant write %s', $fname) . ": $!");
foreach (@kplist) {
%tempSection = split(/$FS2/, $_, -1);
$sectName = $tempSection{'name'};
$sectRev = $tempSection{'revision'};
if ($keepFlag{$sectRev . "," . $sectName}) {
print OUT $FS1, $_;
}
}
close(OUT);
}
sub OpenKeptList {
my ($fname, $data);
@KeptList = ();
$fname = &KeepFileName();
return if (!(-f $fname));
$data = &ReadFileOrDie($fname);
@KeptList = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
}
sub OpenKeptRevisions {
my ($name) = @_; # Name of section
my ($fname, $data, %tempSection);
%KeptRevisions = ();
&OpenKeptList();
foreach (@KeptList) {
%tempSection = split(/$FS2/, $_, -1);
next if ($tempSection{'name'} ne $name);
$KeptRevisions{$tempSection{'revision'}} = $_;
}
}
sub LoadUserData {
my ($data, $status);
%UserData = ();
($status, $data) = &ReadFile(&UserDataFilename($UserID));
if (!$status) {
$UserID = 112; # Could not open file. Consider warning message?
return;
}
%UserData = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
}
sub UserDataFilename {
my ($id) = @_;
return "" if ($id < 1);
return $UserDir . "/" . ($id % 10) . "/$id.db";
}
# ==== Misc. functions ====
sub ReportError {
my ($errmsg) = @_;
print $q->header, $q->start_html, "\n" . $diff
. " ", &QuoteHtml($errmsg), "
", $q->end_html;
}
sub ValidId {
my ($id) = @_;
if (length($id) > 120) {
return Ts('Page name is too long: %s', $id);
}
if ($id =~ m| |) {
return Ts('Page name may not contain space characters: %s', $id);
}
if ($UseSubpage) {
if ($id =~ m|.*/.*/|) {
return Ts('Too many / characters in page %s', $id);
}
if ($id =~ /^\//) {
return Ts('Invalid Page %s (subpage without main page)', $id);
}
if ($id =~ /\/$/) {
return Ts('Invalid Page %s (missing subpage name)', $id);
}
}
if ($FreeLinks) {
$id =~ s/ /_/g;
if (!$UseSubpage) {
if ($id =~ /\//) {
return Ts('Invalid Page %s (/ not allowed)', $id);
}
}
if (!($id =~ m|^$FreeLinkPattern$|)) {
return Ts('Invalid Page %s', $id);
}
if ($id =~ m|\.db$|) {
return Ts('Invalid Page %s (must not end with .db)', $id);
}
if ($id =~ m|\.lck$|) {
return Ts('Invalid Page %s (must not end with .lck)', $id);
}
return "";
} else {
if (!($id =~ /^$LinkPattern$/)) {
return Ts('Invalid Page %s', $id);
}
}
return "";
}
sub ValidIdOrDie {
my ($id) = @_;
my $error;
$error = &ValidId($id);
if ($error ne "") {
&ReportError($error);
return 0;
}
return 1;
}
sub UserCanEdit {
my ($id, $deepCheck) = @_;
# Optimized for the "everyone can edit" case (don't check passwords)
if (($id ne "") && (-f &GetLockedPageFile($id))) {
return 1 if (&UserIsAdmin()); # Requires more privledges
# Consider option for editor-level to edit these pages?
return 0;
}
if (!$EditAllowed) {
return 1 if (&UserIsEditor());
return 0;
}
if (-f "$DataDir/noedit") {
return 1 if (&UserIsEditor());
return 0;
}
if ($deepCheck) { # Deeper but slower checks (not every page)
return 1 if (&UserIsEditor());
return 0 if (&UserIsBanned());
}
return 1;
}
sub UserIsBanned {
my ($host, $ip, $data, $status);
($status, $data) = &ReadFile("$DataDir/banlist");
return 0 if (!$status); # No file exists, so no ban
$data =~ s/\r//g;
$ip = $ENV{'REMOTE_ADDR'};
$host = &GetRemoteHost(0);
foreach (split(/\n/, $data)) {
next if ((/^\s*$/) || (/^#/)); # Skip empty, spaces, or comments
return 1 if ($ip =~ /$_/i);
return 1 if ($host =~ /$_/i);
}
return 0;
}
sub UserIsAdmin {
my (@pwlist, $userPassword);
return 0 if ($AdminPass eq "");
$userPassword = &GetParam("adminpw", "");
return 0 if ($userPassword eq "");
foreach (split(/\s+/, $AdminPass)) {
next if ($_ eq "");
return 1 if ($userPassword eq $_);
}
return 0;
}
sub UserIsEditor {
my (@pwlist, $userPassword);
return 1 if (&UserIsAdmin()); # Admin includes editor
return 0 if ($EditPass eq "");
$userPassword = &GetParam("adminpw", ""); # Used for both
return 0 if ($userPassword eq "");
foreach (split(/\s+/, $EditPass)) {
next if ($_ eq "");
return 1 if ($userPassword eq $_);
}
return 0;
}
sub UserCanUpload {
return 1 if (&UserIsEditor());
return $AllUpload;
}
sub GetLockedPageFile {
my ($id) = @_;
return $PageDir . "/" . &GetPageDirectory($id) . "/$id.lck";
}
sub RequestLockDir {
my ($name, $tries, $wait, $errorDie) = @_;
my ($lockName, $n);
&CreateDir($TempDir);
$lockName = $LockDir . $name;
$n = 0;
while (mkdir($lockName, 0555) == 0) {
if ($! != 17) {
die(Ts('can not make %s', $LockDir) . ": $!\n") if $errorDie;
return 0;
}
return 0 if ($n++ >= $tries);
sleep($wait);
}
return 1;
}
sub ReleaseLockDir {
my ($name) = @_;
rmdir($LockDir . $name);
}
sub RequestLock {
# 10 tries, 3 second wait, possibly die on error
return &RequestLockDir("main", 10, 3, $LockCrash);
}
sub ReleaseLock {
&ReleaseLockDir('main');
}
sub ForceReleaseLock {
my ($name) = @_;
my $forced;
# First try to obtain lock (in case of normal edit lock)
# 5 tries, 3 second wait, do not die on error
$forced = !&RequestLockDir($name, 5, 3, 0);
&ReleaseLockDir($name); # Release the lock, even if we didn't get it.
return $forced;
}
sub RequestCacheLock {
# 4 tries, 2 second wait, do not die on error
return &RequestLockDir('cache', 4, 2, 0);
}
sub ReleaseCacheLock {
&ReleaseLockDir('cache');
}
sub RequestDiffLock {
# 4 tries, 2 second wait, do not die on error
return &RequestLockDir('diff', 4, 2, 0);
}
sub ReleaseDiffLock {
&ReleaseLockDir('diff');
}
# Index lock is not very important--just return error if not available
sub RequestIndexLock {
# 1 try, 2 second wait, do not die on error
return &RequestLockDir('index', 1, 2, 0);
}
sub ReleaseIndexLock {
&ReleaseLockDir('index');
}
sub ReadFile {
my ($fileName) = @_;
my ($data);
local $/ = undef; # Read complete files
if (open(IN, "<$fileName")) {
$data=
'
}
if ($isConflict) {
$editRows -= 10 if ($editRows > 19);
print "\n" . T('Edit Conflict!') . "
\n";
if ($isConflict>1) {
# The main purpose of a new warning is to display more text
# and move the save button down from its old location.
print "\n" . T('(This is a new conflict)') . "
\n";
}
print "
\n",
T('Scroll down to see your edited text.'), "
\n";
print T('Last save time:'), ' ', &TimeToText($oldTime),
" (", T('Current time is:'), ' ', &TimeToText($Now), ")
\n";
}
print &GetFormStart();
print &GetHiddenValue("title", $id), "\n",
&GetHiddenValue("oldtime", $pageTime), "\n",
&GetHiddenValue("oldconflict", $isConflict), "\n";
if ($revision ne "") {
print &GetHiddenValue("revision", $revision), "\n";
}
print &GetTextArea('text', $oldText, $editRows, $editCols);
$summary = &GetParam("summary", "*");
print "
", $q->checkbox(-name=>'recent_edit', -checked=>1,
-label=>T('This change is a minor edit.'));
} else {
print "
", $q->checkbox(-name=>'recent_edit',
-label=>T('This change is a minor edit.'));
}
if ($EmailNotify) {
print " " .
$q->checkbox(-name=> 'do_email_notify',
-label=>Ts('Send email notification that %s has been changed.', $id));
}
print "
";
if ($EditNote ne '') {
print T($EditNote) . '
'; # Allow translation
}
print $q->submit(-name=>'Save', -value=>T('Save')), "\n";
$userName = &GetParam("username", "");
if ($userName ne "") {
print ' (', T('Your user name is'), ' ',
&GetPageLink($userName) . ') ';
} else {
print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink(), 1), ') ';
}
print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n";
if ($isConflict) {
print "\n
\n";
print "", T('Preview:'), "
\n";
if ($isConflict) {
print "",
T('NOTE: This preview shows the revision of the other author.'),
"
\n";
}
$MainPage = $id;
$MainPage =~ s|/.*||; # Only the main page name (remove subpage)
print &WikiToHTML($oldText) . "
\n";
print "", T('Preview only, not yet saved'), "
\n";
print '
' . Ts('Your User ID number: %s', $UserID) . "\n";
print '
' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50);
print ' ' . T('(blank to remove, or valid page name)');
print '
' . T('Set Password:') . ' ',
$q->password_field(-name=>'p_password', -value=>'*',
-size=>15, -maxlength=>50),
' ', T('(blank to remove password)'), '
(',
T('Passwords allow sharing preferences between multiple systems.'),
' ', T('Passwords are completely optional.'), ')';
if (($AdminPass ne '') || ($EditPass ne '')) {
print '
', T('Administrator Password:'), ' ',
$q->password_field(-name=>'p_adminpw', -value=>'*',
-size=>15, -maxlength=>50),
' ', T('(blank to remove password)'), '
',
T('(Administrator passwords are used for special maintenance.)');
}
if ($EmailNotify) {
print "
";
print &GetFormCheck('notify', 1,
T('Include this address in the site email list.')), ' ',
T('(Uncheck the box to remove the address.)');
print '
', T('Email Address:'), ' ',
&GetFormText('email', "", 30, 60);
}
print "
$recentName:\n";
print '
', T('Default days to display:'), ' ',
&GetFormText('rcdays', $RcDefault, 4, 9);
print "
", &GetFormCheck('rcnewtop', $RecentTop,
T('Most recent changes on top'));
print "
", &GetFormCheck('rcall', 0,
T('Show all changes (not just most recent)'));
%labels = (0=>T('Hide minor edits'), 1=>T('Show minor edits'),
2=>T('Show only minor edits'));
print '
', T('Minor edit display:'), ' ';
print $q->popup_menu(-name=>'p_rcshowedit',
-values=>[0,1,2], -labels=>\%labels,
-default=>&GetParam("rcshowedit", $ShowEdits));
print "
", &GetFormCheck('rcchangehist', 1,
T('Use "changes" as link to history'));
if ($UseDiff) {
print '
', T('Differences:'), "\n";
print "
", &GetFormCheck('diffrclink', 1,
Ts('Show (diff) links on %s', $recentName));
print "
", &GetFormCheck('alldiff', 0,
T('Show differences on all pages'));
print " (", &GetFormCheck('norcdiff', 1,
Ts('No differences on %s', $recentName)), ")";
%labels = (1=>T('Major'), 2=>T('Minor'), 3=>T('Author'));
print '
', T('Default difference type:'), ' ';
print $q->popup_menu(-name=>'p_defaultdiff',
-values=>[1,2,3], -labels=>\%labels,
-default=>&GetParam("defaultdiff", 1));
}
print '
', T('Misc:'), "\n";
# Note: TZ offset is added by TimeToText, so pre-subtract to cancel.
print '
', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset);
print '
', T('Time Zone offset (hours):'), ' ',
&GetFormText('tzoffset', 0, 4, 9);
print '
', &GetFormCheck('editwide', 1,
T('Use 100% wide edit area (if supported)'));
print '
',
T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4),
' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4);
print '
', &GetFormCheck('toplinkbar', 1,
T('Show link bar on top'));
print '
', &GetFormCheck('linkrandom', 0,
T('Add "Random Page" link to link bar'));
print '
' . T('StyleSheet URL:') . ' ',
&GetFormText('stylesheet', "", 30, 150);
print '
', $q->submit(-name=>'Save', -value=>T('Save')), "\n";
print $q->end_form;
print '
',
T('(Preferences require cookies, but no cookie was sent.)');
}
print &GetCommonFooter();
return;
}
$username = &GetParam("p_username", "");
if ($FreeLinks) {
$username =~ s/^\[\[(.+)\]\]/$1/; # Remove [[ and ]] if added
$username = &FreeToNormal($username);
$username =~ s/_/ /g;
}
if ($username eq "") {
print T('UserName removed.'), '
';
undef $UserData{'username'};
} elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) {
print Ts('Invalid UserName %s: not saved.', $username), "
\n";
} elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) {
print Ts('Invalid UserName %s: not saved.', $username), "
\n";
} elsif (length($username) > 50) { # Too long
print T('UserName must be 50 characters or less. (not saved)'), "
\n";
} else {
print Ts('UserName %s saved.', $username), '
';
$UserData{'username'} = $username;
}
$password = &GetParam("p_password", "");
if ($password eq "") {
print T('Password removed.'), '
';
undef $UserData{'password'};
} elsif ($password ne "*") {
print T('Password changed.'), '
';
$UserData{'password'} = $password;
}
if (($AdminPass ne "") || ($EditPass ne "")) {
$password = &GetParam("p_adminpw", "");
if ($password eq "") {
print T('Administrator password removed.'), '
';
undef $UserData{'adminpw'};
} elsif ($password ne "*") {
print T('Administrator password changed.'), '
';
$UserData{'adminpw'} = $password;
if (&UserIsAdmin()) {
print T('User has administrative abilities.'), '
';
} elsif (&UserIsEditor()) {
print T('User has editor abilities.'), '
';
} else {
print T('User does not have administrative abilities.'), ' ',
T('(Password does not match administrative password(s).)'),
'
';
}
}
}
if ($EmailNotify) {
&UpdatePrefCheckbox("notify");
&UpdateEmailList();
}
&UpdatePrefNumber("rcdays", 0, 0, 999999);
&UpdatePrefCheckbox("rcnewtop");
&UpdatePrefCheckbox("rcall");
&UpdatePrefCheckbox("rcchangehist");
&UpdatePrefCheckbox("editwide");
if ($UseDiff) {
&UpdatePrefCheckbox("norcdiff");
&UpdatePrefCheckbox("diffrclink");
&UpdatePrefCheckbox("alldiff");
&UpdatePrefNumber("defaultdiff", 1, 1, 3);
}
&UpdatePrefNumber("rcshowedit", 1, 0, 2);
&UpdatePrefNumber("tzoffset", 0, -999, 999);
&UpdatePrefNumber("editrows", 1, 1, 999);
&UpdatePrefNumber("editcols", 1, 1, 999);
print T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset), '
';
$TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60);
print T('Local time:'), ' ', &TimeToText($Now), '
';
$stylesheet = &GetParam('p_stylesheet', '');
if ($stylesheet eq '') {
if (&GetParam('stylesheet', '') ne '') {
print T('StyleSheet URL removed.'), '
';
}
undef $UserData{'stylesheet'};
} else {
$stylesheet =~ s/[">]//g; # Remove characters that would cause problems
$UserData{'stylesheet'} = $stylesheet;
print T('StyleSheet setting saved.'), '
';
}
&SaveUserData();
print '', T('Preferences saved.'), '';
print &GetCommonFooter();
}
# add or remove email address from preferences to $EmailFile
sub UpdateEmailList {
my (@old_emails);
local $/ = "\n"; # don't slurp whole files in this sub.
if (my $new_email = $UserData{'email'} = &GetParam("p_email", "")) {
my $notify = $UserData{'notify'};
if (-f $EmailFile) {
open(NOTIFY, $EmailFile)
or die(Ts('Could not read from %s:', $EmailFile) . " $!\n");
@old_emails =
', T('User ID number:'), ' ',
$q->textfield(-name=>'p_userid', -value=>'',
-size=>15, -maxlength=>50);
print '
', T('Password:'), ' ',
$q->password_field(-name=>'p_password', -value=>'',
-size=>15, -maxlength=>50);
print '
', $q->submit(-name=>'Login', -value=>T('Login')), "\n";
print $q->end_form;
if (!&GetParam('embed', $EmbedWiki)) {
print '';
}
print &GetMinimumFooter();
}
sub DoLogin {
my ($uid, $password, $success);
$success = 0;
$uid = &GetParam("p_userid", "");
$uid =~ s/\D//g;
$password = &GetParam("p_password", "");
if (($uid > 199) && ($password ne "") && ($password ne "*")) {
$UserID = $uid;
&LoadUserData();
if ($UserID > 199) {
if (defined($UserData{'password'}) &&
($UserData{'password'} eq $password)) {
$SetCookie{'id'} = $uid;
$SetCookie{'randkey'} = $UserData{'randkey'};
$SetCookie{'rev'} = 1;
$success = 1;
}
}
}
print &GetHeader('', T('Login Results'), '');
if ($success) {
print Ts('Login for user ID %s complete.', $uid);
} else {
print Ts('Login for user ID %s failed.', $uid);
}
if (!&GetParam('embed', $EmbedWiki)) {
print '';
}
print &GetMinimumFooter();
}
sub GetNewUserId {
my ($id);
$id = $StartUID;
while (-f &UserDataFilename($id+1000)) {
$id += 1000;
}
while (-f &UserDataFilename($id+100)) {
$id += 100;
}
while (-f &UserDataFilename($id+10)) {
$id += 10;
}
&RequestLock() or die(T('Could not get user-ID lock'));
while (-f &UserDataFilename($id)) {
$id++;
}
&WriteStringToFile(&UserDataFilename($id), "lock"); # reserve the ID
&ReleaseLock();
return $id;
}
# Consider user-level lock?
sub SaveUserData {
my ($userFile, $data);
&CreateUserDir();
$userFile = &UserDataFilename($UserID);
$data = join($FS1, %UserData);
&WriteStringToFile($userFile, $data);
}
sub CreateUserDir {
my ($n, $subdir);
if (!(-d "$UserDir/0")) {
&CreateDir($UserDir);
foreach $n (0..9) {
$subdir = "$UserDir/$n";
&CreateDir($subdir);
}
}
}
sub DoSearch {
my ($string) = @_;
if ($string eq '') {
&DoIndex();
return;
}
print &GetHeader('', &QuoteHtml(Ts('Search for: %s', $string)), '');
&PrintPageList(&SearchTitleAndBody($string));
print &GetCommonFooter();
}
sub DoBackLinks {
my ($string) = @_;
print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), '');
# At this time the backlinks are mostly a renamed search.
# An initial attempt to match links only failed on subpages and free links.
# Escape some possibly problematic characters:
$string =~ s/([-'().,])/\\$1/g;
&PrintPageList(&SearchTitleAndBody($string));
print &GetCommonFooter();
}
sub PrintPageList {
my $pagename;
print "", Ts('%s pages found:', ($#_ + 1)), "
\n";
foreach $pagename (@_) {
print ".... " if ($pagename =~ m|/|);
print &GetPageLink($pagename), "
\n";
}
}
sub DoLinks {
print &GetHeader('', &QuoteHtml(T('Full Link List')), '');
print "\n\n\n\n\n"; # Extra lines to get below the logo
&PrintLinkList(&GetFullLinkList());
print "
\n";
print &GetCommonFooter();
}
sub PrintLinkList {
my ($pagelines, $page, $names, $editlink);
my ($link, $extra, @links, %pgExists);
%pgExists = ();
foreach $page (&AllPagesList()) {
$pgExists{$page} = 1;
}
$names = &GetParam("names", 1);
$editlink = &GetParam("editlink", 0);
foreach $pagelines (@_) {
@links = ();
foreach $page (split(' ', $pagelines)) {
if ($page =~ /\:/) { # URL or InterWiki form
if ($page =~ /$UrlPattern/) {
($link, $extra) = &UrlLink($page, 0); # No images
} else {
($link, $extra) = &InterPageLink($page, 0); # No images
}
} else {
if ($pgExists{$page}) {
$link = &GetPageLink($page);
} else {
$link = $page;
if ($editlink) {
$link .= &GetEditLink($page, "?");
}
}
}
push(@links, $link);
}
if (!$names) {
shift(@links);
}
print join(' ', @links), "\n";
}
}
sub GetFullLinkList {
my ($name, $unique, $sort, $exists, $empty, $link, $search);
my ($pagelink, $interlink, $urllink);
my (@found, @links, @newlinks, @pglist, %pgExists, %seen, $main);
$unique = &GetParam("unique", 1);
$sort = &GetParam("sort", 1);
$pagelink = &GetParam("page", 1);
$interlink = &GetParam("inter", 0);
$urllink = &GetParam("url", 0);
$exists = &GetParam("exists", 2);
$empty = &GetParam("empty", 0);
$search = &GetParam("search", "");
if (($interlink == 2) || ($urllink == 2)) {
$pagelink = 0;
}
%pgExists = ();
@pglist = &AllPagesList();
foreach $name (@pglist) {
$pgExists{$name} = 1;
}
%seen = ();
foreach $name (@pglist) {
@newlinks = ();
if ($unique != 2) {
%seen = ();
}
@links = &GetPageLinks($name, $pagelink, $interlink, $urllink);
if ($UseSubpage) {
$main = $name;
$main =~ s/\/.*//;
}
foreach $link (@links) {
if ($UseSubpage && ($link =~ /^\//)) {
$link = $main . $link;
}
$seen{$link}++;
if (($unique > 0) && ($seen{$link} != 1)) {
next;
}
if (($exists == 0) && ($pgExists{$link} == 1)) {
next;
}
if (($exists == 1) && ($pgExists{$link} != 1)) {
next;
}
if (($search ne "") && !($link =~ /$search/)) {
next;
}
push(@newlinks, $link);
}
@links = @newlinks;
if ($sort) {
@links = sort(@links);
}
unshift (@links, $name);
if ($empty || ($#links > 0)) { # If only one item, list is empty.
push(@found, join(' ', @links));
}
}
return @found;
}
sub GetPageLinks {
my ($name, $pagelink, $interlink, $urllink) = @_;
my ($text, @links);
@links = ();
&OpenPage($name);
&OpenDefaultText();
$text = $Text{'text'};
$text =~ s/((.|\n)*?)<\/html>/ /ig;
$text =~ s/(.|\n)*?\<\/pre>/ /ig;
$text =~ s/
(.|\n)*?\<\/code>/ /ig;
if ($interlink) {
$text =~ s/''+/ /g; # Quotes can adjacent to inter-site links
$text =~ s/$InterLinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
} else {
$text =~ s/$InterLinkPattern/ /g;
}
if ($urllink) {
$text =~ s/''+/ /g; # Quotes can adjacent to URLs
$text =~ s/$UrlPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
} else {
$text =~ s/$UrlPattern/ /g;
}
if ($pagelink) {
if ($FreeLinks) {
my $fl = $FreeLinkPattern;
$text =~ s/\[\[$fl\|[^\]]+\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
$text =~ s/\[\[$fl\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
}
if ($WikiLinks) {
$text =~ s/$LinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
}
}
return @links;
}
sub DoPost {
my ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
my $string = &GetParam("text", undef);
my $id = &GetParam("title", "");
my $summary = &GetParam("summary", "");
my $oldtime = &GetParam("oldtime", "");
my $oldconflict = &GetParam("oldconflict", "");
my $isEdit = 0;
my $editTime = $Now;
my $authorAddr = $ENV{REMOTE_ADDR};
if ($FreeLinks) {
$id = &FreeToNormal($id);
}
if (!&UserCanEdit($id, 1)) {
# This is an internal interface--we don't need to explain
&ReportError(Ts('Editing not allowed for %s.', $id));
return;
}
if (($id eq 'SampleUndefinedPage') ||
($id eq T('SampleUndefinedPage')) ||
($id eq 'Sample_Undefined_Page') ||
($id eq T('Sample_Undefined_Page'))) {
&ReportError(Ts('%s cannot be defined.', $id));
return;
}
$string = &RemoveFS($string);
$summary = &RemoveFS($summary);
$summary =~ s/[\r\n]//g;
if (length($summary) > 300) { # Too long (longer than form allows)
$summary = substr($summary, 0, 300);
}
# Add a newline to the end of the string (if it doesn't have one)
$string .= "\n" if (!($string =~ /\n$/));
# Lock before getting old page to prevent races
# Consider extracting lock section into sub, and eval-wrap it?
# (A few called routines can die, leaving locks.)
if ($LockCrash) {
&RequestLock() or die(T('Could not get editing lock'));
} else {
if (!&RequestLock()) {
&ForceReleaseLock('main');
}
# Clear all other locks.
&ForceReleaseLock('cache');
&ForceReleaseLock('diff');
&ForceReleaseLock('index');
}
&OpenPage($id);
&OpenDefaultText();
$old = $Text{'text'};
$oldrev = $Section{'revision'};
$pgtime = $Section{'ts'};
$preview = 0;
$preview = 1 if (&GetParam("Preview", "") ne "");
if (!$preview && ($old eq $string)) { # No changes (ok for preview)
&ReleaseLock();
&ReBrowsePage($id, "", 1);
return;
}
if (($UserID > 399) || ($Section{'id'} > 399)) {
$newAuthor = ($UserID ne $Section{'id'}); # known user(s)
} else {
$newAuthor = ($Section{'ip'} ne $authorAddr); # hostname fallback
}
$newAuthor = 1 if ($oldrev == 0); # New page
$newAuthor = 0 if (!$newAuthor); # Standard flag form, not empty
# Detect editing conflicts and resubmit edit
if (($oldrev > 0) && ($newAuthor && ($oldtime != $pgtime))) {
&ReleaseLock();
if ($oldconflict > 0) { # Conflict again...
&DoEdit($id, 2, $pgtime, $string, $preview);
} else {
&DoEdit($id, 1, $pgtime, $string, $preview);
}
return;
}
if ($preview) {
&ReleaseLock();
&DoEdit($id, 0, $pgtime, $string, 1);
return;
}
$user = &GetParam("username", "");
# If the person doing editing chooses, send out email notification
if ($EmailNotify) {
&EmailNotify($id, $user) if &GetParam("do_email_notify", "") eq 'on';
}
if (&GetParam("recent_edit", "") eq 'on') {
$isEdit = 1;
}
if (!$isEdit) {
&SetPageCache('oldmajor', $Section{'revision'});
}
if ($newAuthor) {
&SetPageCache('oldauthor', $Section{'revision'});
}
&SaveKeepSection();
&ExpireKeepFile();
if ($UseDiff) {
&UpdateDiffs($id, $editTime, $old, $string, $isEdit, $newAuthor);
}
$Text{'text'} = $string;
$Text{'minor'} = $isEdit;
$Text{'newauthor'} = $newAuthor;
$Text{'summary'} = $summary;
$Section{'host'} = &GetRemoteHost(1);
&SaveDefaultText();
&SavePage();
&WriteRcLog($id, $summary, $isEdit, $editTime, $Section{'revision'},
$user, $Section{'host'});
if ($UseCache) {
&UnlinkHtmlCache($id); # Old cached copy is invalid
if ($Page{'revision'} < 2) { # If this is a new page...
&NewPageCacheClear($id); # ...uncache pages linked to this one.
}
}
if ($UseIndex && ($Page{'revision'} == 1)) {
unlink($IndexFile); # Regenerate index on next request
}
&ReleaseLock();
&ReBrowsePage($id, "", 1);
}
sub UpdateDiffs {
my ($id, $editTime, $old, $new, $isEdit, $newAuthor) = @_;
my ($editDiff, $oldMajor, $oldAuthor);
$editDiff = &GetDiff($old, $new, 0); # 0 = already in lock
$oldMajor = &GetPageCache('oldmajor');
$oldAuthor = &GetPageCache('oldauthor');
if ($UseDiffLog) {
&WriteDiff($id, $editTime, $editDiff);
}
&SetPageCache('diff_default_minor', $editDiff);
if ($isEdit || !$newAuthor) {
&OpenKeptRevisions('text_default');
}
if (!$isEdit) {
&SetPageCache('diff_default_major', "1");
} else {
&SetPageCache('diff_default_major', &GetKeptDiff($new, $oldMajor, 0));
}
if ($newAuthor) {
&SetPageCache('diff_default_author', "1");
} elsif ($oldMajor == $oldAuthor) {
&SetPageCache('diff_default_author', "2");
} else {
&SetPageCache('diff_default_author', &GetKeptDiff($new, $oldAuthor, 0));
}
}
# Translation note: the email messages are still sent in English
# Send an email message.
sub SendEmail {
my ($to, $from, $reply, $subject, $message) = @_;
# sendmail options:
# -odq : send mail to queue (i.e. later when convenient)
# -oi : do not wait for "." line to exit
# -t : headers determine recipient.
open (SENDMAIL, "| $SendMail -oi -t ") or die "Can't send email: $!\n";
print SENDMAIL <<"EOF";
From: $from
To: $to
Reply-to: $reply
Subject: $subject\n
$message
EOF
close(SENDMAIL) or warn "sendmail didn't close nicely";
}
## Email folks who want to know a note that a page has been modified. - JimM.
sub EmailNotify {
local $/ = "\n"; # don't slurp whole files in this sub.
if ($EmailNotify) {
my ($id, $user) = @_;
if ($user) {
$user = " by $user";
}
my $address;
return if (!-f $EmailFile); # No notifications yet
open(EMAIL, $EmailFile)
or die "Can't open $EmailFile: $!\n";
$address = join ",", $LockMessage
";
print &GetCommonFooter();
}
# Note: all diff and recent-list operations should be done within locks.
sub WriteRcLog {
my ($id, $summary, $isEdit, $editTime, $revision, $name, $rhost) = @_;
my ($extraTemp, %extra);
%extra = ();
$extra{'id'} = $UserID if ($UserID > 0);
$extra{'name'} = $name if ($name ne "");
$extra{'revision'} = $revision if ($revision ne "");
$extraTemp = join($FS2, %extra);
# The two fields at the end of a line are kind and extension-hash
my $rc_line = join($FS3, $editTime, $id, $summary,
$isEdit, $rhost, "0", $extraTemp);
if (!open(OUT, ">>$RcFile")) {
die(Ts('%s log error:', $RCName) . " $!");
}
print OUT $rc_line . "\n";
close(OUT);
}
sub WriteDiff {
my ($id, $editTime, $diffString) = @_;
open (OUT, ">>$DataDir/diff_log") or die(T('can not write diff_log'));
print OUT "------\n" . $id . "|" . $editTime . "\n";
print OUT $diffString;
close(OUT);
}
# Actions are vetoable if someone edits the page before
# the keep expiry time. For example, page deletion. If
# no one edits the page by the time the keep expiry time
# elapses, then no one has vetoed the last action, and the
# action is accepted.
# See http://www.usemod.com/cgi-bin/mb.pl?PageDeletion
sub ProcessVetos {
my ($expirets);
$expirets = $Now - ($KeepDays * 24 * 60 * 60);
return (0, T('(done)')) unless $Page{'ts'} < $expirets;
if ($DeletedPage && $Text{'text'} =~ /^\s*$DeletedPage\W*?(\n|$)/o) {
&DeletePage($OpenPageName, 1, 1);
return (1, T('(deleted)'));
}
if ($ReplaceFile && $Text{'text'} =~ /^\s*$ReplaceFile\:\s*(\S+)/o) {
my $fname = $1;
# Only replace an allowed, existing file.
if ((grep {$_ eq $fname} @ReplaceableFiles) && -e $fname) {
if ($Text{'text'} =~ /.*.*?\n(.*?)\s*<\/pre>/ims)
{
my $string = $1;
$string =~ s/\r\n/\n/gms;
open (OUT, ">$fname") or return 0;
print OUT $string;
close OUT;
return (0, T('(replaced)'));
}
}
}
return (0, T('(done)'));
}
sub DoMaintain {
my ($name, $fname, $data, $message, $status);
print &GetHeader('', T('Maintenance on all pages'), '');
$fname = "$DataDir/maintain";
if (!&UserIsAdmin()) {
if ((-f $fname) && ((-M $fname) < 0.5)) {
print T('Maintenance not done.'), ' ';
print T('(Maintenance can only be done once every 12 hours.)');
print ' ', T('Remove the "maintain" file or wait.');
print &GetCommonFooter();
return;
}
}
&RequestLock() or die(T('Could not get maintain-lock'));
foreach $name (&AllPagesList()) {
&OpenPage($name);
&OpenDefaultText();
($status, $message) = &ProcessVetos();
&ExpireKeepFile() unless $status;
print ".... " if ($name =~ m|/|);
print &GetPageLink($name);
print " $message
\n";
}
&WriteStringToFile($fname, Ts('Maintenance done at %s', &TimeToText($Now)));
&ReleaseLock();
# Do any rename/deletion commands
# (Must be outside lock because it will grab its own lock)
$fname = "$DataDir/editlinks";
if (-f $fname) {
$data = &ReadFileOrDie($fname);
print '
', T('Processing rename/delete commands:'), "
\n";
&UpdateLinksList($data, 1, 1); # Always update RC and links
unlink("$fname.old");
rename($fname, "$fname.old");
}
if ($MaintTrimRc) {
&RequestLock() or die(T('Could not get lock for RC maintenance'));
$status = &TrimRc(); # Consider error messages?
&ReleaseLock();
}
print &GetCommonFooter();
}
# Must be called within a lock.
# Thanks to Alex Schroeder for original code
sub TrimRc {
my (@rc, @temp, $starttime, $days, $status, $data, $i, $ts);
# Determine the number of days to go back
$days = 0;
foreach (@RcDays) {
$days = $_ if $_ > $days;
}
$starttime = $Now - $days * 24 * 60 * 60;
return 1 if (!-f $RcFile); # No work if no file exists
($status, $data) = &ReadFile($RcFile);
if (!$status) {
print '$!\n" . '
$!\n" . '
';
} else {
print T('RC maintenance not done.') . '
';
}
&ReleaseLock();
print &GetCommonFooter();
}
sub UserIsEditorOrError {
if (!&UserIsEditor()) {
print '
';
} else {
print '
';
}
print &GetCommonFooter();
}
sub DoPageLock {
my ($set, $fname, $id);
$set = &GetParam("set", 1) ? 1 : 0;
if ($set) {
print &GetHeader('', T('Set page edit lock'), '');
} else {
print &GetHeader('', T('Remove page edit lock'), '');
}
# Consider allowing page lock/unlock at editor level?
return if (!&UserIsAdminOrError());
$id = &GetParam("id", "");
if ($id eq "") {
print '
';
} else {
print '
';
}
print &GetCommonFooter();
}
sub DoEditBanned {
my ($banList, $status);
print &GetHeader('', T('Editing Banned list'), '');
return if (!&UserIsAdminOrError());
($status, $banList) = &ReadFile("$DataDir/banlist");
$banList = "" if (!$status);
print &GetFormStart();
print GetHiddenValue("edit_ban", 1), "\n";
print "Banned IP/network/host list:
\n";
print "
",
"# blocks hosts ending with .foocorp.com
",
"\\.foocorp\\.com\$
",
"# blocks exact IP address
",
"^123\\.21\\.3\\.9\$
",
"# blocks whole 123.21.3.* IP network
",
"^123\\.21\\.3\\.\\d+\$
", $q->submit(-name=>'Save'), "\n";
print $q->end_form;
if (!&GetParam('embed', $EmbedWiki)) {
print '
\n";
print "
",
"!PageName -- deletes the page called PageName
\n",
"=OldPageName=NewPageName -- Renames OldPageName ",
"to NewPageName and updates links to OldPageName.
\n",
"|OldPageName|NewPageName -- Changes links to OldPageName ",
"to NewPageName.",
" (Used to rename links to non-existing pages.)
\n",
"Note: page names are case-sensitive!\n";
print &GetTextArea('commandlist', "", 12, 50);
print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1,
-label=>"Edit $RCName");
print "
\n";
print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1,
-label=>"Substitute text for rename");
print "
", $q->submit(-name=>'Edit'), "\n";
print $q->end_form;
if (!&GetParam('embed', $EmbedWiki)) {
print '
\n";
if (/^\!(.+)/) {
&DeletePage($1, $doRC, $doText);
} elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) {
&RenamePage($1, $2, $doRC, $doText);
} elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) {
&RenameTextLinks($1, $2);
}
}
&NewPageCacheClear("."); # Clear cache (needs testing?)
unlink($IndexFile) if ($UseIndex);
&ReleaseLock();
}
sub BuildLinkIndex {
my (@pglist, $page, @links, $link, %seen);
@pglist = &AllPagesList();
%LinkIndex = ();
foreach $page (@pglist) {
&BuildLinkIndexPage($page);
}
}
sub BuildLinkIndexPage {
my ($page) = @_;
my (@links, $link, %seen);
@links = &GetPageLinks($page, 1, 0, 0);
%seen = ();
foreach $link (@links) {
if (defined($LinkIndex{$link})) {
if (!$seen{$link}) {
$LinkIndex{$link} .= " " . $page;
}
} else {
$LinkIndex{$link} .= " " . $page;
}
$seen{$link} = 1;
}
}
sub DoUpdateLinks {
my ($commandList, $doRC, $doText);
print &GetHeader('', T('Updating Links'), '');
if ($AdminDelete) {
return if (!&UserIsAdminOrError());
} else {
return if (!&UserIsEditorOrError());
}
$commandList = &GetParam("commandlist", "");
$doRC = &GetParam("p_changerc", "0");
$doRC = 1 if ($doRC eq "on");
$doText = &GetParam("p_changetext", "0");
$doText = 1 if ($doText eq "on");
if ($commandList eq "") {
print "$!
\n";
print $errorText if ($printError);
return;
}
$outrc = "";
@rclist = split(/\n/, $fileData);
foreach $rcline (@rclist) {
($ts, $page, $junk) = split(/$FS3/, $rcline);
if ($page eq $old) {
if ($action == 1) { # Delete
; # Do nothing (don't add line to new RC)
} elsif ($action == 2) {
$junk = $rcline;
$junk =~ s/^(\d+$FS3)$old($FS3)/"$1$new$2"/ge;
$outrc .= $junk . "\n";
}
} else {
$outrc .= $rcline . "\n";
}
}
&WriteStringToFile($fname . ".old", $fileData); # Backup copy
&WriteStringToFile($fname, $outrc);
}
# Delete and rename must be done inside locks.
sub DeletePage {
my ($page, $doRC, $doText) = @_;
my ($fname, $status);
$page =~ s/ /_/g;
$page =~ s/\[+//;
$page =~ s/\]+//;
$status = &ValidId($page);
if ($status ne "") {
print Tss('Delete-Page: page %1 is invalid, error is: %2', $page, $status)
. "
\n";
return;
}
$fname = &GetPageFile($page);
unlink($fname) if (-f $fname);
$fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
unlink($fname) if (-f $fname);
unlink($IndexFile) if ($UseIndex);
&EditRecentChanges(1, $page, "") if ($doRC); # Delete page
# Currently don't do anything with page text
}
# Given text, returns substituted text
sub SubstituteTextLinks {
my ($old, $new, $text) = @_;
# Much of this is taken from the common markup
%SaveUrl = ();
$SaveUrlIndex = 0;
$text =~ s/$FS(\d)/$1/g; # Remove separators (paranoia)
if ($RawHtml) {
$text =~ s/(((.|\n)*?)<\/html>)/&StoreRaw($1)/ige;
}
$text =~ s/(((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
$text =~ s/(
((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
$text =~ s/(
\n";
return;
}
$status = &ValidId($new);
if ($status ne "") {
print Tss('Rename-Text: new page %1 is invalid, error is: %2', $new, $status)
. "
\n";
return;
}
$old =~ s/_/ /g;
$new =~ s/_/ /g;
# Note: the LinkIndex must be built prior to this routine
return if (!defined($LinkIndex{$oldCanonical}));
@pageList = split(' ', $LinkIndex{$oldCanonical});
foreach $page (@pageList) {
$changed = 0;
&OpenPage($page);
foreach $section (keys %Page) {
if ($section =~ /^text_/) {
&OpenSection($section);
%Text = split(/$FS3/, $Section{'data'}, -1);
$oldText = $Text{'text'};
$newText = &SubstituteTextLinks($old, $new, $oldText);
if ($oldText ne $newText) {
$Text{'text'} = $newText;
$Section{'data'} = join($FS3, %Text);
$Page{$section} = join($FS2, %Section);
$changed = 1;
}
} elsif ($section =~ /^cache_diff/) {
$oldText = $Page{$section};
$newText = &SubstituteTextLinks($old, $new, $oldText);
if ($oldText ne $newText) {
$Page{$section} = $newText;
$changed = 1;
}
}
# Add other text-sections (categories) here
}
if ($changed) {
$file = &GetPageFile($page);
&WriteStringToFile($file, join($FS1, %Page));
}
&RenameKeepText($page, $old, $new);
}
}
sub RenamePage {
my ($old, $new, $doRC, $doText) = @_;
my ($oldfname, $newfname, $oldkeep, $newkeep, $status);
$old =~ s/ /_/g;
$new = &FreeToNormal($new);
$status = &ValidId($old);
if ($status ne "") {
print Tss('Rename: old page %1 is invalid, error is: %2', $old, $status)
. "
\n";
return;
}
$status = &ValidId($new);
if ($status ne "") {
print Tss('Rename: new page %1 is invalid, error is: %2', $new, $status)
. "
\n";
return;
}
$newfname = &GetPageFile($new);
if (-f $newfname) {
print Ts('Rename: new page %s already exists--not renamed.', $new)
. "
\n";
return;
}
$oldfname = &GetPageFile($old);
if (!(-f $oldfname)) {
print Ts('Rename: old page %s does not exist--nothing done.', $old)
. "
\n";
return;
}
&CreatePageDir($PageDir, $new); # It might not exist yet
rename($oldfname, $newfname);
&CreatePageDir($KeepDir, $new);
$oldkeep = $KeepDir . "/" . &GetPageDirectory($old) . "/$old.kp";
$newkeep = $KeepDir . "/" . &GetPageDirectory($new) . "/$new.kp";
unlink($newkeep) if (-f $newkeep); # Clean up if needed.
rename($oldkeep, $newkeep);
unlink($IndexFile) if ($UseIndex);
my $oldlock = &GetLockedPageFile($old);
if (-f $oldlock) {
my $newlock = &GetLockedPageFile($new);
rename($oldlock, $newlock);
}
&EditRecentChanges(2, $old, $new) if ($doRC);
if ($doText) {
&BuildLinkIndexPage($new); # Keep index up-to-date
&RenameTextLinks($old, $new);
}
}
sub DoShowVersion {
print &GetHeader('', T('Displaying Wiki Version'), '');
print "
' . &GetDeleteLink($id, T('Confirm Delete'), 1);
print '
';
print '';
print &GetCommonFooter();
}
sub SaveUpload {
my ($filename, $printFilename, $uploadFilehandle);
print &GetHeader('', T('Upload Finished'), '');
if (!$AllUpload) {
return if (!&UserIsEditorOrError());
}
$UploadDir .= '/' if (substr($UploadDir, -1, 1) ne '/'); # End with /
$UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
$filename = $q->param('file');
$filename =~ s/.*[\/\\](.*)/$1/; # Only name after last \ or /
$uploadFilehandle = $q->upload('file');
open UPLOADFILE, ">$UploadDir$filename";
binmode UPLOADFILE;
while (<$uploadFilehandle>) { print UPLOADFILE; }
close UPLOADFILE;
print T('The wiki link to your file is:') . "\n
";
$printFilename = $filename;
$printFilename =~ s/ /\%20/g; # Replace spaces with escaped spaces
print "upload:" . $printFilename . "
\n";
if ($filename =~ /$ImageExtensions$/i) {
print '' . "\n";
}
print &GetCommonFooter();
}
sub ConvertFsFile {
my ($oldFS, $newFS, $fname) = @_;
my ($oldData, $newData, $status);
return if (!-f $fname); # Convert only existing regular files
($status, $oldData) = &ReadFile($fname);
if (!$status) {
print '
' . Ts('Could not open file %s', $fname)
. ':' . T('Error was') . ":\n$!
\n" . '
';
return;
}
$newData = $oldData;
$newData =~ s/$oldFS(\d)/$newFS . $1/ge;
return if ($oldData eq $newData); # Do not write if the same
&WriteStringToFile($fname, $newData);
# print $fname . '
'; # progress report
}
# Converts up to 3 dirs deep (like page/A/Apple/subpage.db)
# Note that top level directory (page/keep/user) contains only dirs
sub ConvertFsDir {
my ($oldFS, $newFS, $topDir) = @_;
my (@dirs, @files, @subFiles, $dir, $file, $subFile, $fname, $subFname);
opendir(DIRLIST, $topDir);
@dirs = readdir(DIRLIST);
closedir(DIRLIST);
@dirs = sort(@dirs);
foreach $dir (@dirs) {
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
next if (!-d "$topDir/$dir"); # Top level directories only
next if (-f "$topDir/$dir.cvt"); # Skip if already converted
opendir(DIRLIST, "$topDir/$dir");
@files = readdir(DIRLIST);
closedir(DIRLIST);
foreach $file (@files) {
next if (($file eq '.') || ($file eq '..'));
$fname = "$topDir/$dir/$file";
if (-f $fname) {
# print $fname . '
'; # progress
&ConvertFsFile($oldFS, $newFS, $fname);
} elsif (-d $fname) {
opendir(DIRLIST, $fname);
@subFiles = readdir(DIRLIST);
closedir(DIRLIST);
foreach $subFile (@subFiles) {
next if (($subFile eq '.') || ($subFile eq '..'));
$subFname = "$fname/$subFile";
if (-f $subFname) {
# print $subFname . '
'; # progress
&ConvertFsFile($oldFS, $newFS, $subFname);
}
}
}
}
&WriteStringToFile("$topDir/$dir.cvt", 'converted');
}
}
sub ConvertFsCleanup {
my ($topDir) = @_;
my (@dirs, $dir);
opendir(DIRLIST, $topDir);
@dirs = readdir(DIRLIST);
closedir(DIRLIST);
foreach $dir (@dirs) {
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
next if (!-f "$topDir/$dir"); # Remove only files...
next unless ($dir =~ m/\.cvt$/); # ...that end with .cvt
unlink "$topDir/$dir";
}
}
sub DoConvert {
my $oldFS = "\xb3";
my $newFS = "\x1e\xff\xfe\x1e";
print &GetHeader('', T('Convert wiki DB'), '');
return if (!&UserIsAdminOrError());
if ($FS ne $newFS) {
print Ts('You must change the %s option before converting the wiki DB.',
'$NewFS') . '
';
return;
}
&WriteStringToFile("$DataDir/noedit", 'editing locked.');
print T('Wiki DB locked for conversion.') . '
';
print T('Converting Wiki DB...') . '
';
&ConvertFsFile($oldFS, $newFS, "$DataDir/rclog");
&ConvertFsFile($oldFS, $newFS, "$DataDir/rclog.old");
&ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog");
&ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog.old");
&ConvertFsDir($oldFS, $newFS, $PageDir);
&ConvertFsDir($oldFS, $newFS, $KeepDir);
&ConvertFsDir($oldFS, $newFS, $UserDir);
&ConvertFsCleanup($PageDir);
&ConvertFsCleanup($KeepDir);
&ConvertFsCleanup($UserDir);
print T('Finished converting wiki DB.') . '
';
print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit")
. '
';
print &GetCommonFooter();
}
# Remove user-id files if no useful preferences set
sub DoTrimUsers {
my (%Data, $status, $data, $maxID, $id, $removed, $keep);
my (@dirs, @files, $dir, $file, $item);
print &GetHeader('', T('Trim wiki users'), '');
return if (!&UserIsAdminOrError());
$removed = 0;
$maxID = 1001;
opendir(DIRLIST, $UserDir);
@dirs = readdir(DIRLIST);
closedir(DIRLIST);
foreach $dir (@dirs) {
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
next if (!-d "$UserDir/$dir"); # Top level directories only
opendir(DIRLIST, "$UserDir/$dir");
@files = readdir(DIRLIST);
closedir(DIRLIST);
foreach $file (@files) {
if ($file =~ m/(\d+).db/) { # Only numeric ID files
$id = $1;
$maxID = $id if ($id > $maxID);
%Data = ();
($status, $data) = &ReadFile("$UserDir/$dir/$file");
if ($status) {
%Data = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
$keep = 0;
foreach $item (qw(username password adminpw stylesheet)) {
$keep = 1 if (defined($Data{$item}) && ($Data{$item} ne ''));
}
if (!$keep) {
unlink "$UserDir/$dir/$file";
# print "$UserDir/$dir/$file" . '
'; # progress
$removed += 1;
}
}
}
}
}
print Ts('Removed %s files.', $removed) . '
';
print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '
';
print &GetCommonFooter();
}
#END_OF_OTHER_CODE
&DoWikiRequest() if ($RunCGI && ($_ ne 'nocgi')); # Do everything.
1; # In case we are loaded from elsewhere
# == End of UseModWiki script. ===========================================