# -*- mode: cperl -*- use utf8; do '/org/org.emacswiki/htdocs/password.pl'; # $0 is wiki, emacs, emacs-en, emacs-de, etc $ScriptName = "http://www.emacswiki.org/$0"; $FullUrl = "http://www.emacswiki.org/cgi-bin/$0"; $UseGrep = 0; # lock down (alternatively use the $NoEditFile via admin page) $EditAllowed = 1; $ReCaptchaRememberAnswer = 1; $QuestionaskerSecretKey = 'uihnscuskc'; $ReCaptchaSecretKey = $QuestionaskerSecretKey; @QuestionaskerQuestions = (['What is the greatest editor out there?' => sub { shift =~ /^\s*(x?emacs|vim?|pico|nano|ed(lin)?|notepad|(ultra)?edit|text(pad|mate))\s*$/i }], ); # $SurgeProtectionTime = 100; # Size of the protected window in seconds # $SurgeProtectionViews = 10; # How many page views to allow in this window $SummaryHours = 0; $NotFoundHandlerDir = "$DataDir/wiki"; $CommentsPrefix = 'Comments_on_'; $CalendarOnEveryPage = 0; $UploadAllowed = 1; $MaxPost = 1024000; $UseDiff = 1; $MultiUrlLimit = 10; $GitMail = 'anybody@emacswiki.org'; # $ENV{GIT_COMMITTER_NAME} = 'Alex Schroeder'; # $ENV{GIT_COMMITTER_EMAIL} = 'alex@gnu.org'; push(@UploadTypes,'text/css'); push(@UploadTypes,'text/plain'); push(@UploadTypes,'text/xml'); push(@UploadTypes,'text/x-emacs-lisp'); push(@UploadTypes,'image/x-png'); # PNG is usually broken on Windows push(@UploadTypes,'application/tar'); # gzip files push(@UploadTypes,'application/gzip'); # gzip for dds push(@UploadTypes,'application/gzip-compressed'); # gzip for DrewAdams push(@UploadTypes,'application/zip-compressed'); # zip for leooo push(@UploadTypes,'application/x-tar'); # gzip files push(@UploadTypes,'application/x-gzip'); # gzip for dds push(@UploadTypes,'application/x-gzip-compressed'); # gzip for DrewAdams push(@UploadTypes,'application/x-zip-compressed'); # zip for leooo push(@UploadTypes,'image/gif'); # gif for JaariAlto %StaticMimeTypes = ('text/css' => 'css', 'text/plain' => 'txt', 'text/xml' => 'xml', 'text/x-emacs-lisp' => 'el', 'application/x-tar' => 'tar.gz', 'application/x-gzip' => 'gz', 'application/x-gzip-compressed' => 'gz', 'image/png' => 'png', 'image/x-png' => 'png', 'image/jpeg' => 'jpg', 'image/pjpeg' => 'jpg'); $StaticAlways = 1; $StaticDir = '/org/org.emacswiki/htdocs/pics/static'; $StaticUrl = 'http://www.emacswiki.org/pics/static/'; push(@MyInitVariables, sub { if (GetParam('action', 'browse') eq 'static' and GetParam('html', 1) == 1) { # Ordinary static action defaults to html=1 and is used to # create the static tar ball. In this case want to create the # static stuff in a different directory. $StaticDir = '/org/org.emacswiki/htdocs/emacs/static'; } }); $CookieName = "Wiki"; $SiteName = "EmacsWiki"; $HomePage = "SiteMap"; $LogoUrl = "/emacs_logo.png"; $RcDefault = 7; @RcDays = qw(1 3 7 14 21 28); $KeepDays = 21; $SisterSiteLogoUrl = '/pics/%s.png'; $InstanceThrottleLimit = 10; $TocAnchorPrefix = 'toc'; $TocOutlineLibrary = '/outliner.0.5.0.62-toc.js'; $MarkupSingles{'=>'} = '⇒'; # RIGHTWARDS DOUBLE ARROW $MarkupSingles{'==>'} = '⇒'; # RIGHTWARDS DOUBLE ARROW $MarkupSingles{'-->'} = '→'; # RIGHTWARDS ARROW # delete $Smilies{':-?[/\\\]'}; # delete $Smilies{'=-?\)'}; # weird crash! # $Smilies{'=\)'} = 'http://www.emacswiki.org/pics/bigeye-smile.png', # $Smilies{':-?/'} = 'http://www.emacswiki.org/pics/wry.png'; # $Smilies{':-\\'} = 'http://www.emacswiki.org/pics/wry.png'; # Allow + in pagenames: push(@MyInitVariables, sub { $FreeLinkPattern = "([-+,.()' _0-9A-Za-z\x{0080}-\x{fffd}]+)"; }); # Somehow this leads to problems such as links having the URL # http://www.emacswiki.org/cgi-bin/wiki/info+.el/RecentChanges # from the info+.el page. # CGI bug report submitted. For the time being, make sure # to use an older CGI library! $FooterNote = qq{
CC-GNU GPL
}; $RssRights = "This work is licensed to you under version 2 of the GNU General Public License. Alternatively, you may choose to receive this work under any other license that grants the right to use, copy, modify, and distribute the work, as long as that license imposes the restriction that derivative works have to grant the same rights and impose the same restriction. For example, you may choose to receive this work under the GNU Free Documentation License, the CreativeCommons ShareAlike License, the XEmacs manual license, or similar licenses."; $RssLicense = ['http://creativecommons.org/licenses/sa/1.0/', 'http://www.gnu.org/copyleft/fdl.html', 'http://www.gnu.org/copyleft/gpl.html', 'http://www.emacswiki.org/OLD' ]; $EditNote = '

Please make sure you contribute only your own work. IP numbers are made available via the page history. If you want to keep it a secret, you need to use Tor. See TextFormattingRules for how to format text. See StyleGuide for the suggested writing style on this wiki.

'; $HttpCharset = "UTF-8"; @UserGotoBarPages = ($HomePage, 'Search', 'ElispArea', 'HowTo', 'Glossary', $RCName, 'News', 'Problems', 'Suggestions'); # $UserGotoBar = "
Note: We changed the licensing terms on 2004-01-01."; $InterWikiMoniker = "EmacsWiki"; $SiteDescription = "This is the Emacs and XEmacs know-how repository."; $RssImageUrl = "http://www.emacswiki.org/emacs_rss.png"; # may get used if bootstrap config is requested sub NewBootstrapGetCss { return q{ }; } # changes to the bootstrap cookie are retained $CookieParameters{bootstrap} = 1; push(@MyAdminCode, \&BootstrapMenu); sub BootstrapMenu { my ($id, $menuref, $restref) = @_; push(@$menuref, ScriptLink('action=admin;bootstrap=' . (1-GetParam('bootstrap', 1)), T('Toggle theme'), 'bootstrap')); } push(@MyInitVariables, sub { # RSS $HtmlHeaders = qq{ }; my $id = GetId(); my $text = QuoteHtml(NormalToFree($id)); $id = UrlEncode($id); $HtmlHeaders .= qq{ } if $id; my $username = GetParam('username', ''); $text = QuoteHtml(NormalToFree($username)); $username = UrlEncode($username); $HtmlHeaders .= qq{ } if $username; $HtmlHeaders .= $q->meta({-name => "viewport", -content => "width=device-width"}); # setting $HtmlHeaders undid the changes of toc-js.pl! TocScript(); # CSS if (GetParam('bootstrap', 1)) { # changes to the bootstrap configuration need to be reflected # in bin/emacs-elisp-area *GetCss = *NewBootstrapGetCss; $LogoUrl = undef; # separate logo $HtmlHeaders .= q{ }; } else { $StyleSheet = '/css/emacs.css'; $RssStyleSheet = $StyleSheet; } # iPad if ($ENV{HTTP_USER_AGENT} =~ /iPad/) { $HtmlHeaders .= $q->style({-type=>'text/css'}, q(textarea, input { font-size: large })); } # Google Analytics # $HtmlHeaders .= q% # # %; }); # *MyOldGetHtmlHeader = *GetHtmlHeader; # *GetHtmlHeader = *MyNewGetHtmlHeader; # sub MyNewGetHtmlHeader { # my $result = MyOldGetHtmlHeader(@_); # $result =~ s!$SiteName: (.*?)!$1!o; # return $result; # } # changes to the duckduckgo parameter are stored in the cookie # $CookieParameters{duckduckgo} = 0; # push(@MyAdminCode, \&DuckDuckGoMenu); # sub DuckDuckGoMenu { # my ($id, $menuref, $restref) = @_; # push(@$menuref, ScriptLink('action=admin;duckduckgo=' # . (1-GetParam('duckduckgo', 1)), # T('Toggle DuckDuckGo'), 'duckduckgo')); # } # *OldDuckDuckGoGetHeader = *GetHeader; # *GetHeader = *NewDuckDuckGoGetHeader; # sub NewDuckDuckGoGetHeader { # my $html = OldDuckDuckGoGetHeader(@_); # if (GetParam('duckduckgo', '') eq '1') { # my $form = q { # #

# # #

# # # }; # $html =~ s{}{$form}; # } # return $html; # } $Action{new} = \&NewEntry; sub NewEntry { my $id = shift; my $time = time() - 4 * 3600; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($time); $today = sprintf("%d-%02d-%02d", $year + 1900, $mon + 1, $mday); $today .= " " . $id if $id; return DoEdit($today); } push(@MyAdminCode, \&PrintableIndexMenu); sub PrintableIndexMenu { my ($id, $menuref, $restref) = @_; push(@$menuref, ScriptLink('action=printable-index', T('Nice index of all pages'))); } # update http://www.emacswiki.org/cgi-bin/wiki.pl?LanguageIdentification # watch out: non-ascii characters are more than one byte, so in perl [ж] may # match other combinations of these two bytes. %Languages = ( 'en' => ' (the|that|and|why|what) ', 'de' => ' (der|das|und|oder) ', 'fr' => ' (et|une|les|est|je|avec|même) ', 'it' => ' (gli|che|perchè|così) ', 'es' => '(¡|¿|ñ|ción)', 'ru' => '\b(и|или|это|тот|для|как)\b', 'zh' => '(的|一|是|不|了)', # (是|但|這|这|你|了|啊|沒) 'pt' => '(ã|õ)', 'se' => ' (är|från|för) ', 'ja' => '(ま|す|ん|し|ょ|う|の|は)', 'ko' => '(이)'); foreach (keys %Languages) { $TranslationLinkTarget{$_} = "http://www.emacswiki.org/emacs-$_/"; } $Translate{en} = 'English'; $Translate{de} = 'Deutsch'; $Translate{fr} = 'Français'; $Translate{it} = 'Italiano'; $Translate{es} = 'Español'; $Translate{ru} = 'Русский'; $Translate{zh} = '中文'; $Translate{pt} = 'Português'; $Translate{se} = 'Svenska'; $Translate{ja} = '日本語'; $Translate{ko} = '한국어'; # push(@MyMacros, sub{s|\[\[(\S*\.el)\]\]|Lisp:$1|g}); push(@MyMacros, sub{ my $revision = $Page{revision}+1; s|\%Id:(\s*[0-9.]+)?\s*\%|\%Id: $revision\%|g; }); sub elisp_formatting { $_ = shift; # HTML encoded my $symbol = "[-+=*/~!@$%^:<>{}?[:alpha:]]+"; # FIXME: & is not handled # strings (get confused by html elements with attributes, thus this must be first) s!(?:^|(?<=[^\\]))("(?:.*?\n)*?.*?(?<=[^\\])")!$1!g; # named entities confusing comment code (must be translated back in the end) s!&([lg]t|amp);!&$1$FS!g; # comments s!(?:^|(?<=[^\\]))(;.*)!$1!g; # undo escaping of named entities s!&([lg]t|amp)$FS!&$1;!g; # function declarations s!\((def((advice|alias|generic|macro\*?|method|setf|subst\*?|un\*?|ine-(condition|(?:derived|(?:global(?:ized)?-)?minor|generic)-mode|method-combination|setf-expander|skeleton|widget|function|(compiler|modify|symbol)-macro))))([ \t'(]*)(setf[ \t]+$symbol|$symbol)?!($1$6$7!g; # variable declarations s!\((def(const(ant)?|custom|varalias|face|parameter|var))([ \t'(]*)(setf[ \t]+$symbol|$symbol)?!($1$4$5!g; # structure declarations s!\((def(class|group|theme|package|struct|type))([ \t'(]*)(setf[ \t]+$symbol|$symbol)?!($1$3$4!g; # Emacs Lisp autoload cookies. Supports the slightly different forms # used by mh-e, calendar, etc. Already processed as a comment! s!^;;;###([-a-z]*autoload)!;;;###$1!gm; # ;; Regexp negated char group. s!\[\^![^!g; # Control structures. Emacs Lisp forms. s!\((cond|if|while|while-no-input|let|let*|letrec|pcase|pcase-let|pcase-let*|prog|progn|progv|prog1|prog2|prog*|inline|lambda|save-restriction|save-excursion|save-selected-window|save-window-excursion|save-match-data|save-current-buffer|combine-after-change-calls|unwind-protect|condition-case|condition-case-unless-debug|track-mouse|eval-after-load|eval-and-compile|eval-when-compile|eval-when|eval-next-after-load|with-case-table|with-category-table|with-current-buffer|with-demoted-errors|with-electric-help|with-local-quit|with-no-warnings|with-output-to-string|with-output-to-temp-buffer|with-selected-window|with-selected-frame|with-silent-modifications|with-syntax-table|with-temp-buffer|with-temp-file|with-temp-message|with-timeout|with-timeout-handler|with-wrapper-hook)\b!($1!g; # Control structures. Common Lisp forms. s!\((when|unless|case|ecase|typecase|etypecase|ccase|ctypecase|handler-case|handler-bind|restart-bind|restart-case|in-package|break|ignore-errors|loop|do|do*|dotimes|dolist|the|locally|proclaim|declaim|declare|symbol-macrolet|letf|lexical-let|lexical-let*|flet|labels|compiler-let|destructuring-bind|macrolet|tagbody|block|go|multiple-value-bind|multiple-value-prog1|return|return-from|with-accessors|with-compilation-unit|with-condition-restarts|with-hash-table-iterator|with-input-from-string|with-open-file|with-open-stream|with-output-to-string|with-package-iterator|with-simple-restart|with-slots|with-standard-io-syntax)\b!($1!g; # Exit/Feature symbols as constants. s!\((catch|throw|featurep|provide|require)\b([ \t']*)($symbol)?!($1$2$3!g; # Erroneous structures. s!\((abort|assert|warn|check-type|cerror|error|signal)\b!($1!gm; # Words inside \\[] tend to be for `substitute-command-keys'. s!\\\\\[($symbol)\]!\\\\[$1]!g; # Words inside `' tend to be symbol names. s!`($symbol)'!`$1'!g; # Constant values. s!(:$symbol)!$1!g; # ELisp and CLisp `&' keywords as types. s!(&$symbol)!$1!g; return "
$_
"; } sub MyRules { # source code on pages start with a comment on the first line if (pos == 0 and m/\G;;;/gc) { my $result = elisp_formatting($_); pos = length($_); my $link; my $revision = GetParam('revision', ''); my $page = UrlEncode($OpenPageName); if ($revision) { # hack alert: I want the URL to end in $page such that saving # the old revision results in a reasonable name suggestion by # the browser $link = "$ScriptName/download/$page?revision=$revision"; } else { $link = ScriptUrl("download/$page"); } return CloseHtmlEnvironments() . $q->p({-class=>"download"}, $q->a({-href=>$link}, T("Download"))) . $result; } elsif (pos == 0 and m%\G#! ?/usr/bin/perl%gc) { my $pos = length($_); # fake matching entire file my $source = $_; require Beautifier::Core; require HFile::HFile_perl; require Output::CSS; my $Hfile = new HFile::HFile_perl; my $highlighter = new Beautifier::Core($Hfile, new Output::CSS); my $result = $highlighter->highlight_text(UnquoteHtml($source)); pos = $pos; return $q->p(ScriptLink("download/$OpenPageName", T("Download"))) . $result; } elsif (pos == 0 and m!\G(\#|/\*)!gc) { # for any sort of raw page my $pos = length($_); # fake matching entire file pos = $pos; return $q->p(ScriptLink("download/$OpenPageName", T("Download"))) . $q->pre($_); } elsif ( /\G`##([\/*a-z0-9 -]+)##'/cgi or /\G`([\/*a-z0-9 -]+)\'/cgi or /\G‘([\/*a-z0-9 -]+)’/cgi) { # Emacs `syntax' or copy & paste ‘syntax’ return $q->code('‘' . $1 . '’'); } elsif ($bol && m/\G(\<include\s+list\s+"(.*?)"\>[ \t]*\n?)/cgi) { my ($oldpos, $old_) = (pos, $_); Clean(CloseHtmlEnvironments()); Dirty($1); my $re = UnquoteHtml($2); my @pages = map { GetPageLink($_) } grep(/$re/, AllPagesList()); print $q->ul($q->li(\@pages)); ($_, pos) = ($old_, $oldpos); # restore \G return AddHtmlEnvironment('p'); } elsif ($bol && m/\G(\<include\s+gist\s+"(https:\/\/gist\.github\.com\/[0-9]+)"\>[ \t]*\n?)/cgi) { # return "" . ""; } elsif ($bol && m/\G(\<include\s+lisppaste\s+"(http:\/\/paste.lisp.org\/display\/[0-9]+)"\>[ \t]*\n?)/cgi) { Clean(CloseHtmlEnvironments()); Dirty($1); my ($oldpos, $old_) = (pos, $_); print elisp_formatting(GetRaw("$2/raw")); ($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!) return AddHtmlEnvironment('p'); } elsif ($bol && m/\G<pre>\n?(.*?\n)<\/pre>[ \t]*\n?/cgs) { # usemod.pl:
 for monospaced, preformatted and escaped
    my ($oldpos, $old_) = (pos, $_);
    my $html = CloseHtmlEnvironments()
      . elisp_formatting($1) . AddHtmlEnvironment('p');
    ($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
    return $html;
  } elsif ($bol && m/\G(\s*\n)*([ \t]+.+)\n?/gc) {
    # usemod.pl: indented for monospaced, preformatted and escaped
    my $str = $2;
    while (m/\G([ \t]+.*)\n?/gc) {
      $str .= "\n" . $1;
    }
    my ($oldpos, $old_) = (pos, $_);
    my $html = CloseHtmlEnvironments()
      . elisp_formatting($str) . AddHtmlEnvironment('p');
    ($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
    return $html;
  } elsif ($bol && m/\G{{{\n?(.*?\n)}}}[ \t]*\n?/cgs) {
    # marku.pl: 
 for monospaced, preformatted and escaped
    my ($oldpos, $old_) = (pos, $_);
    my $html = CloseHtmlEnvironments()
      . elisp_formatting($1) . AddHtmlEnvironment('p');
    ($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
    return $html;
  } elsif (m/\G\[\[Manual:([^]|]+?)(\|([^]]+?))?\]\](\s+\((.*?)\))?/cog
	  or m/\G\[Manual:([^]]+?)(\s+([^]]+?))?\](\s+\((.*?)\))?/cog
	  or m/\GManual:(((\S+)))(\s+\((.*?)\))?/cog) {
    my ($key, $text, $context) = ($1, $3, $5);
    $text ||= $key;
    my $url = 'http://www.emacswiki.org/cgi-bin/info-ref?find=' . UrlEncode($key);
    $url .= ';context=' . UrlEncode($context) if $context;
    return $q->a({-href=>$url, -class=>'manual'}, $text);
    # } elsif (m/\G\<(div (class|style)="[^\"]+")\>/cgi or m/\G\<(\/div)\>/cgi) {
    #   return CloseHtmlEnvironments() . '<' . UrlDecode($1) . '>';
  }
  return undef;
}

@Debugging = (sub {
		print $q->p($BannedRegexps) . $q->pre(QuoteHtml(GetPageContent($BannedRegexps)));
	      });

push(@MyInitVariables, sub {
       # take the opportunity to clean out some stuff
       delete $AdminPages{$RssInterwikiTranslate};
       delete $AdminPages{$StyleSheetPage};
     });

# nice text to encourage page creation

push(@MyInitVariables, sub {
       my $id = GetId();
       $NewText = Ts('This page does not exist, but you can %s.',
		     '[' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . ' '
		     . T('create it now') . ']')
	 if $id;
     });

# overwrite existing function to handle ForANew and the like
sub UnWiki {
  my $str = shift;
  return $str unless $WikiLinks and $str =~ /^$LinkPattern$/;
  $str =~ s/([[:lower:]])([[:upper:]])/$1 $2/g;
  $str =~ s/\b([[:upper:]])([[:upper:]][[:lower:]])/$1 $2/g;
  return $str;
}

# Add a space between WikiLink segments without compromising copy&paste ability.

*MyOldGetHeader=*GetHeader;
*GetHeader=*MyNewGetHeader;

sub MyNewGetHeader {
  my $html = MyOldGetHeader(@_);
  my $prefix = $CommentsPrefix;
  $prefix =~ s/_/ /g;
  return $html unless $WikiLinks and $html =~ /

(<(a.*?)>)?($prefix)?$LinkPattern(<\/a>)?<\/h1>/; my $str = UnWiki($4); $str = join('', map { $q->span({-style=>"padding-right: 0.5ex;"}, $_) } split(/ +/, $str)); $html =~ s/

()($prefix)?$LinkPattern(<\/a>)?<\/h1>/

$1$2$str$4<\/h1>/; return $html; } $Action{elisp} = \&DoElisp; # for dim and el-get sub DoElisp { SetParam('raw', 1); DoElispArea(); } $Action{'elisp-area'} = \&DoElispArea; # changes to this code won't have an immediate effect because a static # page generated by bin/emacs-elisp-area is getting served instead # (see cgi-bin/.htaccess) sub DoElispArea { my $raw = GetParam('raw'); my $match = GetParam('match', '\.(el|tar)(\.gz)?$'); #' my $context = GetParam('context', 1); if ($raw) { print GetHttpHeader('text/plain'); } else { print GetHeader('', T('Elisp Area!')); print $q->start_div({-class=>'content elisp'}); if ($context) { print $q->p(Ts('Switch to a %s.', ScriptLink('action=elisp-area;context=0', T('compact list')))); } else { print $q->p(Ts('Switch to a %s.', ScriptLink('action=elisp-area', T('list with more context')))); } print '' unless $context; } foreach my $id (grep(/$match/, AllPagesList())) { next if $CommentsPrefix and $id =~ /^$CommentsPrefix(.*)/o; OpenPage($id); next if $Page{text} =~ /^#REDIRECT/; if ($raw) { if ($Page{text} =~ /^(.+)/ and substr($Page{text}, 0, 5) ne '#FILE') { print "$id $1\n"; } else { print "$id\n"; } } elsif ($context) { my $desc; if ($Page{text} =~ /^;;; (.+)/) { $desc = $1; my $re = quotemeta($id); $desc =~ s/$re --?-? ?//; } print $q->p(GetPageLink($id) . ' (' . GetHistoryLink($id, T('history')) . ', ' . ScriptLinkDiff(1, $id, T('diff')) . ')' . $q->br() . ($desc ? $q->em($desc) . $q->br() : '') . T('Last edited') . ' ' . TimeToText($Page{ts}) . ' ' . Ts('by %s', GetAuthorLink($Page{host}, $Page{username}))); } else { print $q->Tr($q->td(GetPageLink($id)), $q->td(TimeToText($Page{ts})), $q->td(ScriptLinkDiff(1, $id, T('diff')))); } } return if $raw; print '
' unless $context; print $q->end_div(); PrintFooter(); } ## comments *MyOldGetFooterLinks = *GetFooterLinks; *GetFooterLinks = *MyNewGetFooterLinks; sub MyNewGetFooterLinks { my $html = MyOldGetFooterLinks(@_); my ($id, $rev) = @_; if ($id and $rev ne 'history' and $rev ne 'edit' and $CommentsPrefix) { if ($id =~ /^$CommentsPrefix(.*)/o) { my $from = NormalToFree($1); my $to = T('Article'); $html =~ s/>$from$top(Ts('This page is already marked with %s.', GetPageLink($fixme))); } else { $text .= "\n" unless $text =~ /\n\n$/; $text .= $fixme . " ($reason)\n"; Save($id, $text, T('This page needs attention')); print $q->p(Tss('%1 has been marked with %2.', GetPageLink($id), GetPageLink($fixme))); } ReleaseLock(); PrintFooter(); } push(@MyAdminCode, \&FixmeMenu); sub FixmeMenu { my ($id, $menuref, $restref) = @_; if ($id) { # push(@$menuref, ScriptLink('action=fixme;id=' . UrlEncode(FreeToNormal($id)), # Ts('%s needs attention', NormalToFree($id)), 'fixme')); push(@$menuref, GetFormStart() . $q->label({-for=>'fixme'}, Ts('%s needs attention: ', NormalToFree($id))) . GetHiddenValue('action', 'fixme') . GetHiddenValue('id', UrlEncode(FreeToNormal($id))) . $q->textfield(-name=>'reason', -size=>20) . $q->submit(T('Save'))); } } push(@MyInitVariables, sub { my $id = GetId(); if (GetParam('action', 'browse') eq 'browse') { OpenPage($id); if ($Page{text} =~ /$fixme/io) { $Message .= $q->p(T('This page needs attention!')); } } }); # making it easy to ban hosts push(@MyAdminCode, \&BanMenu); sub BanMenu { my ($id, $menuref, $restref) = @_; if ($id and UserIsAdmin()) { push(@$menuref, ScriptLink('action=ban;id=' . UrlEncode($id), T('Ban contributors'))); } } $Action{ban} = \&DoBanHosts; sub IsHostBanned { my ($host, $regexps) = @_; foreach my $regexp (@$regexps) { return $host if ($host =~ /$regexp/i); } } sub DoBanHosts { my $id = shift; my $host = GetParam('host', ''); if ($host) { $host =~ s/\./\\./g; SetParam('text', GetPageContent($BannedHosts) . "^" . $host . " # " . CalcDay($Now) . " " . NormalToFree($id) . "\n"); SetParam('summary', NormalToFree($id)); DoPost($BannedHosts); } else { ValidIdOrDie($id); print GetHeader('', Ts('Ban Contributors to %s', NormalToFree($id))); SetParam('rcidonly', $id); SetParam('all', 1); my %contrib = (); for my $line (GetRcLines()) { $contrib{$line->[4]}->{$line->[5]} = 1 if $line->[4]; } my @regexps = (); foreach (split(/\n/, GetPageContent($BannedHosts))) { if (/^\s*([^#]\S+)/) { # all lines except empty lines and comments, trim whitespace push(@regexps, $1); } } print '
'; foreach (sort(keys %contrib)) { my $name = $_; delete $contrib{$_}{''}; $name .= " (" . join(", ", sort(keys(%{$contrib{$_}}))) . ")"; if (IsHostBanned($_, \@regexps)) { print $q->p(Ts("%s is banned", $name)); } else { print GetFormStart(undef, 'get', 'ban'), GetHiddenValue('action', 'ban'), GetHiddenValue('id', $id), GetHiddenValue('host', $_), GetHiddenValue('recent_edit', 'on'), $q->p($name, $q->submit(T('Ban!'))), $q->end_form(); } } } PrintFooter(); } # make maintenance inaccessible for random visitors delete $Action{maintain}; $Action{maintjob} = \&DoAdminMaintenance; sub DoAdminMaintenance { UserIsAdminOrError(); DoMaintenance(); }