forked from github/kensanata.oddmuse
Compare commits
196 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
50c9b79858 | ||
|
|
d99f62ea7e | ||
|
|
c11188fd3e | ||
|
|
dd22a852eb | ||
|
|
62b2e22da8 | ||
|
|
5483bbf386 | ||
|
|
8608464863 | ||
|
|
b0d983c817 | ||
|
|
5f58256543 | ||
|
|
c5c088deb1 | ||
|
|
a5b5af9c07 | ||
|
|
0dcf49e2cf | ||
|
|
f3885aa213 | ||
|
|
6136b399a6 | ||
|
|
5cc7d55152 | ||
|
|
4112d2acc4 | ||
|
|
f270a3ced4 | ||
|
|
375c844e37 | ||
|
|
efce35e250 | ||
|
|
cff4f1fd28 | ||
|
|
6f9ded7e41 | ||
|
|
40c01683fd | ||
|
|
08a4861dc3 | ||
|
|
d7c40d4dbe | ||
|
|
f8360bebad | ||
|
|
45a0558fcc | ||
|
|
f4ff56e69f | ||
|
|
0d7236c047 | ||
|
|
686f24251b | ||
|
|
0841c834b9 | ||
|
|
5225bded01 | ||
|
|
e0d18c31e2 | ||
|
|
670b69c118 | ||
|
|
f4d0f300e6 | ||
|
|
53a7a9a80c | ||
|
|
4f675de687 | ||
|
|
dffe5e3053 | ||
|
|
201970ba0b | ||
|
|
7e9137c6f8 | ||
|
|
9d81a1e3d2 | ||
|
|
2f58de9aa4 | ||
|
|
5ca2bf3efb | ||
|
|
96bc4e14fa | ||
|
|
ad1059dbb2 | ||
|
|
508396d1d1 | ||
|
|
6d457ff87b | ||
|
|
860cb15324 | ||
|
|
56e76a4883 | ||
|
|
3fa8e0a6b0 | ||
|
|
4c4ab98d47 | ||
|
|
ca62cbf446 | ||
|
|
ef3bde90ac | ||
|
|
7771c541bb | ||
|
|
6adabedefe | ||
|
|
a776c67cd6 | ||
|
|
0ddc1770a3 | ||
|
|
44fa8cfb5a | ||
|
|
96c21c2240 | ||
|
|
1c25325257 | ||
|
|
fd5b4e84b1 | ||
|
|
9beff3748b | ||
|
|
87dedeab85 | ||
|
|
1e73ae22d3 | ||
|
|
5e9b02b5b1 | ||
|
|
deec99c353 | ||
|
|
d1b0ac4ccb | ||
|
|
06881768c3 | ||
|
|
8e1f6c92e3 | ||
|
|
1ebc5192ff | ||
|
|
7c52b7b4c2 | ||
|
|
2936ace022 | ||
|
|
4504ef43ac | ||
|
|
50b71adf2d | ||
|
|
8bb0475ba2 | ||
|
|
0e66af495b | ||
|
|
be6752116b | ||
|
|
36577490a7 | ||
|
|
8e4dcc2240 | ||
|
|
dc4de8212a | ||
|
|
ba2de753dd | ||
|
|
6dd1b7e125 | ||
|
|
aec6e9fb30 | ||
|
|
7b7d90f9f9 | ||
|
|
c937258922 | ||
|
|
08aa098203 | ||
|
|
b0fc1e4cc0 | ||
|
|
ca9eef8c09 | ||
|
|
b90b6e9651 | ||
|
|
f10bbb4f81 | ||
|
|
0116618e36 | ||
|
|
d864045815 | ||
|
|
294e5745e7 | ||
|
|
afc4f7ecba | ||
|
|
d249792866 | ||
|
|
59cad086e7 | ||
|
|
cfac228f57 | ||
|
|
a4bd6383a2 | ||
|
|
df0f470998 | ||
|
|
d61bf19b15 | ||
|
|
e0659c4d60 | ||
|
|
70baed8088 | ||
|
|
ab3e187354 | ||
|
|
f17a67d817 | ||
|
|
601218c0b1 | ||
|
|
8af5095ff5 | ||
|
|
0a6cbfa20d | ||
|
|
1630b64fa5 | ||
|
|
ff4ad6e151 | ||
|
|
cc07341463 | ||
|
|
9fd20a9e93 | ||
|
|
1a561c3cb1 | ||
|
|
ca3740ca86 | ||
|
|
7a69437443 | ||
|
|
671f00701b | ||
|
|
af28957796 | ||
|
|
28c56373f6 | ||
|
|
d5fa00f1e2 | ||
|
|
66fe91efed | ||
|
|
3d07062e1f | ||
|
|
f7b94272bf | ||
|
|
9e2353aebc | ||
|
|
bf83cc5ca1 | ||
|
|
d5e7d58d7e | ||
|
|
806a8ba89b | ||
|
|
8602dfb324 | ||
|
|
6647d52e88 | ||
|
|
3dcf08a850 | ||
|
|
2a5454a732 | ||
|
|
ee239428d9 | ||
|
|
dd731569d3 | ||
|
|
d9640c2ef7 | ||
|
|
a57d26f520 | ||
|
|
98f5b48ceb | ||
|
|
4e790f7847 | ||
|
|
355874edad | ||
|
|
91cdb9888a | ||
|
|
ff28c5f79e | ||
|
|
004b0c0831 | ||
|
|
01d9cdf4e3 | ||
|
|
0226a82dca | ||
|
|
31fcd5dc99 | ||
|
|
2c69716295 | ||
|
|
e772254293 | ||
|
|
f8df77d1a6 | ||
|
|
de4af94e89 | ||
|
|
cdee73b859 | ||
|
|
70895ed631 | ||
|
|
14a6cc4e2f | ||
|
|
83eaa45077 | ||
|
|
3a9b92f4a3 | ||
|
|
6e82239616 | ||
|
|
8e2da8a1a9 | ||
|
|
872b914c90 | ||
|
|
1e6f732fa9 | ||
|
|
925f0788fb | ||
|
|
3c0c79a526 | ||
|
|
88e66e825e | ||
|
|
fb7566ae53 | ||
|
|
9b05ea62c5 | ||
|
|
4feccd6484 | ||
|
|
7d166842f0 | ||
|
|
c6943cad7b | ||
|
|
c29037a9d6 | ||
|
|
e1b429c3b7 | ||
|
|
c17c622c97 | ||
|
|
9d11d42e5e | ||
|
|
270e0f4932 | ||
|
|
d1f6e1bb37 | ||
|
|
47e4ad5e41 | ||
|
|
78dd013fc0 | ||
|
|
c04403ca66 | ||
|
|
8c8e23b21a | ||
|
|
fd9a715634 | ||
|
|
957729fd5d | ||
|
|
23fb0cf18b | ||
|
|
8e72af0a45 | ||
|
|
26135820e1 | ||
|
|
2c3abffd2e | ||
|
|
4b46c5385e | ||
|
|
5b7fdbdea4 | ||
|
|
61dae58368 | ||
|
|
6958b66bc5 | ||
|
|
512cbf4ae9 | ||
|
|
e188665a9b | ||
|
|
4898f970b0 | ||
|
|
d9a2db5b8d | ||
|
|
7b518f14f0 | ||
|
|
ff4b889f1c | ||
|
|
b4b6435826 | ||
|
|
011953370a | ||
|
|
40a0b7104a | ||
|
|
964f8c38c0 | ||
|
|
e46c89e90f | ||
|
|
99d8ff2b01 | ||
|
|
dfbd5ad47e | ||
|
|
68ea223940 |
90
contrib/anonymize.pl
Normal file
90
contrib/anonymize.pl
Normal file
@@ -0,0 +1,90 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
=head1 Anonymize oldrc.log Files
|
||||
|
||||
This script will read your oldrc.log file and replace the host field
|
||||
with 'Anonymous'. This is what the main script started doing
|
||||
2013-11-30.
|
||||
|
||||
When you run this script, it sets the main lock to prevent maintenance
|
||||
from running. You can therefore run it on a live system.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
|
||||
sub verify_setup {
|
||||
if (not -f 'oldrc.log') {
|
||||
die "Run this script in your data directory.\n"
|
||||
. "The oldrc.log file should be in the same directory.\n";
|
||||
}
|
||||
if (not -d 'temp') {
|
||||
die "Run this script in your data directory.\n"
|
||||
. "The temp directory should be in the same directory.\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub request_lock {
|
||||
if (-d 'temp/lockmain') {
|
||||
die "The wiki is currently locked.\n"
|
||||
. "Rerun this script later.\n";
|
||||
}
|
||||
mkdir('temp/lockmain') or die "Could not create 'temp/lockmain'.\n"
|
||||
. "You probably don't have the file permissions necessary.\n";
|
||||
}
|
||||
|
||||
sub release_lock {
|
||||
rmdir('temp/lockmain') or die "Could not remove 'temp/lockmain'.\n"
|
||||
}
|
||||
|
||||
sub anonymize {
|
||||
open(F, 'oldrc.log') or die "Could not open 'oldrc.log' for reading.\n";
|
||||
open(B, '>oldrc.log~') or die "Could not open 'oldrc.log~' for writing.\n"
|
||||
. "I will not continue without having a backup available.\n";
|
||||
my $FS = "\x1e"; # The FS character is the RECORD SEPARATOR control char
|
||||
my @lines = ();
|
||||
while (my $line = <F>) {
|
||||
next if $line eq "\n"; # some rc.log files are broken and contain empty lines
|
||||
my ($ts, $id, $minor, $summary, $host, @rest) = split(/$FS/o, $line);
|
||||
if ($id eq '[[rollback]]') {
|
||||
# rollback markers are very different
|
||||
push(@lines, $line);
|
||||
} else {
|
||||
# anonymize
|
||||
push(@lines, join($FS, $ts, $id, $minor, $summary, 'Anonymous', @rest));
|
||||
}
|
||||
print B $line;
|
||||
}
|
||||
close(F);
|
||||
open(F, '>', 'oldrc.log') or die "Could not open 'oldrc.log' for writing.\n";
|
||||
for my $line (@lines) {
|
||||
print F $line; # @rest ends with a newline
|
||||
}
|
||||
close(F);
|
||||
print "Wrote anonymized 'oldrc.log'.\n";
|
||||
print "Saved a backup as 'oldrc.log~'\n";
|
||||
}
|
||||
|
||||
sub main {
|
||||
verify_setup();
|
||||
request_lock();
|
||||
anonymize();
|
||||
release_lock();
|
||||
}
|
||||
|
||||
main();
|
||||
@@ -1,21 +1,17 @@
|
||||
#!/usr/bin/perl
|
||||
# Copyright (C) 2005, 2006, 2007 Alex Schroeder <alex@emacswiki.org>
|
||||
# Copyright (C) 2005, 2006, 2007, 2012 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the
|
||||
# Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330
|
||||
# Boston, MA 02111-1307 USA
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
@@ -38,6 +34,42 @@ my %indexes = (
|
||||
=> 'GNU Emacs Lisp reference manual, Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/elisp/index.html'
|
||||
=> 'GNU Emacs Lisp reference manual, Top Menu',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/message/Index.html'
|
||||
=> 'Message Manual, Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/gnus/Index.html'
|
||||
=> 'The Gnus Newsreader, Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/cl/Function-Index.html'
|
||||
=> 'Common Lisp Extensions, Function Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/ccmode/Variable-Index.html'
|
||||
=> 'CC Mode Manual, Variable Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/ccmode/Concept-and-Key-Index.html'
|
||||
=> 'CC Mode Manual, Command and Function Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/org/Index.html'
|
||||
=> 'Org Mode Manual, Index',
|
||||
'http://www.gnu.org/software/auctex/manual/auctex/Function-Index.html'
|
||||
=> 'AUCTeX Manual, Function Index',
|
||||
'http://www.gnu.org/software/auctex/manual/auctex/Variable-Index.html'
|
||||
=> 'AUCTeX Manual, Variable Index',
|
||||
'http://www.gnu.org/software/auctex/manual/auctex/Concept-Index.html'
|
||||
=> 'AUCTeX Manual, Concept Index',
|
||||
'http://www.gnu.org/software/texinfo/manual/texinfo/html_node/index.html'
|
||||
=> 'Texinfo, Command and Variable Index',
|
||||
'http://www.gnu.org/software/texinfo/manual/texinfo/html_node/General-Index.html'
|
||||
=> 'Texinfo, General Index',
|
||||
'http://www.gnu.org/software/texinfo/manual/info/html_node/Index.html'
|
||||
=> 'Info, Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/dired-x/Command-Index.html'
|
||||
=> 'Dired Extra, Function Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/dired-x/Variable-Index.html'
|
||||
=> 'Dired Extra, Variable Index',
|
||||
'http://www.gnu.org/software/coreutils/manual/html_node/Concept-index.html'
|
||||
=> 'Coreutils, Index',
|
||||
'http://www.gnu.org/software/diffutils/manual/html_node/Index.html'
|
||||
=> 'Diffutils, Index',
|
||||
'http://www.gnu.org/software/findutils/manual/html_node/find_html/Primary-Index.html'
|
||||
=> 'Findutils, Primary Index',
|
||||
'http://www.gnu.org/software/emacs/manual/html_node/ediff/Index.html'
|
||||
=> 'Edfiff, Index',
|
||||
);
|
||||
|
||||
my $db = '/org/org.emacswiki/htdocs/emacs/info-ref.dat';
|
||||
@@ -63,7 +95,9 @@ sub ProcessRequest {
|
||||
sub ShowForm {
|
||||
print $q->header, $q->start_html,
|
||||
$q->start_form, "Index entry: ", $q->textfield('find'), $q->submit, $q->end_form,
|
||||
$q->p('$Id: info-ref,v 1.1 2007/07/13 23:20:57 as Exp $'),
|
||||
$q->p($q->a({-href=>"http://www.emacswiki.org/scripts/info-ref"}, "Source"), $q->br(),
|
||||
'Last DB update: ', TimeToText((stat($db))[9]),
|
||||
' (' . $q->a({-href=>$q->url . '?init=1'}, "update") . ')'),
|
||||
$q->end_html;
|
||||
}
|
||||
|
||||
@@ -74,9 +108,11 @@ sub Find {
|
||||
foreach my $line (split(/$nl/, $data)) {
|
||||
my ($key, $rest) = split(/$fs/, $line);
|
||||
$map{$key} = ();
|
||||
foreach my $a (split(/$gs/, $rest)) {
|
||||
my ($link, $label) = split(/$rs/, $a);
|
||||
$map{$key}{$link} = $label;
|
||||
if ($rest) {
|
||||
foreach my $a (split(/$gs/, $rest)) {
|
||||
my ($link, $label) = split(/$rs/, $a);
|
||||
$map{$key}{$link} = $label;
|
||||
}
|
||||
}
|
||||
}
|
||||
my @links = keys %{$map{$str}};
|
||||
@@ -150,7 +186,7 @@ sub GetRaw {
|
||||
return unless eval { require LWP::UserAgent; };
|
||||
my $ua = LWP::UserAgent->new;
|
||||
my $response = $ua->get($uri);
|
||||
return $response->content;
|
||||
return $response->decoded_content;
|
||||
}
|
||||
|
||||
sub ReadFile {
|
||||
@@ -189,3 +225,18 @@ sub ReportError { # fatal!
|
||||
print $q->start_html, $q->h2($errmsg), $q->end_html;
|
||||
exit (1);
|
||||
}
|
||||
|
||||
sub CalcDay {
|
||||
my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
|
||||
return sprintf('%4d-%02d-%02d', $year+1900, $mon+1, $mday);
|
||||
}
|
||||
|
||||
sub CalcTime {
|
||||
my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
|
||||
return sprintf('%02d:%02d UTC', $hour, $min);
|
||||
}
|
||||
|
||||
sub TimeToText {
|
||||
my $t = shift;
|
||||
return CalcDay($t) . ' ' . CalcTime($t);
|
||||
}
|
||||
|
||||
694
contrib/oddmuse-curl.el
Normal file
694
contrib/oddmuse-curl.el
Normal file
@@ -0,0 +1,694 @@
|
||||
;;; oddmuse-curl.el -- edit pages on an Oddmuse wiki using curl
|
||||
;;
|
||||
;; Copyright (C) 2006–2014 Alex Schroeder <alex@gnu.org>
|
||||
;; (C) 2007 rubikitch <rubikitch@ruby-lang.org>
|
||||
;;
|
||||
;; Latest version:
|
||||
;; http://git.savannah.gnu.org/cgit/oddmuse.git/plain/contrib/oddmuse-curl.el
|
||||
;; Discussion, feedback:
|
||||
;; http://www.emacswiki.org/cgi-bin/wiki/OddmuseCurl
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify it
|
||||
;; under the terms of the GNU General Public License as published by the Free
|
||||
;; Software Foundation, either version 3 of the License, or (at your option)
|
||||
;; any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
||||
;; more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License along
|
||||
;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; A simple mode to edit pages on Oddmuse wikis using Emacs and the command-line
|
||||
;; HTTP client `curl'.
|
||||
;;
|
||||
;; Since text formatting rules depend on the wiki you're writing for, the
|
||||
;; font-locking can only be an approximation.
|
||||
;;
|
||||
;; Put this file in a directory on your `load-path' and
|
||||
;; add this to your init file:
|
||||
;; (require 'oddmuse)
|
||||
;; (oddmuse-mode-initialize)
|
||||
;; And then use M-x oddmuse-edit to start editing.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl)
|
||||
(require 'sgml-mode)
|
||||
(require 'skeleton))
|
||||
|
||||
(require 'goto-addr)
|
||||
(require 'info)
|
||||
|
||||
(defcustom oddmuse-directory "~/.emacs.d/oddmuse"
|
||||
"Directory to store oddmuse pages."
|
||||
:type '(string)
|
||||
:group 'oddmuse)
|
||||
|
||||
(defcustom oddmuse-wikis
|
||||
'(("EmacsWiki" "http://www.emacswiki.org/cgi-bin/emacs"
|
||||
utf-8 "uihnscuskc" nil)
|
||||
("OddmuseWiki" "http://www.oddmuse.org/cgi-bin/oddmuse"
|
||||
utf-8 "question" nil))
|
||||
"Alist mapping wiki names to URLs.
|
||||
|
||||
The elements in this list are:
|
||||
|
||||
NAME, the name of the wiki you provide when calling `oddmuse-edit'.
|
||||
|
||||
URL, the base URL of the script used when posting. If the site
|
||||
uses URL rewriting, then you need to extract the URL from the
|
||||
edit page. Emacs Wiki, for example, usually shows an URL such as
|
||||
http://www.emacswiki.org/emacs/Foo, but when you edit the page
|
||||
and examine the page source, you'll find this:
|
||||
|
||||
<form method=\"post\" action=\"http://www.emacswiki.org/cgi-bin/emacs\"
|
||||
enctype=\"multipart/form-data\" accept-charset=\"utf-8\"
|
||||
class=\"edit text\">...</form>
|
||||
|
||||
Thus, the correct value for URL is
|
||||
http://www.emacswiki.org/cgi-bin/emacs.
|
||||
|
||||
ENCODING, a symbol naming a coding-system.
|
||||
|
||||
SECRET, the secret the wiki uses if it has the Question Asker
|
||||
extension enabled. If you're getting 403 responses (edit denied)
|
||||
eventhough you can do it from a browser, examine your cookie in
|
||||
the browser. For Emacs Wiki, for example, my cookie says:
|
||||
|
||||
euihnscuskc%251e1%251eusername%251eAlexSchroeder
|
||||
|
||||
Use `split-string' and split by \"%251e\" and you'll see that
|
||||
\"euihnscuskc\" is the odd one out. The parameter name is the
|
||||
relevant string (its value is always 1).
|
||||
|
||||
USERNAME, your optional username to provide. It defaults to
|
||||
`oddmuse-username'."
|
||||
:type '(repeat (list (string :tag "Wiki")
|
||||
(string :tag "URL")
|
||||
(choice :tag "Coding System"
|
||||
(const :tag "default" utf-8)
|
||||
(symbol :tag "specify"
|
||||
:validate (lambda (widget)
|
||||
(unless (coding-system-p
|
||||
(widget-value widget))
|
||||
(widget-put widget :error
|
||||
"Not a valid coding system")))))
|
||||
(choice :tag "Secret"
|
||||
(const :tag "default" "question")
|
||||
(string :tag "specify"))
|
||||
(choice :tag "Username"
|
||||
(const :tag "default" nil)
|
||||
(string :tag "specify"))))
|
||||
:group 'oddmuse)
|
||||
|
||||
(defcustom oddmuse-username user-full-name
|
||||
"Username to use when posting.
|
||||
Setting a username is the polite thing to do."
|
||||
:type '(string)
|
||||
:group 'oddmuse)
|
||||
|
||||
(defcustom oddmuse-password ""
|
||||
"Password to use when posting.
|
||||
You only need this if you want to edit locked pages and you
|
||||
know an administrator password."
|
||||
:type '(string)
|
||||
:group 'oddmuse)
|
||||
|
||||
(defcustom oddmuse-use-always-minor nil
|
||||
"When t, set all the minor mode bit to all editions.
|
||||
This can be changed for each edition using `oddmuse-toggle-minor'."
|
||||
:type '(boolean)
|
||||
:group 'oddmuse)
|
||||
|
||||
(defvar oddmuse-get-command
|
||||
"curl --silent %w\"?action=browse;raw=2;\"id=%t"
|
||||
"Command to use for publishing pages.
|
||||
It must print the page to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'
|
||||
%t URL encoded pagename, eg. HowTo, How_To, or How%20To")
|
||||
|
||||
(defvar oddmuse-history-command
|
||||
"curl --silent %w\"?action=history;raw=1;\"id=%t"
|
||||
"Command to use for reading the history of a page.
|
||||
It must print the history to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'
|
||||
%t URL encoded pagename, eg. HowTo, How_To, or How%20To")
|
||||
|
||||
(defvar oddmuse-rc-command
|
||||
"curl --silent %w\"?action=rc;raw=1\""
|
||||
"Command to use for Recent Changes.
|
||||
It must print the RSS 3.0 text format to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'")
|
||||
|
||||
(defvar oddmuse-post-command
|
||||
(concat "curl --silent --write-out '%{http_code}'"
|
||||
" --form title='%t'"
|
||||
" --form summary='%s'"
|
||||
" --form username='%u'"
|
||||
" --form password='%p'"
|
||||
" --form %q=1"
|
||||
" --form recent_edit=%m"
|
||||
" --form oldtime=%o"
|
||||
" --form text='<-'"
|
||||
" '%w'")
|
||||
"Command to use for publishing pages.
|
||||
It must accept the page on stdin.
|
||||
|
||||
%? '?' character
|
||||
%t pagename
|
||||
%s summary
|
||||
%u username
|
||||
%p password
|
||||
%q question-asker cookie
|
||||
%m minor edit
|
||||
%o oldtime, a timestamp provided by Oddmuse
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'")
|
||||
|
||||
(defvar oddmuse-link-pattern
|
||||
"\\<[[:upper:]]+[[:lower:]]+\\([[:upper:]]+[[:lower:]]*\\)+\\>"
|
||||
"The pattern used for finding WikiName.")
|
||||
|
||||
(defvar oddmuse-wiki nil
|
||||
"The current wiki.
|
||||
Must match a key from `oddmuse-wikis'.")
|
||||
|
||||
(defvar oddmuse-page-name nil
|
||||
"Pagename of the current buffer.")
|
||||
|
||||
(defvar oddmuse-pages-hash (make-hash-table :test 'equal)
|
||||
"The wiki-name / pages pairs.")
|
||||
|
||||
(defvar oddmuse-index-get-command
|
||||
"curl --silent %w\"?action=index;raw=1\""
|
||||
"Command to use for publishing index pages.
|
||||
It must print the page to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'
|
||||
")
|
||||
|
||||
(defvar oddmuse-minor nil
|
||||
"Is this edit a minor change?")
|
||||
|
||||
(defvar oddmuse-revision nil
|
||||
"The ancestor of the current page.
|
||||
This is used by Oddmuse to merge changes.")
|
||||
|
||||
(defun oddmuse-mode-initialize ()
|
||||
(add-to-list 'auto-mode-alist
|
||||
`(,(expand-file-name oddmuse-directory) . oddmuse-mode)))
|
||||
|
||||
(defun oddmuse-creole-markup ()
|
||||
"Implement markup rules for the Creole markup extension."
|
||||
(font-lock-add-keywords
|
||||
nil
|
||||
'(("^=[^=\n]+" 0 '(face info-title-1 help-echo "Creole H1")); = h1
|
||||
("^==[^=\n]+" 0 '(face info-title-2 help-echo "Creole H2")); == h2
|
||||
("^===[^=\n]+" 0 '(face info-title-3 help-echo "Creole H3")); === h3
|
||||
("^====+[^=\n]+" 0 '(face info-title-4 help-echo "Creole H4")); ====h4
|
||||
("\\_<//\\(.*\n\\)*?.*?//" 0 '(face italic help-echo "Creole italic")); //italic//
|
||||
("\\*\\*\\(.*\n\\)*?.*?\\*\\*" 0 '(face bold help-echo "Creole bold")); **bold**
|
||||
("__\\(.*\n\\)*?.*?__" 0 '(face underline help-echo "Creole underline")); __underline__
|
||||
("|+=?" 0 '(face font-lock-string-face help-echo "Creole table cell"))
|
||||
("\\\\\\\\[ \t]+" 0 '(face font-lock-warning-face help-echo "Creole line break"))
|
||||
("^#+ " 0 '(face font-lock-constant-face help-echo "Creole ordered list"))
|
||||
("^- " 0 '(face font-lock-constant-face help-echo "Creole ordered list")))))
|
||||
|
||||
(defun oddmuse-bbcode-markup ()
|
||||
"Implement markup rules for the bbcode markup extension."
|
||||
(font-lock-add-keywords
|
||||
nil
|
||||
`(("\\[b\\]\\(.*\n\\)*?.*?\\[/b\\]"
|
||||
0 '(face bold help-echo "BB code bold"))
|
||||
("\\[i\\]\\(.*\n\\)*?.*?\\[/i\\]"
|
||||
0 '(face italic help-echo "BB code italic"))
|
||||
("\\[u\\]\\(.*\n\\)*?.*?\\[/u\\]"
|
||||
0 '(face underline help-echo "BB code underline"))
|
||||
(,(concat "\\[url=" goto-address-url-regexp "\\]")
|
||||
0 '(face font-lock-builtin-face help-echo "BB code url"))
|
||||
("\\[/?\\(img\\|url\\)\\]"
|
||||
0 '(face font-lock-builtin-face help-echo "BB code url or img"))
|
||||
("\\[s\\(trike\\)?\\]\\(.*\n\\)*?.*?\\[/s\\(trike\\)?\\]"
|
||||
0 '(face strike help-echo "BB code strike"))
|
||||
("\\[/?\\(left\\|right\\|center\\)\\]"
|
||||
0 '(face font-lock-constant-face help-echo "BB code alignment")))))
|
||||
|
||||
(defun oddmuse-usemod-markup ()
|
||||
"Implement markup rules for the Usemod markup extension."
|
||||
(font-lock-add-keywords
|
||||
nil
|
||||
'(("^=[^=\n]+=$"
|
||||
0 '(face info-title-1 help-echo "Usemod H1"))
|
||||
("^==[^=\n]+==$"
|
||||
0 '(face info-title-2 help-echo "Usemod H2"))
|
||||
("^===[^=\n]+===$"
|
||||
0 '(face info-title-3 help-echo "Usemod H3"))
|
||||
("^====+[^=\n]+====$"
|
||||
0 '(face info-title-4 help-echo "Usemod H4"))
|
||||
("^ .+?$"
|
||||
0 '(face font-lock-comment-face help-echo "Usemod block"))
|
||||
("^[#]+ "
|
||||
0 '(face font-lock-constant-face help-echo "Usemod ordered list")))))
|
||||
|
||||
(defun oddmuse-usemod-html-markup ()
|
||||
"Implement markup rules for the HTML option in the Usemod markup extension."
|
||||
(font-lock-add-keywords
|
||||
nil
|
||||
'(("<\\(/?[a-z]+\\)" 1 '(face font-lock-function-name-face help-echo "Usemod HTML"))))
|
||||
(set (make-local-variable 'sgml-tag-alist)
|
||||
`(("b") ("code") ("em") ("i") ("strong") ("nowiki")
|
||||
("pre" \n) ("tt") ("u")))
|
||||
(set (make-local-variable 'skeleton-transformation) 'identity))
|
||||
|
||||
(defun oddmuse-extended-markup ()
|
||||
"Implement markup rules for the Markup extension."
|
||||
(font-lock-add-keywords
|
||||
nil
|
||||
'(("\\*\\w+[[:word:]-%.,:;\'\"!? ]*\\*"
|
||||
0 '(face bold help-echo "Markup bold"))
|
||||
("\\_</\\w+[[:word:]-%.,:;\'\"!? ]*/"
|
||||
0 '(face italic help-echo "Markup italic"))
|
||||
("_\\w+[[:word:]-%.,:;\'\"!? ]*_"
|
||||
0 '(face underline help-echo "Markup underline")))))
|
||||
|
||||
(defun oddmuse-basic-markup ()
|
||||
"Implement markup rules for the basic Oddmuse setup without extensions.
|
||||
This function should come come last in `oddmuse-markup-functions'
|
||||
because of such basic patterns as [.*] which are very generic."
|
||||
(font-lock-add-keywords
|
||||
nil
|
||||
`((,oddmuse-link-pattern
|
||||
0 '(face link help-echo "Basic wiki name"))
|
||||
("\\[\\[.*?\\]\\]"
|
||||
0 '(face link help-echo "Basic free link"))
|
||||
(,(concat "\\[" goto-address-url-regexp "\\( .+?\\)?\\]")
|
||||
0 '(face link help-echo "Basic external free link"))
|
||||
("^\\([*]+\\)"
|
||||
0 '(face font-lock-constant-face help-echo "Basic bullet list"))))
|
||||
(goto-address))
|
||||
|
||||
;; Should determine this automatically based on the version? And cache it per wiki?
|
||||
;; http://emacswiki.org/wiki?action=version
|
||||
(defvar oddmuse-markup-functions
|
||||
'(oddmuse-basic-markup
|
||||
oddmuse-extended-markup
|
||||
oddmuse-usemod-markup
|
||||
oddmuse-creole-markup
|
||||
oddmuse-bbcode-markup)
|
||||
"The list of functions to call when `oddmuse-mode' runs.
|
||||
Later functions take precedence because they call `font-lock-add-keywords'
|
||||
which adds the expressions to the front of the existing list.")
|
||||
|
||||
(define-derived-mode oddmuse-mode text-mode "Odd"
|
||||
"Simple mode to edit wiki pages.
|
||||
|
||||
Use \\[oddmuse-follow] to follow links. With prefix, allows you
|
||||
to specify the target page yourself.
|
||||
|
||||
Use \\[oddmuse-post] to post changes. With prefix, allows you to
|
||||
post the page to a different wiki.
|
||||
|
||||
Use \\[oddmuse-edit] to edit a different page. With prefix,
|
||||
forces a reload of the page instead of just popping to the buffer
|
||||
if you are already editing the page.
|
||||
|
||||
Customize `oddmuse-wikis' to add more wikis to the list.
|
||||
|
||||
Font-locking is controlled by `oddmuse-markup-functions'.
|
||||
|
||||
\\{oddmuse-mode-map}"
|
||||
(mapc 'funcall oddmuse-markup-functions)
|
||||
(font-lock-mode 1)
|
||||
(when buffer-file-name
|
||||
(set (make-local-variable 'oddmuse-wiki)
|
||||
(file-name-nondirectory
|
||||
(substring (file-name-directory buffer-file-name) 0 -1)))
|
||||
(set (make-local-variable 'oddmuse-page-name)
|
||||
(file-name-nondirectory buffer-file-name)))
|
||||
(set (make-local-variable 'oddmuse-minor)
|
||||
oddmuse-use-always-minor)
|
||||
(set (make-local-variable 'oddmuse-revision)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (looking-at
|
||||
"\\([0-9]+\\) # Do not delete this line when editing!\n")
|
||||
(prog1 (match-string 1)
|
||||
(replace-match "")
|
||||
(set-buffer-modified-p nil)))))
|
||||
(setq indent-tabs-mode nil))
|
||||
|
||||
(autoload 'sgml-tag "sgml-mode" t)
|
||||
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-t") 'sgml-tag)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-o") 'oddmuse-follow)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-m") 'oddmuse-toggle-minor)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-c") 'oddmuse-post)
|
||||
(define-key oddmuse-mode-map (kbd "C-x C-v") 'oddmuse-revert)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-f") 'oddmuse-edit)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-i") 'oddmuse-insert-pagename)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-h") 'oddmuse-history)
|
||||
(define-key oddmuse-mode-map (kbd "C-c C-r") 'oddmuse-rc)
|
||||
|
||||
;; This has been stolen from simple-wiki-edit
|
||||
;;;###autoload
|
||||
(defun oddmuse-toggle-minor (&optional arg)
|
||||
"Toggle minor mode state."
|
||||
(interactive)
|
||||
(let ((num (prefix-numeric-value arg)))
|
||||
(cond
|
||||
((or (not arg) (equal num 0))
|
||||
(setq oddmuse-minor (not oddmuse-minor)))
|
||||
((> num 0) (set 'oddmuse-minor t))
|
||||
((< num 0) (set 'oddmuse-minor nil)))
|
||||
(message "Oddmuse Minor set to %S" oddmuse-minor)
|
||||
oddmuse-minor))
|
||||
|
||||
(add-to-list 'minor-mode-alist
|
||||
'(oddmuse-minor " [MINOR]"))
|
||||
|
||||
(defun oddmuse-format-command (command)
|
||||
"Internal: Substitute oddmuse format flags according to `url',
|
||||
`oddmuse-page-name', `summary', `oddmuse-username', `question',
|
||||
`oddmuse-password', `oddmuse-revision'."
|
||||
(let ((hatena "?"))
|
||||
(dolist (pair '(("%w" . url)
|
||||
("%t" . oddmuse-page-name)
|
||||
("%s" . summary)
|
||||
("%u" . oddmuse-username)
|
||||
("%m" . oddmuse-minor)
|
||||
("%p" . oddmuse-password)
|
||||
("%q" . question)
|
||||
("%o" . oddmuse-revision)
|
||||
("%r" . regexp)
|
||||
("%\\?" . hatena)))
|
||||
(when (and (boundp (cdr pair)) (stringp (symbol-value (cdr pair))))
|
||||
(setq command (replace-regexp-in-string (car pair)
|
||||
(symbol-value (cdr pair))
|
||||
command t t))))
|
||||
command))
|
||||
|
||||
(defun oddmuse-read-wiki-and-pagename (&optional required default)
|
||||
"Read an wikiname and a pagename of `oddmuse-wikis' with completion.
|
||||
If provided, REQUIRED and DEFAULT are passed along to `oddmuse-read-pagename'."
|
||||
(let ((wiki (completing-read "Wiki: " oddmuse-wikis nil t oddmuse-wiki)))
|
||||
(list wiki (oddmuse-read-pagename wiki required default))))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-history (wiki pagename)
|
||||
"Show a page's history on a wiki using `view-mode'.
|
||||
WIKI is the name of the wiki as defined in `oddmuse-wikis',
|
||||
PAGENAME is the pagename of the page you want the history of.
|
||||
Use a prefix argument to force a reload of the page."
|
||||
(interactive (oddmuse-read-wiki-and-pagename t oddmuse-page-name))
|
||||
(let ((name (concat wiki ":" pagename " [history]")))
|
||||
(if (and (get-buffer name)
|
||||
(not current-prefix-arg))
|
||||
(pop-to-buffer (get-buffer name))
|
||||
(let* ((wiki-data (assoc wiki oddmuse-wikis))
|
||||
(url (nth 1 wiki-data))
|
||||
(oddmuse-page-name pagename)
|
||||
(command (oddmuse-format-command oddmuse-history-command))
|
||||
(coding (nth 2 wiki-data))
|
||||
(buf (get-buffer-create name)))
|
||||
(set-buffer buf)
|
||||
(erase-buffer)
|
||||
(let ((max-mini-window-height 1))
|
||||
(shell-command command buf))
|
||||
(pop-to-buffer buf)
|
||||
(goto-address)
|
||||
(view-mode)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-edit (wiki pagename)
|
||||
"Edit a page on a wiki.
|
||||
WIKI is the name of the wiki as defined in `oddmuse-wikis',
|
||||
PAGENAME is the pagename of the page you want to edit.
|
||||
Use a prefix argument to force a reload of the page."
|
||||
(interactive (oddmuse-read-wiki-and-pagename))
|
||||
(make-directory (concat oddmuse-directory "/" wiki) t)
|
||||
(let ((name (concat wiki ":" pagename)))
|
||||
(if (and (get-buffer name)
|
||||
(not current-prefix-arg))
|
||||
(pop-to-buffer (get-buffer name))
|
||||
(let* ((wiki-data (assoc wiki oddmuse-wikis))
|
||||
(url (nth 1 wiki-data))
|
||||
(oddmuse-page-name pagename)
|
||||
(command (oddmuse-format-command oddmuse-get-command))
|
||||
(coding (nth 2 wiki-data))
|
||||
(buf (find-file-noselect (concat oddmuse-directory "/" wiki "/"
|
||||
pagename)))
|
||||
(coding-system-for-read coding)
|
||||
(coding-system-for-write coding))
|
||||
;; don't use let for dynamically bound variable
|
||||
(set-buffer buf)
|
||||
(unless (equal name (buffer-name)) (rename-buffer name))
|
||||
(erase-buffer)
|
||||
(let ((max-mini-window-height 1))
|
||||
(oddmuse-run "Loading" command buf nil))
|
||||
(pop-to-buffer buf)
|
||||
(oddmuse-mode)))))
|
||||
|
||||
(defalias 'oddmuse-go 'oddmuse-edit)
|
||||
|
||||
(autoload 'word-at-point "thingatpt")
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-follow (arg)
|
||||
"Figure out what page we need to visit
|
||||
and call `oddmuse-edit' on it."
|
||||
(interactive "P")
|
||||
(let ((pagename (or (and arg (oddmuse-read-pagename oddmuse-wiki))
|
||||
(oddmuse-pagename-at-point)
|
||||
(oddmuse-read-pagename oddmuse-wiki))))
|
||||
(oddmuse-edit (or oddmuse-wiki
|
||||
(read-from-minibuffer "URL: "))
|
||||
pagename)))
|
||||
|
||||
(defun oddmuse-current-free-link-contents ()
|
||||
"Free link contents if the point is between [[ and ]]."
|
||||
(save-excursion
|
||||
(let* ((pos (point))
|
||||
(start (search-backward "[[" nil t))
|
||||
(end (search-forward "]]" nil t)))
|
||||
(and start end (>= end pos)
|
||||
(replace-regexp-in-string
|
||||
" " "_"
|
||||
(buffer-substring (+ start 2) (- end 2)))))))
|
||||
|
||||
(defun oddmuse-pagename-at-point ()
|
||||
"Page name at point."
|
||||
(let ((pagename (word-at-point)))
|
||||
(or (oddmuse-current-free-link-contents)
|
||||
(oddmuse-wikiname-p pagename))))
|
||||
|
||||
(defun oddmuse-wikiname-p (pagename)
|
||||
"Whether PAGENAME is WikiName or not."
|
||||
(when pagename
|
||||
(let (case-fold-search)
|
||||
(when (string-match (concat "^" oddmuse-link-pattern "$") pagename)
|
||||
pagename))))
|
||||
|
||||
;; (oddmuse-wikiname-p nil)
|
||||
;; (oddmuse-wikiname-p "WikiName")
|
||||
;; (oddmuse-wikiname-p "not-wikiname")
|
||||
;; (oddmuse-wikiname-p "notWikiName")
|
||||
|
||||
(defun oddmuse-run (mesg command buf on-region)
|
||||
"Print MESG and run COMMAND on the current buffer.
|
||||
MESG should be appropriate for the following uses:
|
||||
\"MESG...\"
|
||||
\"MESG...done\"
|
||||
\"MESG failed: REASON\"
|
||||
Save outpout in BUF and report an appropriate error.
|
||||
ON-REGION indicates whether the commands runs on the region
|
||||
such as when posting, or whether it just runs by itself such
|
||||
as when loading a page."
|
||||
(message "%s using %s..." mesg command)
|
||||
;; If ON-REGION, the resulting HTTP CODE is found in BUF, so check
|
||||
;; that, too.
|
||||
(if (and (= 0 (if on-region
|
||||
(shell-command-on-region (point-min) (point-max) command buf)
|
||||
(shell-command command buf)))
|
||||
(or (not on-region)
|
||||
(string= "302" (with-current-buffer buf
|
||||
(buffer-string)))))
|
||||
(message "%s...done" mesg)
|
||||
(let ((err "Unknown error"))
|
||||
(with-current-buffer buf
|
||||
(when (re-search-forward "<h1>\\(.*?\\)\\.?</h1>" nil t)
|
||||
(setq err (match-string 1))))
|
||||
(error "%s...%s" mesg err))))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-post (summary)
|
||||
"Post the current buffer to the current wiki.
|
||||
The current wiki is taken from `oddmuse-wiki'."
|
||||
(interactive "sSummary: ")
|
||||
;; when using prefix or on a buffer that is not in oddmuse-mode
|
||||
(when (or (not oddmuse-wiki) current-prefix-arg)
|
||||
(set (make-local-variable 'oddmuse-wiki)
|
||||
(completing-read "Wiki: " oddmuse-wikis nil t)))
|
||||
(when (not oddmuse-page-name)
|
||||
(set (make-local-variable 'oddmuse-page-name)
|
||||
(read-from-minibuffer "Pagename: " (buffer-name))))
|
||||
(let* ((list (assoc oddmuse-wiki oddmuse-wikis))
|
||||
(url (nth 1 list))
|
||||
(oddmuse-minor (if oddmuse-minor "on" "off"))
|
||||
(coding (nth 2 list))
|
||||
(coding-system-for-read coding)
|
||||
(coding-system-for-write coding)
|
||||
(question (nth 3 list))
|
||||
(oddmuse-username (or (nth 4 list)
|
||||
oddmuse-username))
|
||||
(command (oddmuse-format-command oddmuse-post-command))
|
||||
(buf (get-buffer-create " *oddmuse-response*"))
|
||||
(text (buffer-string)))
|
||||
(and buffer-file-name (basic-save-buffer))
|
||||
(oddmuse-run "Posting" command buf t)))
|
||||
|
||||
(defun oddmuse-make-completion-table (wiki)
|
||||
"Create pagename completion table for WIKI.
|
||||
If available, return precomputed one."
|
||||
(or (gethash wiki oddmuse-pages-hash)
|
||||
(oddmuse-compute-pagename-completion-table wiki)))
|
||||
|
||||
(defun oddmuse-compute-pagename-completion-table (&optional wiki-arg)
|
||||
"Really fetch the list of pagenames from WIKI.
|
||||
This command is used to reflect new pages to `oddmuse-pages-hash'."
|
||||
(interactive)
|
||||
(let* ((wiki (or wiki-arg
|
||||
(completing-read "Wiki: " oddmuse-wikis nil t oddmuse-wiki)))
|
||||
(url (cadr (assoc wiki oddmuse-wikis)))
|
||||
(command (oddmuse-format-command oddmuse-index-get-command))
|
||||
table)
|
||||
(message "Getting index of all pages...")
|
||||
(prog1
|
||||
(setq table (split-string (shell-command-to-string command)))
|
||||
(puthash wiki table oddmuse-pages-hash)
|
||||
(message "Getting index of all pages...done"))))
|
||||
|
||||
(defun oddmuse-read-pagename (wiki &optional require default)
|
||||
"Read a pagename of WIKI with completion.
|
||||
Optional arguments REQUIRE and DEFAULT are passed on to `completing-read'.
|
||||
Typically you would use t and a `oddmuse-page-name', if that makes sense."
|
||||
(completing-read (if default
|
||||
(concat "Pagename [" default "]: ")
|
||||
"Pagename: ")
|
||||
(oddmuse-make-completion-table wiki)
|
||||
nil require nil nil default))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-rc (&optional include-minor-edits)
|
||||
"Show Recent Changes.
|
||||
With universal argument, reload."
|
||||
(interactive "P")
|
||||
(let* ((wiki (or oddmuse-wiki
|
||||
(completing-read "Wiki: " oddmuse-wikis nil t)))
|
||||
(name (concat "*" wiki " RC*")))
|
||||
(if (and (get-buffer name)
|
||||
(not current-prefix-arg))
|
||||
(pop-to-buffer (get-buffer name))
|
||||
(let* ((wiki-data (assoc wiki oddmuse-wikis))
|
||||
(url (nth 1 wiki-data))
|
||||
(command (oddmuse-format-command oddmuse-rc-command))
|
||||
(coding (nth 2 wiki-data))
|
||||
(buf (get-buffer-create name))
|
||||
(coding-system-for-read coding)
|
||||
(coding-system-for-write coding))
|
||||
(set-buffer buf)
|
||||
(unless (equal name (buffer-name)) (rename-buffer name))
|
||||
(erase-buffer)
|
||||
(let ((max-mini-window-height 1))
|
||||
(oddmuse-run "Load recent changes" command buf nil))
|
||||
(oddmuse-rc-buffer)
|
||||
(set (make-local-variable 'oddmuse-wiki) wiki)))))
|
||||
|
||||
(defun oddmuse-rc-buffer ()
|
||||
"Parse current buffer as RSS 3.0 and display it correctly."
|
||||
(let (result)
|
||||
(dolist (item (cdr (split-string (buffer-string) "\n\n")));; skip first item
|
||||
(let ((data (mapcar (lambda (line)
|
||||
(when (string-match "^\\(.*?\\): \\(.*\\)" line)
|
||||
(cons (match-string 1 line)
|
||||
(match-string 2 line))))
|
||||
(split-string item "\n"))))
|
||||
(setq result (cons data result))))
|
||||
(erase-buffer)
|
||||
(dolist (item (nreverse result))
|
||||
(insert "[[" (cdr (assoc "title" item)) "]] – "
|
||||
(cdr (assoc "generator" item)) "\n"))
|
||||
(goto-char (point-min))
|
||||
(oddmuse-mode)))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-revert ()
|
||||
"Revert this oddmuse page."
|
||||
(interactive)
|
||||
(let ((current-prefix-arg 4))
|
||||
(oddmuse-edit oddmuse-wiki oddmuse-page-name)))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-insert-pagename (pagename)
|
||||
"Insert a PAGENAME of current wiki with completion."
|
||||
(interactive (list (oddmuse-read-pagename oddmuse-wiki)))
|
||||
(insert pagename))
|
||||
|
||||
;;;###autoload
|
||||
(defun emacswiki-post (&optional pagename summary)
|
||||
"Post the current buffer to the EmacsWiki.
|
||||
If this command is invoked interactively: with prefix argument,
|
||||
prompts for pagename, otherwise set pagename as basename of
|
||||
`buffer-file-name'.
|
||||
|
||||
This command is intended to post current EmacsLisp program easily."
|
||||
(interactive)
|
||||
(let* ((oddmuse-wiki "EmacsWiki")
|
||||
(oddmuse-page-name (or pagename
|
||||
(and (not current-prefix-arg)
|
||||
buffer-file-name
|
||||
(file-name-nondirectory buffer-file-name))
|
||||
(oddmuse-read-pagename oddmuse-wiki)))
|
||||
(summary (or summary (read-string "Summary: "))))
|
||||
(oddmuse-post summary)))
|
||||
|
||||
(defun oddmuse-url (wiki pagename)
|
||||
"Get the URL of oddmuse wiki."
|
||||
(condition-case v
|
||||
(concat (or (cadr (assoc wiki oddmuse-wikis)) (error)) "/" pagename)
|
||||
(error nil)))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-browse-page (wiki pagename)
|
||||
"Ask a WWW browser to load an Oddmuse page.
|
||||
WIKI is the name of the wiki as defined in `oddmuse-wikis',
|
||||
PAGENAME is the pagename of the page you want to browse."
|
||||
(interactive (oddmuse-read-wiki-and-pagename))
|
||||
(browse-url (oddmuse-url wiki pagename)))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-browse-this-page ()
|
||||
"Ask a WWW browser to load current oddmuse page."
|
||||
(interactive)
|
||||
(oddmuse-browse-page oddmuse-wiki oddmuse-page-name))
|
||||
|
||||
;;;###autoload
|
||||
(defun oddmuse-kill-url ()
|
||||
"Make the URL of current oddmuse page the latest kill in the kill ring."
|
||||
(interactive)
|
||||
(kill-new (oddmuse-url oddmuse-wiki oddmuse-page-name)))
|
||||
|
||||
(provide 'oddmuse)
|
||||
|
||||
;;; oddmuse-curl.el ends here
|
||||
51
contrib/twitter
Normal file
51
contrib/twitter
Normal file
@@ -0,0 +1,51 @@
|
||||
#!/usr/bin/perl
|
||||
# Copyright (C) 2009, 2012 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
use CGI qw/:standard/;
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
use LWP::UserAgent;
|
||||
use XML::RSS;
|
||||
|
||||
if (not param('feed')) {
|
||||
print header(),
|
||||
start_html('Description Stripping'),
|
||||
h1('Description Stripping'),
|
||||
p('Removes the description of an article if it matches the title. This is most useful for Twitter and other microblogging services.'),
|
||||
p('Example input:', code('http://api.twitter.com/1/statuses/user_timeline.rss?screen_name=kensanata')),
|
||||
start_form(-method=>'GET'),
|
||||
p('Feed: ', textfield('feed', '', 40), checkbox('Strip username'),
|
||||
submit()),
|
||||
end_form(),
|
||||
end_html();
|
||||
exit;
|
||||
}
|
||||
|
||||
$ua = LWP::UserAgent->new;
|
||||
$request = HTTP::Request->new('GET', param('feed'));
|
||||
$response = $ua->request($request);
|
||||
$data = $response->content;
|
||||
exit unless $data;
|
||||
|
||||
print header(-type=>$response->content_type);
|
||||
|
||||
$rss = new XML::RSS;
|
||||
$rss->parse($data);
|
||||
|
||||
foreach my $i (@{$rss->{items}}) {
|
||||
$i->{description} = undef if $i->{description} eq $i->{title};
|
||||
$i->{title} =~ s/^.*?: // if param('Strip username');
|
||||
}
|
||||
|
||||
print $rss->as_string;
|
||||
187
contrib/vc-oddmuse.el
Normal file
187
contrib/vc-oddmuse.el
Normal file
@@ -0,0 +1,187 @@
|
||||
;;; vc-oddmuse.el -- add VC support to oddmuse-curl
|
||||
;;
|
||||
;; Copyright (C) 2014 Alex Schroeder <alex@gnu.org>
|
||||
;;
|
||||
;; Latest version:
|
||||
;; http://git.savannah.gnu.org/cgit/oddmuse.git/plain/contrib/vc-oddmuse.el
|
||||
;; Discussion, feedback:
|
||||
;; http://www.emacswiki.org/cgi-bin/wiki/OddmuseCurl
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify it
|
||||
;; under the terms of the GNU General Public License as published by the Free
|
||||
;; Software Foundation, either version 3 of the License, or (at your option)
|
||||
;; any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
||||
;; more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License along
|
||||
;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Add the following to your init file:
|
||||
;;
|
||||
;; (add-to-list 'vc-handled-backends 'oddmuse)
|
||||
|
||||
(add-to-list 'vc-handled-backends 'oddmuse)
|
||||
|
||||
(require 'oddmuse)
|
||||
(require 'diff)
|
||||
|
||||
(defun vc-oddmuse-revision-granularity () 'file)
|
||||
|
||||
(defun vc-oddmuse-registered (file)
|
||||
"Handle files in `oddmuse-directory'."
|
||||
(string-match (concat "^" (expand-file-name oddmuse-directory))
|
||||
(file-name-directory file)))
|
||||
|
||||
(defun vc-oddmuse-state (file)
|
||||
"No idea."
|
||||
'up-to-date)
|
||||
|
||||
(defun vc-oddmuse-working-revision (file)
|
||||
"No idea")
|
||||
|
||||
(defun vc-oddmuse-checkout-model (files)
|
||||
"No locking."
|
||||
'implicit)
|
||||
|
||||
(defun vc-oddmuse-create-repo (file)
|
||||
(error "You cannot create Oddmuse wikis using Emacs."))
|
||||
|
||||
(defun vc-oddmuse-register (files &optional rev comment)
|
||||
"This always works.")
|
||||
|
||||
(defun vc-oddmuse-revert (file &optional contents-done)
|
||||
"No idea"
|
||||
nil)
|
||||
|
||||
(defvar vc-oddmuse-log-command
|
||||
"curl --silent %w\"?action=rc;showedit=1;all=1;from=1;raw=1;match=%r\""
|
||||
"Command to use for publishing index pages.
|
||||
It must print the page to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'
|
||||
%r Regular expression, URL encoded, of the pages to limit ourselves to.
|
||||
This uses the free variable `regexp'.")
|
||||
|
||||
(defun vc-oddmuse-print-log (files buffer &optional shortlog
|
||||
start-revision limit)
|
||||
"Load complete recent changes for the files."
|
||||
(let* ((wiki (or oddmuse-wiki
|
||||
(completing-read "Wiki: " oddmuse-wikis nil t)))
|
||||
(wiki-data (assoc wiki oddmuse-wikis))
|
||||
(url (nth 1 wiki-data))
|
||||
(regexp (concat
|
||||
"^(" ;; Perl regular expression!
|
||||
(mapconcat 'file-name-nondirectory files "|")
|
||||
")$"))
|
||||
(command (oddmuse-format-command vc-oddmuse-log-command))
|
||||
(coding (nth 2 wiki-data))
|
||||
(coding-system-for-read coding)
|
||||
(coding-system-for-write coding)
|
||||
(max-mini-window-height 1))
|
||||
(oddmuse-run "Getting recent changes" command buffer nil))
|
||||
;; Parse current buffer as RSS 3.0 and display it correctly.
|
||||
(save-excursion
|
||||
(with-current-buffer buffer
|
||||
(let (result)
|
||||
(dolist (item (cdr (split-string (buffer-string) "\n\n")));; skip first item
|
||||
(let ((data (mapcar (lambda (line)
|
||||
(when (string-match "^\\(.*?\\): \\(.*\\)" line)
|
||||
(cons (match-string 1 line)
|
||||
(match-string 2 line))))
|
||||
(split-string item "\n"))))
|
||||
(setq result (cons data result))))
|
||||
(dolist (item (nreverse result))
|
||||
(insert "title: " (cdr (assoc "title" item)) "\n"
|
||||
"version: " (cdr (assoc "revision" item)) "\n"
|
||||
"generator: " (cdr (assoc "generator" item)) "\n"
|
||||
"timestamp: " (cdr (assoc "last-modified" item)) "\n\n"
|
||||
" " (or (cdr (assoc "description" item)) ""))
|
||||
(fill-paragraph)
|
||||
(insert "\n\n"))
|
||||
(goto-char (point-min))))))
|
||||
|
||||
(defun vc-oddmuse-log-outgoing ()
|
||||
(error "This is not supported."))
|
||||
|
||||
(defun vc-oddmuse-log-incoming ()
|
||||
(error "This is not supported."))
|
||||
|
||||
(defvar vc-oddmuse-get-revision-command
|
||||
"curl --silent %w\"?action=browse;id=%t;revision=%o;raw=1\""
|
||||
"Command to use to get older revisions of a page.
|
||||
It must print the page to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'
|
||||
%t Page title as provided by `oddmuse-page-name'
|
||||
%o Revision to retrieve as provided by `oddmuse-revision'")
|
||||
|
||||
(defvar vc-oddmuse-get-history-command
|
||||
"curl --silent %w\"?action=history;id=%t;raw=1\""
|
||||
"Command to use to get the history of a page.
|
||||
It must print the page to stdout.
|
||||
|
||||
%? '?' character
|
||||
%w URL of the wiki as provided by `oddmuse-wikis'
|
||||
%t Page title as provided by `oddmuse-page-name'")
|
||||
|
||||
(defun vc-oddmuse-diff (files &optional rev1 rev2 buffer)
|
||||
"Report the differences for FILES."
|
||||
(setq buffer (or buffer (get-buffer-create "*vc-diff*")))
|
||||
(dolist (file files)
|
||||
(setq oddmuse-page-name (file-name-nondirectory file)
|
||||
oddmuse-wiki (or oddmuse-wiki
|
||||
(file-name-nondirectory
|
||||
(directory-file-name
|
||||
(file-name-directory file)))))
|
||||
(let* ((wiki-data (or (assoc oddmuse-wiki oddmuse-wikis)
|
||||
(error "Cannot find data for wiki %s" oddmuse-wiki)))
|
||||
(url (nth 1 wiki-data)))
|
||||
(unless rev1
|
||||
;; Since we don't know the most recent revision we have to fetch
|
||||
;; it from the server every time.
|
||||
(with-temp-buffer
|
||||
(let ((max-mini-window-height 1))
|
||||
(oddmuse-run "Determining latest revision"
|
||||
(oddmuse-format-command vc-oddmuse-get-history-command)
|
||||
(current-buffer) nil))
|
||||
(if (re-search-forward "^revision: \\([0-9]+\\)$" nil t)
|
||||
(setq rev1 (match-string 1))
|
||||
(error "Cannot determine the latest revision from the page history"))))
|
||||
(dolist (rev (list rev1 rev2))
|
||||
(when (and rev
|
||||
(not (file-readable-p (concat oddmuse-directory
|
||||
"/" oddmuse-wiki "/"
|
||||
oddmuse-page-name
|
||||
".~" rev "~"))))
|
||||
(let* ((oddmuse-revision rev)
|
||||
(command (oddmuse-format-command vc-oddmuse-get-revision-command))
|
||||
(coding (nth 2 wiki-data))
|
||||
(filename (concat oddmuse-directory "/" oddmuse-wiki "/"
|
||||
oddmuse-page-name ".~" rev "~"))
|
||||
(coding-system-for-read coding)
|
||||
(coding-system-for-write coding))
|
||||
(with-temp-buffer
|
||||
(let ((max-mini-window-height 1))
|
||||
(oddmuse-run (concat "Downloading revision " rev)
|
||||
command (current-buffer) nil))
|
||||
(write-file filename)))))
|
||||
(diff-no-select
|
||||
(if rev1
|
||||
(concat oddmuse-directory "/" oddmuse-wiki "/" oddmuse-page-name ".~" rev1 "~")
|
||||
file)
|
||||
(if rev2
|
||||
(concat oddmuse-directory "/" oddmuse-wiki "/" oddmuse-page-name ".~" rev2 "~")
|
||||
file)
|
||||
nil
|
||||
(vc-switches 'oddmuse 'diff)
|
||||
buffer))))
|
||||
|
||||
(provide 'vc-oddmuse)
|
||||
@@ -1,15 +1,18 @@
|
||||
@font-face {
|
||||
font-family: 'Garamond';
|
||||
font-style: normal;
|
||||
font-weight: 400;
|
||||
src: local('Garamond'), local('GaramondNo8'), local('EB Garamond'), local('EBGaramond'), url(https://themes.googleusercontent.com/static/fonts/ebgaramond/v4/kYZt1bJ8UsGAPRGnkXPeFdIh4imgI8P11RFo6YPCPC0.woff) format('woff');
|
||||
}
|
||||
|
||||
body, rss {
|
||||
font-family: Garamond, GaramondNo8, "Bookman Old Style", Cochin, Baskerville, serif;
|
||||
font-family: Garamond, serif;
|
||||
font-size: 16pt;
|
||||
line-height: 20pt;
|
||||
margin:1em 3em;
|
||||
padding:0;
|
||||
}
|
||||
|
||||
body.sans {
|
||||
font-family: Franklin Gothic Book, Corbel, Arial, sans-serif;
|
||||
}
|
||||
|
||||
/* headings: we can use larger sizes if we use a lighter color.
|
||||
we cannot inherit the font-family because header and footer use a narrow font. */
|
||||
|
||||
@@ -176,7 +179,6 @@ div.sister hr {
|
||||
}
|
||||
div.sister img {
|
||||
border:none;
|
||||
background-color:#ffe;
|
||||
}
|
||||
|
||||
div.near, div.definition {
|
||||
@@ -194,9 +196,6 @@ div.sidebar ul {
|
||||
|
||||
/* replacements, features */
|
||||
|
||||
del {
|
||||
color: #666;
|
||||
}
|
||||
ins {
|
||||
color: #b33;
|
||||
text-decoration: none;
|
||||
@@ -229,6 +228,12 @@ div.commentshown {
|
||||
p.comment {
|
||||
margin-bottom: 0;
|
||||
}
|
||||
div.comment {
|
||||
font-size: 14pt;
|
||||
}
|
||||
div.comment h2 {
|
||||
margin-top: 5em;
|
||||
}
|
||||
/* comment pages with username, homepage, and email subscription */
|
||||
.comment span { display: block; }
|
||||
.comment span label { display: inline-block; width: 10em; }
|
||||
@@ -381,78 +386,78 @@ div.left p + p { display:table-caption; caption-side:bottom; }
|
||||
p.table a { float:left; width:20ex; }
|
||||
p.table + p { clear:both; }
|
||||
|
||||
/* no bleeding
|
||||
@media screen {
|
||||
/* no bleeding */
|
||||
div.content, div.rc {
|
||||
overflow:hidden;
|
||||
}
|
||||
}
|
||||
} */
|
||||
|
||||
@media print {
|
||||
body {
|
||||
font-size: 12pt;
|
||||
line-height: 13pt;
|
||||
color: #000;
|
||||
background-color: #fff;
|
||||
}
|
||||
font-size: 12pt;
|
||||
line-height: 13pt;
|
||||
color: #000;
|
||||
background-color: #fff;
|
||||
}
|
||||
|
||||
/* hide all the crap */
|
||||
div.diff, div.diff+hr, div.refer, div.near, div.definition, div.sister,
|
||||
div.cal, div.footer, span.specialdays, span.gotobar, a.edit, a.number span,
|
||||
div.rc form, form.tiny, p.comment {
|
||||
display:none;
|
||||
div.rc form, form.tiny, p.comment, p#plus1, div.g-plusone {
|
||||
display:none;
|
||||
}
|
||||
a,
|
||||
a:visited,
|
||||
div.content a.near:link,
|
||||
div.content a.near:visited,
|
||||
div.content a.near:active {
|
||||
color:inherit;
|
||||
font-weight: bold;
|
||||
color:inherit;
|
||||
font-weight: bold;
|
||||
}
|
||||
div.content a.feed {
|
||||
display: none;
|
||||
display: none;
|
||||
}
|
||||
div.content a.book,
|
||||
div.content a.movie {
|
||||
text-decoration: none;
|
||||
text-decoration: none;
|
||||
}
|
||||
a cite {
|
||||
font-style: italic;
|
||||
font-style: italic;
|
||||
}
|
||||
/* no difference */
|
||||
pre, code, tt {
|
||||
font-size: inherit;
|
||||
line-height: inherit;
|
||||
font-size: inherit;
|
||||
line-height: inherit;
|
||||
}
|
||||
/* no dotted underlines */
|
||||
acronym, abbr {
|
||||
border: none;
|
||||
text-decoration: none;
|
||||
border: none;
|
||||
text-decoration: none;
|
||||
}
|
||||
/* headings */
|
||||
h1 {
|
||||
color: inherit;
|
||||
margin-top: 2em;
|
||||
}
|
||||
h2 {
|
||||
color:inherit;
|
||||
margin: 1em 0;
|
||||
font-variant: small-caps;
|
||||
}
|
||||
h3 {
|
||||
font-weight:inherit;
|
||||
font-style:italic;
|
||||
color:inherit;
|
||||
margin: 1em 0;
|
||||
}
|
||||
h1 a, h2 a, h3 a {
|
||||
color: inherit;
|
||||
}
|
||||
div.journal h1 a:visited,
|
||||
div.journal h2 a:visited,
|
||||
div.journal h3 a:visited {
|
||||
color: inherit;
|
||||
color: inherit;
|
||||
margin-top: 2em;
|
||||
}
|
||||
h2 {
|
||||
color:inherit;
|
||||
margin: 1em 0;
|
||||
font-variant: small-caps;
|
||||
}
|
||||
h3 {
|
||||
font-weight:inherit;
|
||||
font-style:italic;
|
||||
color:inherit;
|
||||
margin: 1em 0;
|
||||
}
|
||||
h1 a, h2 a, h3 a {
|
||||
color: inherit;
|
||||
}
|
||||
div.journal h1 a:visited,
|
||||
div.journal h2 a:visited,
|
||||
div.journal h3 a:visited {
|
||||
color: inherit;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -108,6 +108,35 @@ a:active {
|
||||
color:#a41;
|
||||
background-color: inherit;
|
||||
}
|
||||
.button {
|
||||
display: inline-block;
|
||||
font-size: 150%;
|
||||
cursor: pointer;
|
||||
padding: 0.3em 0.5em;
|
||||
text-shadow: 0px -1px 0px #ccc;
|
||||
background-color: #cfa;
|
||||
border: 1px solid #9d8;
|
||||
border-radius: 5px;
|
||||
box-shadow: 0px 1px 3px white inset,
|
||||
0px 1px 3px black;
|
||||
}
|
||||
.button a {
|
||||
text-decoration: none;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
/* table of contents */
|
||||
.toc {
|
||||
font-size: smaller;
|
||||
border-left: 1em solid #886;
|
||||
}
|
||||
.toc ol {
|
||||
list-style-type: none;
|
||||
padding-left: 1em;
|
||||
}
|
||||
.toc a {
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
/* images with links, captions, etc */
|
||||
div.image { display: inline; margin: 1em; font-size: 90%; text-align: center; }
|
||||
|
||||
@@ -237,9 +237,6 @@ a.near:link {
|
||||
a.near:visited {
|
||||
color:#550;
|
||||
}
|
||||
a.tag:before {
|
||||
content:"\2601\ ";
|
||||
}
|
||||
ol, ul, dl {
|
||||
padding-top:0.5em;
|
||||
}
|
||||
@@ -249,7 +246,7 @@ dd, li {
|
||||
|
||||
/* elisp files and other scripts for download */
|
||||
|
||||
p.download a {
|
||||
p.download a, a.download {
|
||||
padding: 0.5em;
|
||||
color: black;
|
||||
text-decoration: none;
|
||||
|
||||
207
css/oddmuse-2013.css
Normal file
207
css/oddmuse-2013.css
Normal file
@@ -0,0 +1,207 @@
|
||||
@font-face {
|
||||
font-family: 'Gentium Basic';
|
||||
font-style: normal;
|
||||
font-weight: 400;
|
||||
src: local('Gentium Basic'), local('GentiumBasic'), url(http://themes.googleusercontent.com/static/fonts/gentiumbasic/v5/KCktj43blvLkhOTolFn-MVhr3SzZVY8L1R-AhaesIwA.woff) format('woff');
|
||||
}
|
||||
@font-face {
|
||||
font-family: 'Gentium Basic';
|
||||
font-style: normal;
|
||||
font-weight: 700;
|
||||
src: local('Gentium Basic Bold'), local('GentiumBasic-Bold'), url(http://themes.googleusercontent.com/static/fonts/gentiumbasic/v5/2qL6yulgGf0wwgOp-UqGyKuvVGpDTHxx0YlM6XbRIFE.woff) format('woff');
|
||||
}
|
||||
@font-face {
|
||||
font-family: 'Gentium Basic';
|
||||
font-style: italic;
|
||||
font-weight: 400;
|
||||
src: local('Gentium Basic Italic'), local('GentiumBasic-Italic'), url(http://themes.googleusercontent.com/static/fonts/gentiumbasic/v5/qoFz4NSMaYC2UmsMAG3lyajIwExuvJl80GezUi4i-sM.woff) format('woff');
|
||||
}
|
||||
@font-face {
|
||||
font-family: 'Gentium Basic';
|
||||
font-style: italic;
|
||||
font-weight: 700;
|
||||
src: local('Gentium Basic Bold Italic'), local('GentiumBasic-BoldItalic'), url(http://themes.googleusercontent.com/static/fonts/gentiumbasic/v5/8N9-c_aQDJ8LbI1NGVMrwjBWbH-5CKom31QWlI8zOIM.woff) format('woff');
|
||||
}
|
||||
|
||||
body {
|
||||
background:#fff;
|
||||
padding:2% 5%;
|
||||
margin:0;
|
||||
font-family: "Gentium Basic", "Bookman Old Style", "Times New Roman", serif;
|
||||
font-size: 18pt;
|
||||
}
|
||||
|
||||
div.header h1 {
|
||||
margin-top:2ex;
|
||||
}
|
||||
|
||||
a {
|
||||
text-decoration: none;
|
||||
color: #a00;
|
||||
}
|
||||
|
||||
a:visited {
|
||||
color: #d88;
|
||||
}
|
||||
|
||||
div.header h1 a:hover, h1 a:hover, h2 a:hover, h3 a:hover, h4 a:hover,
|
||||
a:hover, span.caption a.image:hover {
|
||||
background:#fee;
|
||||
}
|
||||
|
||||
img.logo {
|
||||
float: right;
|
||||
clear: right;
|
||||
border-style:none;
|
||||
background-color:#fff;
|
||||
}
|
||||
|
||||
img {
|
||||
padding: 0.5em;
|
||||
margin: 0 1em;
|
||||
}
|
||||
|
||||
a.image:hover {
|
||||
background:inherit;
|
||||
}
|
||||
|
||||
a.image:hover img {
|
||||
background:#fee;
|
||||
}
|
||||
|
||||
/* a.definition soll aussehen wie h2 */
|
||||
h2, p a.definition {
|
||||
display:block;
|
||||
clear:both;
|
||||
}
|
||||
|
||||
/* Such Link im h1 soll nicht auffallen. */
|
||||
h1, h2, h3, h4, h1 a, h1 a:visited, p a.definition {
|
||||
color:#666;
|
||||
font-size: 30pt;
|
||||
font-weight: normal;
|
||||
margin: 4ex 0 1ex 0;
|
||||
padding: 0;
|
||||
border-bottom: 1px solid #000;
|
||||
}
|
||||
|
||||
h3, h4 {
|
||||
font-size: inherit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
div.diff {
|
||||
padding: 1em 3em;
|
||||
}
|
||||
div.old {
|
||||
background-color:#FFFFAF;
|
||||
}
|
||||
div.new {
|
||||
background-color:#CFFFCF;
|
||||
}
|
||||
div.old p, div.new p {
|
||||
padding: 0.5em 0;
|
||||
}
|
||||
div.refer { padding-left:5%; padding-right:5%; font-size:smaller; }
|
||||
div[class="content refer"] p { margin-top:2em; }
|
||||
div.content div.refer hr { display:none; }
|
||||
div.content div.refer { padding:0; font-size:medium; }
|
||||
div.content div.refer p { margin:0; }
|
||||
div.refer a { display:block; }
|
||||
table.history { border-style:none; }
|
||||
td.history { border-style:none; }
|
||||
|
||||
table.user {
|
||||
border-style: none;
|
||||
margin-left: 3em;
|
||||
}
|
||||
table.user tr td {
|
||||
border-style: none;
|
||||
padding:0.5ex 1ex;
|
||||
}
|
||||
|
||||
dt {
|
||||
font-weight:bold;
|
||||
}
|
||||
dd {
|
||||
margin-bottom:1ex;
|
||||
}
|
||||
|
||||
textarea { width:100%; height:80%; }
|
||||
textarea#summary { height: 3em; }
|
||||
|
||||
div.image span.caption {
|
||||
margin: 0 1em;
|
||||
}
|
||||
li img, img.smiley, .noborder img {
|
||||
border:none;
|
||||
padding:0;
|
||||
margin:0;
|
||||
background:#fff;
|
||||
color:#000;
|
||||
}
|
||||
/* Google +1 */
|
||||
a#plus1 img {
|
||||
background-color: #fff;
|
||||
padding: 0;
|
||||
margin: 0;
|
||||
border: none;
|
||||
}
|
||||
|
||||
div.header img, div.footer img { border:0; padding:0; margin:0; }
|
||||
|
||||
.left { float:left; }
|
||||
.right { float:right; }
|
||||
div.left .left, div.right .right {
|
||||
float:none;
|
||||
}
|
||||
.center { text-align:center; }
|
||||
|
||||
span.author {
|
||||
color: #501;
|
||||
}
|
||||
span.bar a {
|
||||
padding-right:1ex;
|
||||
}
|
||||
|
||||
.rc .author {
|
||||
color: #655;
|
||||
}
|
||||
|
||||
.rc strong {
|
||||
font-weight: normal;
|
||||
color: inherit;
|
||||
}
|
||||
|
||||
.rc li {
|
||||
position:relative;
|
||||
padding: 1ex 0;
|
||||
}
|
||||
|
||||
hr {
|
||||
border:none;
|
||||
color:black;
|
||||
background-color:#000;
|
||||
height:2px;
|
||||
margin-top:2ex;
|
||||
}
|
||||
|
||||
div.footer hr {
|
||||
height:4px;
|
||||
margin: 2em 0 1ex 0;
|
||||
}
|
||||
|
||||
pre {
|
||||
padding: 0.5em;
|
||||
margin-left: 1em;
|
||||
margin-right: 2em;
|
||||
white-space: pre;
|
||||
overflow:hidden;
|
||||
font-size: smaller;
|
||||
}
|
||||
|
||||
div.footer hr {
|
||||
clear:both;
|
||||
}
|
||||
@@ -12,7 +12,7 @@
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/anchors.pl">anchors.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Comments_on_Local_Anchor_Extension">Comments on Local Anchor Extension</a></p>';
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/anchors.pl">anchors.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Local_Anchor_Extension">Local Anchor Extension</a></p>';
|
||||
|
||||
push(@MyRules, \&AnchorsRule);
|
||||
|
||||
|
||||
169
modules/balanced-page-directories.pl
Normal file
169
modules/balanced-page-directories.pl
Normal file
@@ -0,0 +1,169 @@
|
||||
# Copyright (C) 2014 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2014 Aki Goto <tyatsumi@gmail.com>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
=head1 Balanced Page Directories
|
||||
|
||||
By default, Oddmuse disperses page data files into 27 directories
|
||||
based on the first character of the page name. The directories are "A"
|
||||
to "Z", and "other". If you use your wiki as a blog, all the pages
|
||||
starting with a date end up in "other". If your page names start with
|
||||
letters other than "A" to "Z", all the pages end up in "other". If you
|
||||
are using comment pages, all your comment pages end in "C". This can
|
||||
turn into a problem if you reach ten thousand pages and more in a
|
||||
single directory.
|
||||
|
||||
=over
|
||||
|
||||
The ext2 inode specification allows for over 100 trillion files to
|
||||
reside in a single directory, however because of the current
|
||||
linked-list directory implementation, only about 10-15 thousand files
|
||||
can realistically be stored in a single directory. – L<haversian-ga on
|
||||
09 Dec 2002 22:56
|
||||
PST|http://answers.google.com/answers/threadview?id=122241>
|
||||
|
||||
=back
|
||||
|
||||
CAUTION: When this extension is installed, your data structure I<must>
|
||||
change. Make sure you have a backup of your data directory somewhere.
|
||||
|
||||
=head2 Finding the right directory
|
||||
|
||||
On the command line, finding the right subdirectory can be a problem.
|
||||
Here's how to use md5sum. Note that the -n option to echo prevents the
|
||||
trailing newline. Its inclusion would change the checksum.
|
||||
|
||||
echo -n HomePage | md5sum | cut -c 1-2
|
||||
c1
|
||||
echo -n ホームページ | md5sum | cut -c 1-2
|
||||
10
|
||||
|
||||
=head2 $BalancedPageDirectoriesSize
|
||||
|
||||
If you have more than 2560000 pages (w00t!) you might want to set
|
||||
$BalancedPageDirectoriesSize to 3. This will give you 16× more
|
||||
directories, which should let you have 40960000 pages. Also, please
|
||||
let us know about your wiki. :)
|
||||
|
||||
=head2 Migration
|
||||
|
||||
Once you install the code, reload any page. This should trigger
|
||||
migration. No output is produced during migration. Migration is
|
||||
triggered whenever a page file isn't found but a page is found at the
|
||||
default old location. If, for example, $PageDir/c1/HomePage.pg doesn't
|
||||
exist but $PageDir/h/HomePage.pg does, and the wiki can be locked, the
|
||||
wiki is locked and migration is started.
|
||||
|
||||
=cut
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/balanced-page-directories.pl">balanced-page-directories.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Balanced_Page_Directories_Extension">Balanced Page Directories Extension</a>';
|
||||
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use File::Find qw(finddepth);
|
||||
use vars qw($BalancedPageDirectoriesSize);
|
||||
|
||||
$BalancedPageDirectoriesSize = 2;
|
||||
|
||||
*OldBalancedPageDirectoriesGetPageDirectory = *GetPageDirectory;
|
||||
*GetPageDirectory = *NewBalancedPageDirectoriesGetPageDirectory;
|
||||
|
||||
sub NewBalancedPageDirectoriesGetPageDirectory {
|
||||
my $id = shift;
|
||||
utf8::encode($id);
|
||||
return substr(md5_hex($id), 0, $BalancedPageDirectoriesSize);
|
||||
}
|
||||
|
||||
*OldBalancedPageDirectoriesOpenPage = *OpenPage;
|
||||
*OpenPage = *NewBalancedPageDirectoriesOpenPage;
|
||||
|
||||
sub NewBalancedPageDirectoriesOpenPage {
|
||||
my $id = shift;
|
||||
if (! -f GetPageFile($id)) {
|
||||
BalancedPageDirectoriesMigrate($id);
|
||||
}
|
||||
return OldBalancedPageDirectoriesOpenPage($id, @_);
|
||||
}
|
||||
|
||||
sub BalancedPageDirectoriesMigrate {
|
||||
my $id = shift;
|
||||
|
||||
# This code is called if the page file does not exist. Perhaps we
|
||||
# need to migrate? Check if the old page file exists. If it does
|
||||
# not, there is no point in migration.
|
||||
*GetPageDirectory = *OldBalancedPageDirectoriesGetPageDirectory;
|
||||
if (not -f GetPageFile($id)) {
|
||||
*GetPageDirectory = *NewBalancedPageDirectoriesGetPageDirectory;
|
||||
return;
|
||||
}
|
||||
|
||||
# Make sure we can change the data structure now.
|
||||
RequestLockOrError();
|
||||
|
||||
# Now we know that we need to migrate. The list of pages is scanned
|
||||
# using globbing.
|
||||
SetParam('refresh', 1);
|
||||
|
||||
for $id (AllPagesList()) {
|
||||
|
||||
*GetPageDirectory = *OldBalancedPageDirectoriesGetPageDirectory;
|
||||
my $page_from = GetPageFile($id);
|
||||
my $keep_from = GetKeepDir($id);
|
||||
my $lock_from = GetLockedPageFile($id);
|
||||
my $joiner_from = $JoinerDir . '/' . GetPageDirectory($username) if $JoinerDir;
|
||||
my $joiner_email_from = $JoinerEmailDir . '/' . GetPageDirectory($username) if $JoinerEmailDir;
|
||||
my $referrer_from = $RefererDir . '/' . GetPageDirectory($id) if $RefererDir;
|
||||
*GetPageDirectory = *NewBalancedPageDirectoriesGetPageDirectory;
|
||||
my $page_to = GetPageFile($id);
|
||||
my $keep_to = GetKeepDir($id);
|
||||
my $lock_to = GetLockedPageFile($id);
|
||||
my $joiner_to = $JoinerDir . '/' . GetPageDirectory($username) if $JoinerDir;
|
||||
my $joiner_email_to = $JoinerEmailDir . '/' . GetPageDirectory($username) if $JoinerEmailDir;
|
||||
my $referrer_to = $RefererDir . '/' . GetPageDirectory($id) if $RefererDir;
|
||||
|
||||
# no clobbering
|
||||
if (! -f $page_to) {
|
||||
CreatePageDir($PageDir, $id);
|
||||
rename $page_from, $page_to || ReportError("Cannot rename $page_from");
|
||||
}
|
||||
if (-f $lock_from and ! -f $lock_to) {
|
||||
rename $lock_from, $lock_to || ReportError("Cannot rename $lock_from");
|
||||
}
|
||||
if (-d $keep_from and ! -d $keep_to) {
|
||||
CreateKeepDir($KeepDir, $id);
|
||||
rename $keep_from, $keep_to || ReportError("Cannot rename $keep_from");
|
||||
}
|
||||
if ($joiner_from and -d $joiner_from and ! -d $joiner_to) {
|
||||
CreatePageDir($JoinerDir, $id);
|
||||
rename $joiner_from, $joiner_to || ReportError("Cannot rename $joiner_from");
|
||||
}
|
||||
if ($joiner_email_from and -d $joiner_email_from and ! -d $joiner_email_to) {
|
||||
CreatePageDir($JoinerEmailDir, $id);
|
||||
rename $joiner_email_from, $joiner_email_to || ReportError("Cannot rename $joiner_email_from");
|
||||
}
|
||||
if ($referrer_from and -d $referrer_from and ! -d $referrer_to) {
|
||||
CreateRefererDir($RefererDir, $id);
|
||||
rename $referrer_from, $referrer_to || ReportError("Cannot rename $referrer_from");
|
||||
}
|
||||
}
|
||||
|
||||
# Delete empty subdirectories. Actually, attempt to delete all the
|
||||
# directories, depth first. It will simply fail for the non-empty
|
||||
# directories. http://www.perlmonks.org/?node_id=520791
|
||||
for my $parent ($PageDir, $KeepDir, $JoinerDir, $JoinerEmailDir, $RefererDir) {
|
||||
next unless $parent;
|
||||
finddepth(sub { rmdir $_ if -d }, $parent);
|
||||
}
|
||||
|
||||
ReleaseLock();
|
||||
}
|
||||
157
modules/ban-contributors.pl
Normal file
157
modules/ban-contributors.pl
Normal file
@@ -0,0 +1,157 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
=head1 Ban Contributors Extension
|
||||
|
||||
This module adds "Ban contributors" to the administration page. If you
|
||||
click on it, it will list all the recent contributors to the page
|
||||
you've been looking at. Each contributor (IP or hostname) will be
|
||||
compared to the list of regular expressions on the C<BannedHosts> page
|
||||
(see C<$BannedHosts>). If the contributor is already banned, this is
|
||||
mentioned. If the contributor is not banned, you'll see a button
|
||||
allowing you to ban him or her immediately. If you click the button,
|
||||
the IP or hostname will be added to the C<BannedHosts> page for you.
|
||||
|
||||
=cut
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/ban-contributors.pl">ban-contributors.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Ban_Contributors_Extension">Ban Contributors Extension</a></p>';
|
||||
|
||||
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 IsItBanned {
|
||||
my ($it, $regexps) = @_;
|
||||
my $re = undef;
|
||||
foreach my $regexp (@$regexps) {
|
||||
eval { $re = qr/$regexp/i; };
|
||||
if (defined($re) && $it =~ $re) {
|
||||
return $it;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub DoBanHosts {
|
||||
my $id = shift;
|
||||
my $content = GetParam('content', '');
|
||||
my $host = GetParam('host', '');
|
||||
if ($content) {
|
||||
SetParam('text', GetPageContent($BannedContent)
|
||||
. $content . " # " . CalcDay($Now) . " "
|
||||
. NormalToFree($id) . "\n");
|
||||
SetParam('summary', NormalToFree($id));
|
||||
DoPost($BannedContent);
|
||||
} elsif ($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);
|
||||
SetParam('showedit', 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 '<div class="content ban">';
|
||||
foreach (sort(keys %contrib)) {
|
||||
my $name = $_;
|
||||
delete $contrib{$_}{''};
|
||||
$name .= " (" . join(", ", sort(keys(%{$contrib{$_}}))) . ")";
|
||||
if (IsItBanned($_, \@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();
|
||||
}
|
||||
|
||||
=head2 Rollback
|
||||
|
||||
If you are an admin and rolled back a single page, this extension will
|
||||
list the URLs your rollback removed (assuming that those URLs are part
|
||||
of the spam) and it will allow you to provide a regular expression
|
||||
that will be added to BannedHosts.
|
||||
|
||||
=cut
|
||||
|
||||
*OldBanContributorsWriteRcLog = *WriteRcLog;
|
||||
*WriteRcLog = *NewBanContributorsWriteRcLog;
|
||||
|
||||
sub NewBanContributorsWriteRcLog {
|
||||
my ($tag, $id, $to) = @_;
|
||||
if ($tag eq '[[rollback]]' and $id and $to > 0
|
||||
and $OpenPageName eq $id and UserIsAdmin()) {
|
||||
# we currently have the clean page loaded, so we need to reload
|
||||
# the spammed revision (there is a possible race condition here)
|
||||
my ($old) = GetTextRevision($Page{revision}-1, 1);
|
||||
my %urls = map {$_ => 1 } $old =~ /$UrlPattern/og;
|
||||
# we open the file again to force a load of the despammed page
|
||||
foreach my $url ($Page{text} =~ /$UrlPattern/og) {
|
||||
delete($urls{$url});
|
||||
}
|
||||
# we also remove any candidates that are already banned
|
||||
my @regexps = ();
|
||||
foreach (split(/\n/, GetPageContent($BannedContent))) {
|
||||
if (/^\s*([^#]\S+)/) { # all lines except empty lines and comments, trim whitespace
|
||||
push(@regexps, $1);
|
||||
}
|
||||
}
|
||||
foreach my $url (keys %urls) {
|
||||
delete($urls{$url}) if IsItBanned($url, \@regexps);
|
||||
}
|
||||
if (keys %urls) {
|
||||
print $q->p(Ts("These URLs were rolled back. Perhaps you want to add a regular expression to %s?",
|
||||
GetPageLink($BannedContent)));
|
||||
print $q->pre(join("\n", sort keys %urls));
|
||||
print GetFormStart(undef, 'get', 'ban'),
|
||||
GetHiddenValue('action', 'ban'),
|
||||
GetHiddenValue('id', $id),
|
||||
GetHiddenValue('recent_edit', 'on'),
|
||||
$q->p($q->label({-for=>'content'}, T('Regular expression:')), " ",
|
||||
$q->textfield(-name=>'content', -size=>30), " ",
|
||||
$q->submit(T('Ban!'))),
|
||||
$q->end_form();
|
||||
};
|
||||
print $q->p(T("Consider banning the hostname or IP number as well: "),
|
||||
ScriptLink('action=ban;id=' . UrlEncode($id), T('Ban contributors')));
|
||||
};
|
||||
return OldBanContributorsWriteRcLog(@_);
|
||||
}
|
||||
37
modules/ban-quick-editors.pl
Normal file
37
modules/ban-quick-editors.pl
Normal file
@@ -0,0 +1,37 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# This file must load before logbannedcontent.pl such that quick
|
||||
# editors will be logged.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/ban-quick-editors.pl">ban-quick-editors.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Banning_Quick_Editors">Banning Quick Editors</a></p>';
|
||||
|
||||
*BanQuickOldUserIsBanned = *UserIsBanned;
|
||||
*UserIsBanned = *BanQuickNewUserIsBanned;
|
||||
|
||||
sub BanQuickNewUserIsBanned {
|
||||
my $rule = BanQuickOldUserIsBanned(@_);
|
||||
if (not $rule
|
||||
and $SurgeProtection # need surge protection
|
||||
and GetParam('title')) {
|
||||
my $name = GetParam('username', $ENV{'REMOTE_ADDR'});
|
||||
my @entries = @{$RecentVisitors{$name}};
|
||||
# $entry[0] is $Now after AddRecentVisitor
|
||||
my $ts = $entries[1];
|
||||
if ($Now - $ts < 5) {
|
||||
return "fast editing spam bot";
|
||||
}
|
||||
}
|
||||
return $rule;
|
||||
}
|
||||
84
modules/banned-regexps.pl
Normal file
84
modules/banned-regexps.pl
Normal file
@@ -0,0 +1,84 @@
|
||||
# Copyright (C) 2012 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
package OddMuse;
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/banned-regexps.pl">banned-regexps.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Banning_Regular_Expressions">Banning Regular Expressions</a></p>';
|
||||
|
||||
=h1 Compatibility
|
||||
|
||||
This extension works with logbannedcontent.pl.
|
||||
|
||||
=h1 Example content for the BannedRegexps page:
|
||||
|
||||
# This page lists regular expressions that prevent the saving of a page.
|
||||
# The regexps are matched against any page or comment submitted.
|
||||
# The format is simple: # comments to the end of the line. Empty lines are ignored.
|
||||
# Everything else is a regular expression. If the regular expression is followed by
|
||||
# a comment, this is used as the explanation when a user is denied editing. If the
|
||||
# comment starts with a date, this date is not included in the explanation.
|
||||
# The date could help us decide which regular expressions to delete in the future.
|
||||
# In other words:
|
||||
# ^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$
|
||||
# Group 1 is the regular expression to use.
|
||||
# Group 4 is the explanation to use.
|
||||
|
||||
порно # 2012-12-31 Russian porn
|
||||
<a\s+href=["']?http # 2012-12-31 HTML anchor tags usually mean spam
|
||||
\[url= # 2012-12-31 bbCode links usually mean spam
|
||||
\s+https?:\S+[ .\r\n]*$ # 2012-12-31 ending with a link usually means spam
|
||||
(?s)\s+https?:\S+.*\s+https?:\S+.*\s+https?:\S+.* # 2012-12-31 three naked links usually mean spam
|
||||
|
||||
=cut
|
||||
|
||||
use vars qw($BannedRegexps);
|
||||
|
||||
$BannedRegexps = 'BannedRegexps';
|
||||
|
||||
push(@MyInitVariables, sub {
|
||||
$AdminPages{$BannedRegexps} = 1;
|
||||
$LockOnCreation{$BannedRegexps} = 1;
|
||||
$PlainTextPages{$BannedRegexps} = 1;
|
||||
});
|
||||
|
||||
*RegexpOldBannedContent = *BannedContent;
|
||||
*BannedContent = *RegexpNewBannedContent;
|
||||
|
||||
# the above also changes the mapping for the variable!
|
||||
$BannedContent = $RegexpOldBannedContent;
|
||||
|
||||
sub RegexpNewBannedContent {
|
||||
my $str = shift;
|
||||
my $rule = RegexpOldBannedContent($str, @_);
|
||||
if (not $rule) {
|
||||
foreach (split(/\n/, GetPageContent($BannedRegexps))) {
|
||||
next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
|
||||
my ($regexp, $comment, $re) = ($1, $4, undef);
|
||||
eval { $re = qr/$regexp/i; };
|
||||
if (defined($re) && $str =~ $re) {
|
||||
my $group1 = $1;
|
||||
my $explanation = ($group1
|
||||
? Tss('Regular expression "%1" matched "%2" on this page.', QuoteHtml($regexp), $group1)
|
||||
: Ts('Regular expression "%s" matched on this page.', QuoteHtml($regexp)));
|
||||
$rule = $explanation . ' '
|
||||
. ($comment ? Ts('Reason: %s.', $comment) : T('Reason unknown.')) . ' '
|
||||
. Ts('See %s for more information.', GetPageLink($BannedRegexps));
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
LogWrite($rule) if $rule and $BannedFile;
|
||||
return $rule if $rule;
|
||||
return 0;
|
||||
}
|
||||
@@ -1,22 +1,23 @@
|
||||
# Copyright (C) 2007, 2008 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2007, 2008, 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/bbcode.pl">bbcode.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/bbCode_Extension">bbCode Extension</a></p>';
|
||||
|
||||
push(@MyRules, \&bbCodeRule);
|
||||
|
||||
$RuleOrder{\&bbCodeRule} = 100; # must come after PortraitSupportRule
|
||||
|
||||
use vars qw($bbBlock);
|
||||
my %bbTitle = qw(h1 1 h2 1 h3 1 h4 1 h5 1 h6 1);
|
||||
|
||||
@@ -37,6 +38,12 @@ sub bbCodeRule {
|
||||
. qq{font-style: normal;"}); }
|
||||
elsif ($tag eq 's' or $tag eq 'strike') {
|
||||
return AddHtmlEnvironment('del'); }
|
||||
elsif ($tag eq 'tt') {
|
||||
return AddHtmlEnvironment('tt'); }
|
||||
elsif ($tag eq 'sub') {
|
||||
return AddHtmlEnvironment('sub'); }
|
||||
elsif ($tag eq 'sup') {
|
||||
return AddHtmlEnvironment('sup'); }
|
||||
elsif ($tag eq 'color') {
|
||||
return AddHtmlEnvironment('em', qq{style="color: $option; }
|
||||
. qq{font-style: normal;"}); }
|
||||
@@ -96,7 +103,8 @@ sub bbCodeRule {
|
||||
%translate = qw{b b i i u em color em size em font span url a
|
||||
quote blockquote h1 h1 h2 h2 h3 h3 h4 h4 h5 h5
|
||||
h6 h6 center div left div right div list ul
|
||||
s del strike del highlight strong};
|
||||
s del strike del sub sub sup sup highlight strong
|
||||
tt tt};
|
||||
# closing a block level element closes all elements
|
||||
if ($bbBlock eq $translate{$tag}) {
|
||||
/\G([ \t]*\n)*/cg; # eat whitespace after closing block level element
|
||||
|
||||
@@ -391,7 +391,7 @@ sub CreoleRule {
|
||||
my $is_right_justified = $3;
|
||||
|
||||
# Now that we've retrieved all numbered matches, match another lookahead.
|
||||
my $is_left_justified = m/\G(?=.*?[ \t]+\|)/;
|
||||
my $is_left_justified = m/\G(?=[^\n|]*?[ \t]+\|)/;
|
||||
my $attributes = $column_span == 1 ? '' : qq{colspan="$column_span"};
|
||||
|
||||
if ($is_left_justified and
|
||||
|
||||
@@ -1,20 +1,16 @@
|
||||
# Copyright (C) 2006 Alex Schroeder <alex@emacswiki.org>
|
||||
# Copyright (C) 2006-2013 Alex Schroeder <alex@gnu.org>
|
||||
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the
|
||||
# Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330
|
||||
# Boston, MA 02111-1307 USA
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/delete-all.pl">delete-all.pl</a></p>';
|
||||
|
||||
@@ -27,6 +23,7 @@ $DeleteAge = 172800; # 2*24*60*60
|
||||
|
||||
# All pages will be deleted after two days of inactivity!
|
||||
sub NewDelPageDeletable {
|
||||
return 1 if $Now - $Page{ts} > $DeleteAge;
|
||||
return 1 if $Now - $Page{ts} > $DeleteAge
|
||||
and not $LockOnCreation{$OpenPageName};
|
||||
return OldDelPageDeletable(@_);
|
||||
}
|
||||
|
||||
@@ -91,14 +91,14 @@ sub DespamBannedContent {
|
||||
foreach my $url (@urls) {
|
||||
if ($url =~ /($regexp)/i) {
|
||||
return Tss('Rule "%1" matched "%2" on this page.',
|
||||
QuoteHtml($regexp), $url);
|
||||
QuoteHtml($regexp), QuoteHtml($url));
|
||||
}
|
||||
}
|
||||
}
|
||||
# depends on strange-spam.pl!
|
||||
foreach (@DespamStrangeRules) {
|
||||
my $regexp = $_;
|
||||
if ($str =~ /($regexp)/) {
|
||||
if ($str =~ /($regexp)/i) {
|
||||
my $match = $1;
|
||||
$match =~ s/\n/ /g;
|
||||
return Tss('Rule "%1" matched "%2" on this page.',
|
||||
|
||||
49
modules/duckduckgo-search.pl
Normal file
49
modules/duckduckgo-search.pl
Normal file
@@ -0,0 +1,49 @@
|
||||
# Copyright (C) 2007–2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/duckduckgo-search.pl">duckduckgo-search.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Use_DuckDuckGo_For_Searches">Use DuckDuckGo For Searches</a></p>';
|
||||
|
||||
use vars qw($DuckDuckGoSearchDomain);
|
||||
|
||||
$DuckDuckGoSearchDomain = undef;
|
||||
|
||||
$Action{search} = \&DoDuckDuckGoSearch;
|
||||
|
||||
push(@MyInitVariables, \&DuckDuckGoSearchInit);
|
||||
|
||||
sub DuckDuckGoSearchInit {
|
||||
# If $ScriptName does not contain a hostname, this extension will
|
||||
# have no effect. Domain regexp based on RFC 2396 section 3.2.2.
|
||||
if (!$DuckDuckGoSearchDomain) {
|
||||
my $alpha = '[a-zA-Z]';
|
||||
my $alphanum = '[a-zA-Z0-9]';
|
||||
my $alphanumdash = '[-a-zA-Z0-9]';
|
||||
my $domainlabel = "$alphanum($alphanumdash*$alphanum)?";
|
||||
my $toplabel = "$alpha($alphanumdash*$alphanum)?";
|
||||
if ($ScriptName =~ m!^(https?://)?([^/]+\.)?($domainlabel\.$toplabel)\.?(:|/|\z)!) {
|
||||
$DuckDuckGoSearchDomain = $3;
|
||||
}
|
||||
}
|
||||
if ($DuckDuckGoSearchDomain
|
||||
and GetParam('search', undef)
|
||||
and not GetParam('action', undef)
|
||||
and not GetParam('old', 0)) {
|
||||
SetParam('action', 'search');
|
||||
}
|
||||
}
|
||||
|
||||
sub DoDuckDuckGoSearch {
|
||||
my $search = UrlEncode(GetParam('search', undef));
|
||||
print $q->redirect({-uri=>"https://www.duckduckgo.com/?q=$search+site%3A$DuckDuckGoSearchDomain"});
|
||||
}
|
||||
@@ -1,20 +1,16 @@
|
||||
# Copyright (C) 2005 Alex Schroeder <alex@emacswiki.org>
|
||||
# Copyright (C) 2005-2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the
|
||||
# Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330
|
||||
# Boston, MA 02111-1307 USA
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/dynamic-comments.pl">dynamic-comments.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Dynamic_Comments_Extension">Dynamic Comments Extension</a></p>';
|
||||
|
||||
@@ -51,7 +47,7 @@ sub DynamicCommentsNewGetPageLink {
|
||||
my $anchor = "id" . $num++;
|
||||
return qq{<a href="javascript:togglecomments('$anchor')">$title</a>}
|
||||
. '</p>' # close p before opening div
|
||||
. $q->div({-class=>commenthidden, -id=>$anchor},
|
||||
. $q->div({-class=>'commenthidden', -id=>$anchor},
|
||||
$page,
|
||||
$q->p(DynamicCommentsOldGetPageLink($id, T('Add Comment'))))
|
||||
. '<p>'; # open an empty p that will be closed in PrintAllPages
|
||||
|
||||
@@ -24,7 +24,20 @@ sub FixEncoding {
|
||||
OpenPage($id);
|
||||
my $text = $Page{text};
|
||||
utf8::decode($text);
|
||||
Save($id, $text, 'fix encoding', 1) if $text ne $Page{text};
|
||||
Save($id, $text, T('Fix character encoding'), 1) if $text ne $Page{text};
|
||||
ReleaseLock();
|
||||
ReBrowsePage($id);
|
||||
}
|
||||
|
||||
$Action{'fix-escaping'} = \&FixEscaping;
|
||||
|
||||
sub FixEscaping {
|
||||
my $id = shift;
|
||||
ValidIdOrDie($id);
|
||||
RequestLockOrError();
|
||||
OpenPage($id);
|
||||
my $text = UnquoteHtml($Page{text});
|
||||
Save($id, $text, T('Fix HTML escapes'), 1) if $text ne $Page{text};
|
||||
ReleaseLock();
|
||||
ReBrowsePage($id);
|
||||
}
|
||||
@@ -33,8 +46,12 @@ push(@MyAdminCode, \&FixEncodingMenu);
|
||||
|
||||
sub FixEncodingMenu {
|
||||
my ($id, $menuref, $restref) = @_;
|
||||
if ($id) {
|
||||
if ($id && GetParam('username')) {
|
||||
push(@$menuref,
|
||||
ScriptLink('action=fix-encoding;id=' . UrlEncode($id), T('Fix page encoding')));
|
||||
ScriptLink('action=fix-encoding;id=' . UrlEncode($id),
|
||||
T('Fix character encoding')));
|
||||
push(@$menuref,
|
||||
ScriptLink('action=fix-escaping;id=' . UrlEncode($id),
|
||||
T('Fix HTML escapes')));
|
||||
}
|
||||
}
|
||||
|
||||
60
modules/fractions.pl
Normal file
60
modules/fractions.pl
Normal file
@@ -0,0 +1,60 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/fractions.pl">fractions.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Fractions">Fractions</a></p>';
|
||||
|
||||
push(@MyRules, \&FractionsRule);
|
||||
|
||||
# usage: ^1/32
|
||||
sub FractionsRule {
|
||||
if (/\G\^([0-9]+)\/([0-9]+)/cg) {
|
||||
if ($1 == 1 and $2 == 4) { return "\¼"; }
|
||||
elsif ($1 == 1 and $2 == 2) { return "\½"; }
|
||||
elsif ($1 == 3 and $2 == 4) { return "\¾"; }
|
||||
elsif ($1 == 1 and $2 == 7) { return "\⅐"; }
|
||||
elsif ($1 == 1 and $2 == 9) { return "\⅑"; }
|
||||
elsif ($1 == 1 and $2 == 10) { return "\⅒"; }
|
||||
elsif ($1 == 1 and $2 == 3) { return "\⅓"; }
|
||||
elsif ($1 == 2 and $2 == 3) { return "\⅔"; }
|
||||
elsif ($1 == 1 and $2 == 5) { return "\⅕"; }
|
||||
elsif ($1 == 2 and $2 == 5) { return "\⅖"; }
|
||||
elsif ($1 == 3 and $2 == 5) { return "\⅗"; }
|
||||
elsif ($1 == 4 and $2 == 5) { return "\⅘"; }
|
||||
elsif ($1 == 1 and $2 == 6) { return "\⅙"; }
|
||||
elsif ($1 == 5 and $2 == 6) { return "\⅚"; }
|
||||
elsif ($1 == 1 and $2 == 8) { return "\⅛"; }
|
||||
elsif ($1 == 3 and $2 == 8) { return "\⅜"; }
|
||||
elsif ($1 == 5 and $2 == 8) { return "\⅝"; }
|
||||
elsif ($1 == 7 and $2 == 8) { return "\⅞"; }
|
||||
else {
|
||||
my $html;
|
||||
# superscripts
|
||||
for my $char (split(//, $1)) {
|
||||
if ($char eq '1') { $html .= "\¹"; }
|
||||
elsif ($char eq '2') { $html .= "\²"; }
|
||||
elsif ($char eq '3') { $html .= "\³"; }
|
||||
else { $html .= "\ȇ$char;"; }
|
||||
}
|
||||
# fraction slash
|
||||
$html .= '⁄';
|
||||
# subscripts
|
||||
for my $char (split(//, $2)) {
|
||||
$html .= "\Ȉ$char;";
|
||||
}
|
||||
return $html;
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
@@ -133,26 +133,50 @@ sub GitNewDeletePage {
|
||||
|
||||
push(@MyMaintenance, \&GitCleanup);
|
||||
|
||||
$Action{git} = \&DoGitCleanup;
|
||||
|
||||
sub DoGitCleanup {
|
||||
UserIsAdminOrError();
|
||||
print GetHeader('', 'Git', '');
|
||||
print $q->start_div({-class=>'content git'});
|
||||
RequestLockOrError();
|
||||
print $q->p(T('Main lock obtained.')), '<p>',
|
||||
T('Cleaning up git repository');
|
||||
GitCleanup();
|
||||
ReleaseLock();
|
||||
print $q->p(T('Main lock released.')), $q->end_div();
|
||||
PrintFooter();
|
||||
}
|
||||
|
||||
sub GitCleanup {
|
||||
if (-d $GitRepo) {
|
||||
print $q->p("Git cleanup starting");
|
||||
AllPagesList();
|
||||
# delete all the files including all the files starting with a dot
|
||||
opendir(DIR, $GitRepo) or ReportError("cannot open directory $GitRepo: $!");
|
||||
foreach my $file (readdir(DIR)) {
|
||||
next if $file eq '.git' or $file eq '.' or $file eq '..';
|
||||
unlink "$GitRepo/$file" or ReportError("cannot delete $GitRepo/$file: $!");
|
||||
my $name = $file;
|
||||
utf8::decode($name); # filenames are bytes
|
||||
next if $file eq '.git' or $file eq '.' or $file eq '..' or $IndexHash{$name};
|
||||
print $q->p("Deleting left over file $name");
|
||||
unlink "$GitRepo/$file" or ReportError("cannot delete $GitRepo/$name: $!");
|
||||
}
|
||||
closedir DIR;
|
||||
# write all the files again
|
||||
foreach my $id (AllPagesList()) {
|
||||
# write all the files again, just to be sure
|
||||
print $q->p("Rewriting all the files, just to be sure");
|
||||
foreach my $id (@IndexList) {
|
||||
OpenPage($id);
|
||||
WriteStringToFile("$GitRepo/$id", $Page{text});
|
||||
}
|
||||
# run git!
|
||||
chdir($GitRepo); # important for all the git commands that follow!
|
||||
# add any new files
|
||||
print $q->p("Adding new files, if any");
|
||||
GitRun('add', '.');
|
||||
# commit the new state
|
||||
GitRun('commit', '--quiet', '-a', '-m', 'maintenance job',
|
||||
"--author=Oddmuse <$GitMail>");
|
||||
print $q->p("Committing changes, if any");
|
||||
# try to protect against mysterious crashes
|
||||
print $q->pre(`$GitBinary commit --quiet -a -m 'maintenance job' --author=Oddmuse <$GitMail>` . ' ');
|
||||
print $q->p("Git done");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -50,7 +50,7 @@ sub NewGoogleCustomGetSearchLink {
|
||||
|
||||
sub NewGoogleCustomGetHeader {
|
||||
my $html = OldGoogleCustomGetHeader(@_);
|
||||
$form .= qq {
|
||||
my $form = qq {
|
||||
<!-- Google CSE Search Box Begins -->
|
||||
<form class="tiny" action="http://www.google.com/cse" id="searchbox_004774160799092323420:6-ff2s0o6yi"><p>
|
||||
<input type="hidden" name="cx" value="004774160799092323420:6-ff2s0o6yi" />
|
||||
|
||||
1131
modules/joiner.pl
Normal file
1131
modules/joiner.pl
Normal file
File diff suppressed because it is too large
Load Diff
63
modules/list-banned-content.pl
Normal file
63
modules/list-banned-content.pl
Normal file
@@ -0,0 +1,63 @@
|
||||
# Copyright (C) 2012 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/list-banned-content.pl">list-banned-content.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/BannedContent">Index Extension</a></p>';
|
||||
|
||||
$Action{'list-banned-content'} = \&DoListBannedContent;
|
||||
|
||||
sub DoListBannedContent {
|
||||
print GetHeader('', T('Banned Content'), '');
|
||||
my @pages = AllPagesList();
|
||||
my %url_regexps;
|
||||
my %text_regexps;
|
||||
foreach (split(/\n/, GetPageContent($BannedContent))) {
|
||||
next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
|
||||
$url_regexps{qr($1)} = $4;
|
||||
}
|
||||
foreach (split(/\n/, GetPageContent($BannedRegexps))) {
|
||||
next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
|
||||
$text_regexps{qr($1)} = $4;
|
||||
}
|
||||
print '<div class="content banned"><p>';
|
||||
print $BannedContent . ': ' . scalar(keys(%url_regexps)) . $q->br() . "\n";
|
||||
print $BannedRegexps . ': ' . scalar(keys(%text_regexps)) . $q->br() . "\n";
|
||||
PAGE: foreach my $id (@pages) {
|
||||
OpenPage($id);
|
||||
my @urls = $str =~ /$FullUrlPattern/go;
|
||||
foreach my $url (@urls) {
|
||||
foreach my $re (keys %url_regexps) {
|
||||
if ($url =~ $re) {
|
||||
print GetPageLink($id) . ': '
|
||||
. Tss('Rule "%1" matched "%2" on this page.', $re, $url) . ' '
|
||||
. ($url_regexps{$re}
|
||||
? Ts('Reason: %s.', $url_regexps{$re})
|
||||
: T('Reason unknown.')) . $q->br() . "\n";
|
||||
next PAGE;
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach my $re (keys %text_regexps) {
|
||||
if ($Page{text} =~ $re) {
|
||||
print GetPageLink($id) . ': '
|
||||
. Tss('Rule "%1" matched on this page.', $re) . ' '
|
||||
. ($text_regexps{$re}
|
||||
? Ts('Reason: %s.', $text_regexps{$re})
|
||||
: T('Reason unknown.')) . $q->br() . "\n";
|
||||
next PAGE;
|
||||
}
|
||||
}
|
||||
}
|
||||
print '</p></div>';
|
||||
PrintFooter();
|
||||
}
|
||||
@@ -54,7 +54,7 @@ You can change this expiry time by setting C<$LnCacheHours>.
|
||||
|
||||
=cut
|
||||
|
||||
push (MyMaintenance, \&LnMaintenance);
|
||||
push (@MyMaintenance, \&LnMaintenance);
|
||||
|
||||
sub LnMaintenance {
|
||||
if (opendir(DIR, $RssDir)) { # cleanup if they should expire anyway
|
||||
|
||||
@@ -20,25 +20,31 @@ use vars qw($BannedFile);
|
||||
|
||||
$BannedFile = "$DataDir/spammer.log" unless defined $BannedFile;
|
||||
|
||||
*OldBannedContent = *BannedContent;
|
||||
*BannedContent = *LogBannedContent;
|
||||
$BannedContent = $OldBannedContent; # copy variable
|
||||
*LogOldBannedContent = *BannedContent;
|
||||
*BannedContent = *LogNewBannedContent;
|
||||
$BannedContent = $LogOldBannedContent; # copy variable
|
||||
|
||||
sub LogBannedContent {
|
||||
sub LogNewBannedContent {
|
||||
my $str = shift;
|
||||
my $rule = OldBannedContent($str);
|
||||
if ($rule) {
|
||||
my $visitor = $ENV{'REMOTE_ADDR'};
|
||||
($sec, $min, $hr, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
|
||||
$year=$year+1900;
|
||||
$mon += 1;
|
||||
# Fix for 0's
|
||||
$mon = sprintf("%02d", $mon);
|
||||
$mday = sprintf("%02d", $mday);
|
||||
$sec = sprintf("%02d", $sec);
|
||||
$min = sprintf("%02d", $min);
|
||||
$hr = sprintf("%02d", $hr);
|
||||
AppendStringToFile($BannedFile, "$year/$mon/$mday\t$hr:$min:$sec\t$visitor: $OpenPageName - $rule\n");
|
||||
}
|
||||
my $rule = LogOldBannedContent($str);
|
||||
LogWrite($rule) if $rule;
|
||||
return $rule;
|
||||
}
|
||||
|
||||
*LogOldUserIsBanned = *UserIsBanned;
|
||||
*UserIsBanned = *LogNewUserIsBanned;
|
||||
|
||||
sub LogNewUserIsBanned {
|
||||
my $str = shift;
|
||||
my $rule = LogOldUserIsBanned($str);
|
||||
LogWrite(Ts('Host or IP matched %s', $rule)) if $rule;
|
||||
return $rule;
|
||||
}
|
||||
|
||||
sub LogWrite {
|
||||
my $rule = shift;
|
||||
my $id = $OpenPageName || GetId();
|
||||
AppendStringToFile($BannedFile,
|
||||
join("\t", TimeToW3($Now), $ENV{'REMOTE_ADDR'}, $id, $rule)
|
||||
. "\n");
|
||||
}
|
||||
|
||||
@@ -71,19 +71,21 @@ sub MacFixEncoding {
|
||||
$UseGrep = 0 if GetParam('search', '') =~ /[x{0080}-\x{fffd}]/;
|
||||
|
||||
# the rest is only necessary if using namespaces.pl
|
||||
return unless defined %Namespaces;
|
||||
while (my ($key, $value) = each %Namespaces) {
|
||||
delete $Namespaces{$key};
|
||||
return unless %Namespaces;
|
||||
my %hash = ();
|
||||
for my $key (keys %Namespaces) {
|
||||
utf8::decode($key);
|
||||
$key = NFC($key);
|
||||
$Namespaces{$key} = $NamespaceRoot . '/' . $key . '/';
|
||||
$hash{$key} = $NamespaceRoot . '/' . $key . '/';
|
||||
}
|
||||
while (my ($key, $value) = each %InterSite) {
|
||||
delete $InterSite{$key};
|
||||
%Namespaces = %hash;
|
||||
%hash = ();
|
||||
for my $key (keys %InterSite) {
|
||||
utf8::decode($key);
|
||||
$key = NFC($key);
|
||||
$InterSite{$key} = $Namespaces{$key} if $Namespaces{$key};
|
||||
$hash{$key} = $Namespaces{$key} if $Namespaces{$key};
|
||||
}
|
||||
%InterSite = %hash;
|
||||
}
|
||||
|
||||
# for drafts.pl
|
||||
|
||||
105
modules/mail.pl
105
modules/mail.pl
@@ -102,7 +102,7 @@ sub MailIsSubscribed {
|
||||
# open the DB file
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $MailFile;
|
||||
my %subscribers = map {$_=>1} split(/$FS/, $h{$id});
|
||||
my %subscribers = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($id)}));
|
||||
untie %h;
|
||||
return $subscribers{$mail};
|
||||
}
|
||||
@@ -179,13 +179,13 @@ sub MailDeletePage {
|
||||
my $id = shift;
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $MailFile;
|
||||
foreach my $mail (split(/$FS/, delete $h{$id})) {
|
||||
my %subscriptions = map {$_=>1} split(/$FS/, $h{$mail});
|
||||
foreach my $mail (split(/$FS/, UrlDecode(delete $h{UrlEncode($id)}))) {
|
||||
my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
|
||||
delete $subscriptions{$id};
|
||||
if (%subscriptions) {
|
||||
$h{$mail} = join($FS, keys %subscriptions);
|
||||
$h{UrlEncode($mail)} = UrlEncode(join($FS, keys %subscriptions));
|
||||
} else {
|
||||
delete $h{$mail};
|
||||
delete $h{UrlEncode($mail)};
|
||||
}
|
||||
}
|
||||
untie %h;
|
||||
@@ -256,7 +256,7 @@ sub MailSubscription {
|
||||
return unless $mail;
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $MailFile;
|
||||
my @result = split(/$FS/, $h{$mail});
|
||||
my @result = split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
|
||||
untie %h;
|
||||
return sort @result;
|
||||
}
|
||||
@@ -283,15 +283,16 @@ sub DoMailSubscriptionList {
|
||||
'<ul>';
|
||||
}
|
||||
require DB_File;
|
||||
|
||||
tie %h, "DB_File", $MailFile;
|
||||
foreach my $key (sort keys %h) {
|
||||
my @values = sort split(/$FS/, $h{$key});
|
||||
foreach my $encodedkey (sort keys %h) {
|
||||
my @values = sort split(/$FS/, UrlDecode($h{$encodedkey}));
|
||||
my $key = UrlDecode($encodedkey);
|
||||
if ($raw) {
|
||||
print join(' ', $key, @values) . "\n";
|
||||
} else {
|
||||
print $q->li(Ts('%s: ', MailLink($key, @values)),
|
||||
join(' ', map { MailLink($_, $key) }
|
||||
sort split(/$FS/, $h{$key})));
|
||||
join(' ', map { MailLink($_, $key) } @values));
|
||||
}
|
||||
}
|
||||
print '</ul></div>' unless $raw;
|
||||
@@ -363,16 +364,16 @@ sub MailSubscribe {
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $MailFile;
|
||||
# add to the mail entry
|
||||
my %subscriptions = map {$_=>1} split(/$FS/, $h{$mail});
|
||||
my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
|
||||
for my $id (@pages) {
|
||||
$subscriptions{$id} = 1;
|
||||
}
|
||||
$h{$mail} = join($FS, keys %subscriptions);
|
||||
$h{UrlEncode($mail)} = UrlEncode(join($FS, keys %subscriptions));
|
||||
# add to the page entries
|
||||
for my $id (@pages) {
|
||||
my %subscribers = map {$_=>1} split(/$FS/, $h{$id});
|
||||
my %subscribers = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($id)}));
|
||||
$subscribers{$mail} = 1;
|
||||
$h{$id} = join($FS, keys %subscribers);
|
||||
$h{UrlEncode($id)} = UrlEncode(join($FS, keys %subscribers));
|
||||
}
|
||||
untie %h;
|
||||
# changes made will affect how pages look
|
||||
@@ -420,53 +421,67 @@ sub MailUnsubscribe {
|
||||
return unless $mail and @pages;
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $MailFile;
|
||||
my %subscriptions = map {$_=>1} split(/$FS/, $h{$mail});
|
||||
my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
|
||||
foreach my $id (@pages) {
|
||||
delete $subscriptions{$id};
|
||||
# take care of reverse lookup
|
||||
my %subscribers = map {$_=>1} split(/$FS/, $h{$id});
|
||||
my %subscribers = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($id)}));
|
||||
delete $subscribers{$mail};
|
||||
if (%subscribers) {
|
||||
$h{$id} = join($FS, keys %subscribers);
|
||||
$h{UrlEncode($id)} = UrlEncode(join($FS, keys %subscribers));
|
||||
} else {
|
||||
delete $h{$id};
|
||||
delete $h{UrlEncode($id)};
|
||||
}
|
||||
}
|
||||
if (%subscriptions) {
|
||||
$h{$mail} = join($FS, keys %subscriptions);
|
||||
$h{UrlEncode($mail)} = UrlEncode(join($FS, keys %subscriptions));
|
||||
} else {
|
||||
delete $h{$mail} unless %subscriptions;
|
||||
delete $h{UrlEncode($mail)} unless %subscriptions;
|
||||
}
|
||||
untie %h;
|
||||
# changes made will affect how pages look
|
||||
SetParam('sub', GetParam('sub', 0) + 1);
|
||||
}
|
||||
|
||||
=head1 Sending Mail
|
||||
=head1 Migrate
|
||||
|
||||
The actual sending of emails depends on setting the appropriate
|
||||
options.
|
||||
|
||||
C<$MailServer>: This defaults to localhost. If you have Oddmuse
|
||||
installed on a full server that includes an SMTP server such as
|
||||
sendmail or postfix, you might get away with not setting any of the
|
||||
variables.
|
||||
|
||||
C<$MailUser>: Chances are you will need to authenticate before you can
|
||||
send an email via your mail server. Specify the name here.
|
||||
|
||||
C<$MailPassword>: Specify the password here.
|
||||
|
||||
C<$MailFrom>: Often mail servers know which email addresses they
|
||||
serve. If somebody else tries to use them, they'll return an error
|
||||
saying that "relaying is not allowed". If you are allowed to use the
|
||||
mail server, use this option to set the appropriate sender address.
|
||||
|
||||
Example setup:
|
||||
|
||||
$MailServer = 'smtp.google.com';
|
||||
$MailUser = 'kensanata';
|
||||
$MailPassword = '*secret*';
|
||||
$MailFrom = 'kensanata@gmail.com';
|
||||
The mailmigrate action will migrate your subscription list from the
|
||||
old format to the new format. This is necessary because these days
|
||||
because the keys and values of the DB_File are URL encoded.
|
||||
|
||||
=cut
|
||||
|
||||
$Action{'migrate-subscriptions'} = \&DoMailMigration;
|
||||
|
||||
sub DoMailMigration {
|
||||
UserIsAdminOrError();
|
||||
print GetHeader('', T('Migrating Subscriptions')),
|
||||
$q->start_div({-class=>'content mailmigrate'});
|
||||
|
||||
require DB_File;
|
||||
|
||||
tie %h, "DB_File", $MailFile;
|
||||
my $found = 0;
|
||||
foreach my $key (keys %h) {
|
||||
if (index($key, '@') != -1) {
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
if (not $found) {
|
||||
print $q->p(T('No non-migrated email addresses found, migration not necessary.'));
|
||||
} else {
|
||||
my %n;
|
||||
foreach my $key (sort keys %h) {
|
||||
my $value = $h{$key};
|
||||
my @values = sort split(/$FS/, $value);
|
||||
$n{UrlEncode($key)} = join($FS, map { UrlEncode($_) } @values);
|
||||
}
|
||||
%h = %n;
|
||||
print $q->p(Ts('Migrated %s rows.', scalar(keys %n)));
|
||||
}
|
||||
print '</div>';
|
||||
untie %h;
|
||||
PrintFooter();
|
||||
}
|
||||
|
||||
138
modules/markdown-rule.pl
Normal file
138
modules/markdown-rule.pl
Normal file
@@ -0,0 +1,138 @@
|
||||
#! /usr/bin/perl
|
||||
# Copyright (C) 2014 Alex Schroeder <alex@gnu.org>
|
||||
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/markdown-rule.pl">markdown-rule.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Markdown_Rule_Extension">Markdown Rule Extension</a></p>';
|
||||
|
||||
push(@MyRules, \&MarkdownRule);
|
||||
# Since we want this package to be a simple add-on, we try and avoid
|
||||
# all conflicts by going *last*. The use of # for numbered lists by
|
||||
# Usemod conflicts with the use of # for headings, for example.
|
||||
$RuleOrder{\&MarkdownRule} = 200;
|
||||
|
||||
# http://daringfireball.net/projects/markdown/syntax
|
||||
# https://help.github.com/articles/markdown-basics
|
||||
# https://help.github.com/articles/github-flavored-markdown
|
||||
|
||||
sub MarkdownRule {
|
||||
# atx headers
|
||||
if ($bol and m~\G(\s*\n)*(#{1,6})[ \t]*~cg) {
|
||||
my $header_depth = length($2);
|
||||
return CloseHtmlEnvironments()
|
||||
. AddHtmlEnvironment("h" . $header_depth);
|
||||
}
|
||||
# end atx header at a newline
|
||||
elsif ((InElement('h1') or InElement('h2') or InElement('h3') or
|
||||
InElement('h4') or InElement('h5') or InElement('h6'))
|
||||
and m/\G\n/cg) {
|
||||
return CloseHtmlEnvironments()
|
||||
. AddHtmlEnvironment("p");
|
||||
}
|
||||
# setext headers
|
||||
elsif ($bol and m/\G((\s*\n)*(.+?)[ \t]*\n(-+|=+)[ \t]*\n)/gc) {
|
||||
return CloseHtmlEnvironments()
|
||||
. (substr($4,0,1) eq '=' ? $q->h2($3) : $q->h3($3))
|
||||
. AddHtmlEnvironment('p');
|
||||
}
|
||||
# > blockquote
|
||||
# with continuation
|
||||
elsif ($bol and m/\G>/gc) {
|
||||
return CloseHtmlEnvironments()
|
||||
. AddHtmlEnvironment('blockquote');
|
||||
}
|
||||
# ***bold and italic***
|
||||
elsif (not InElement('strong') and not InElement('em') and m/\G\*\*\*/cg) {
|
||||
return AddHtmlEnvironment('em') . AddHtmlEnvironment('strong');
|
||||
}
|
||||
# **bold**
|
||||
elsif (m/\G\*\*/cg) {
|
||||
return AddOrCloseHtmlEnvironment('strong');
|
||||
}
|
||||
# *italic*
|
||||
elsif (m/\G\*/cg) {
|
||||
return AddOrCloseHtmlEnvironment('em');
|
||||
}
|
||||
# ~~strikethrough~~ (deleted)
|
||||
elsif (m/\G~~/cg) {
|
||||
return AddOrCloseHtmlEnvironment('del');
|
||||
}
|
||||
# - bullet list
|
||||
elsif ($bol and m/\G(\s*\n)*-[ \t]*/cg
|
||||
or InElement('li') and m/\G(\s*\n)+-[ \t]*/cg) {
|
||||
return CloseHtmlEnvironment('li')
|
||||
. OpenHtmlEnvironment('ul',1) . AddHtmlEnvironment('li');
|
||||
}
|
||||
# 1. numbered list
|
||||
elsif ($bol and m/\G(\s*\n)*\d+\.[ \t]*/cg
|
||||
or InElement('li') and m/\G(\s*\n)+\d+\.[ \t]*/cg) {
|
||||
return CloseHtmlEnvironment('li')
|
||||
. OpenHtmlEnvironment('ol',1) . AddHtmlEnvironment('li');
|
||||
}
|
||||
# beginning of a table
|
||||
elsif ($bol and !InElement('table') and m/\G\|/cg) {
|
||||
# warn pos . " beginning of a table";
|
||||
return OpenHtmlEnvironment('table',1)
|
||||
. AddHtmlEnvironment('tr')
|
||||
. AddHtmlEnvironment('th');
|
||||
}
|
||||
# end of a row and beginning of a new row
|
||||
elsif (InElement('table') and m/\G\|?\n\|/cg) {
|
||||
# warn pos . " end of a row and beginning of a new row";
|
||||
return CloseHtmlEnvironment('tr')
|
||||
. AddHtmlEnvironment('tr')
|
||||
. AddHtmlEnvironment('td');
|
||||
}
|
||||
# otherwise the table ends
|
||||
elsif (InElement('table') and m/\G\|?(\n|$)/cg) {
|
||||
# warn pos . " otherwise the table ends";
|
||||
return CloseHtmlEnvironment('table')
|
||||
. AddHtmlEnvironment('p');
|
||||
}
|
||||
# continuation of the first row
|
||||
elsif (InElement('th') and m/\G\|/cg) {
|
||||
# warn pos . " continuation of the first row";
|
||||
return CloseHtmlEnvironment('th')
|
||||
. AddHtmlEnvironment('th');
|
||||
}
|
||||
# continuation of other rows
|
||||
elsif (InElement('td') and m/\G\|/cg) {
|
||||
# warn pos . " continuation of other rows";
|
||||
return CloseHtmlEnvironment('td')
|
||||
. AddHtmlEnvironment('td');
|
||||
}
|
||||
# whitespace indentation = code
|
||||
elsif ($bol and m/\G(\s*\n)*( .+)\n?/gc) {
|
||||
my $str = substr($2, 4);
|
||||
while (m/\G( .*)\n?/gc) {
|
||||
$str .= "\n" . substr($1, 4);
|
||||
}
|
||||
return OpenHtmlEnvironment('pre',1) . $str; # always level 1
|
||||
}
|
||||
# ``` = code
|
||||
elsif ($bol and m/\G```[ \t]*\n(.*?)\n```[ \t]*(\n|$)/gcs) {
|
||||
return CloseHtmlEnvironments() . $q->pre($1)
|
||||
. AddHtmlEnvironment("p");
|
||||
}
|
||||
# [an example](http://example.com/ "Title")
|
||||
elsif (m/\G\[(.+?)\]\($FullUrlPattern(\s+"(.+?)")?\)/goc) {
|
||||
my ($text, $url, $title) = ($1, $2, $4);
|
||||
$url =~ /^($UrlProtocols)/;
|
||||
my %params;
|
||||
$params{-href} = $url;
|
||||
$params{-class} = "url $1";
|
||||
$params{-title} = $title if $title;
|
||||
return $q->a(\%params, $text);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
@@ -144,6 +144,8 @@ sub MarkupRule {
|
||||
return CloseHtmlEnvironments()
|
||||
. MarkupTag($MarkupLines{UnquoteHtml($tag)}, $str)
|
||||
. AddHtmlEnvironment('p');
|
||||
} elsif (%MarkupSingles and m/$markup_singles_re/gc) {
|
||||
return $MarkupSingles{UnquoteHtml($1)};
|
||||
} elsif (%MarkupForcedPairs and m/$markup_forced_pairs_re/gc) {
|
||||
my $tag = $1;
|
||||
my $start = $tag;
|
||||
@@ -170,8 +172,6 @@ sub MarkupRule {
|
||||
}
|
||||
} elsif (%MarkupPairs and m/$markup_pairs_re/gc) {
|
||||
return MarkupTag($MarkupPairs{UnquoteHtml($1)}, $2);
|
||||
} elsif (%MarkupSingles and m/$markup_singles_re/gc) {
|
||||
return $MarkupSingles{UnquoteHtml($1)};
|
||||
} elsif ($MarkupPairs{'/'} and m|\G~/|gc) {
|
||||
return '~/'; # fix ~/elisp/ example
|
||||
} elsif ($MarkupPairs{'/'} and m|\G(/[-A-Za-z0-9\x{0080}-\x{fffd}/]+/$words/)|gc) {
|
||||
|
||||
@@ -64,6 +64,7 @@ $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git
|
||||
'4-17' => 'Syrien: Abzug der letzten französischen Mandatstruppen 1946',
|
||||
'4-18' => 'Simbabwe: Erlangung der Unabhängigkeit',
|
||||
'4-19' => 'Jahrestag der Papstwahl (Benedikt XVI.)',
|
||||
'4-25' => 'Italien: Tag der Befreiung 1945',
|
||||
'4-26' => 'Tansania: Jahrestag der Vereinigung von Tanganjika und Sansibar 1964',
|
||||
'4-27' => 'Afghanistan: Tag der Revolution, Sierra Leone: Erlangung der Unabhängigkeit 1961, Südafrika: Tag der ersten freien Wahlen 1994, Togo: Erlangung der Unabhängigkeit 1960',
|
||||
'4-30' => 'Niederlande: Königinnentag',
|
||||
|
||||
@@ -51,6 +51,7 @@ $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git
|
||||
'4-17' => 'Syria, National Day',
|
||||
'4-18' => 'Zimbabwe, National Day',
|
||||
'4-19' => 'Sierra Leone, Republic Day',
|
||||
'4-25' => 'Italy, Liberation Day',
|
||||
'4-26' => 'Tanzania, Union Day, Israel, Independence Day',
|
||||
'4-27' => 'Federal Republic of Yugoslavia, National Day, Togo, Togolais National Day, South Africa, Freedom Day',
|
||||
'4-30' => 'The Netherlands, Official Birthday of Her Majesty Queen Beatrix',
|
||||
@@ -66,7 +67,7 @@ $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git
|
||||
'5-26' => 'Georgia, National Day',
|
||||
'5-28' => 'Ethiopia, National Day, Azerbaijan, National Day',
|
||||
'6-1' => 'Samoa, Independence Day',
|
||||
'6-2' => 'Italy, Foundation of the Republic',
|
||||
'6-2' => 'Italy, Republic Day',
|
||||
'6-4' => 'Tonga, Emancipation Day',
|
||||
'6-6' => 'Sweden, National Day',
|
||||
'6-10' => 'Portugal, Portugal Day, Camões Day and Day of Portuguese Communities',
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2003–2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
@@ -303,8 +303,12 @@ resolved to the same target (the local page), which is unexpected.
|
||||
=cut
|
||||
|
||||
|
||||
push(@IndexOptions, ['near', T('Include near pages'), 0,
|
||||
\&ListNearPages]);
|
||||
# IndexOptions must be set in MyInitVariables for translations to
|
||||
# work.
|
||||
push(@MyInitVariables, sub {
|
||||
push(@IndexOptions, ['near', T('Include near pages'), 0,
|
||||
\&ListNearPages]);
|
||||
});
|
||||
|
||||
sub ListNearPages {
|
||||
my %pages = %NearSource;
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (C) 2012 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2012–2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
@@ -81,6 +81,16 @@ sub PrivatePageMessage {
|
||||
. T('supply the password now') . ']');
|
||||
}
|
||||
|
||||
# prevent unauthorized reading
|
||||
|
||||
# If we leave $Page{revision}, PrintWikiToHTML will save the new
|
||||
# PrivatePageMessage as the new page content. If we delete
|
||||
# $Page{revision}, the text shown will be based on $NewText. If we
|
||||
# have no $Page{ts} and no $Page{text}, PageDeletable will return 1.
|
||||
# As a workaround, we set a timestamp. Aging of the page doesn't
|
||||
# matter since the text starts with #PASSWORD and therefore cannot be
|
||||
# the empty string or $DeletedPage.
|
||||
|
||||
*OldPrivatePagesOpenPage = *OpenPage;
|
||||
*OpenPage = *NewPrivatePagesOpenPage;
|
||||
|
||||
@@ -88,11 +98,14 @@ sub NewPrivatePagesOpenPage {
|
||||
OldPrivatePagesOpenPage(@_);
|
||||
if (PrivatePageLocked($Page{text})) {
|
||||
%Page = (); # reset everything
|
||||
$Page{ts} = $Now;
|
||||
$NewText = PrivatePageMessage();
|
||||
}
|
||||
return $OpenPageName;
|
||||
}
|
||||
|
||||
# prevent reading of page content by other code
|
||||
|
||||
*OldPrivatePagesGetPageContent = *GetPageContent;
|
||||
*GetPageContent = *NewPrivatePagesGetPageContent;
|
||||
|
||||
@@ -104,6 +117,8 @@ sub NewPrivatePagesGetPageContent {
|
||||
return $text;
|
||||
}
|
||||
|
||||
# prevent reading of old revisions
|
||||
|
||||
*OldPrivatePagesGetTextRevision = *GetTextRevision;
|
||||
*GetTextRevision = *NewPrivatePagesGetTextRevision;
|
||||
|
||||
@@ -115,6 +130,8 @@ sub NewPrivatePagesGetTextRevision {
|
||||
return ($text, $revision);
|
||||
}
|
||||
|
||||
# hide #PASSWORD
|
||||
|
||||
push(@MyRules, \&PrivatePageRule);
|
||||
|
||||
sub PrivatePageRule {
|
||||
@@ -124,6 +141,8 @@ sub PrivatePageRule {
|
||||
return undef;
|
||||
}
|
||||
|
||||
# prevent leaking of edit summary
|
||||
|
||||
*OldPrivatePagesGetSummary = *GetSummary;
|
||||
*GetSummary = *NewPrivatePagesGetSummary;
|
||||
|
||||
|
||||
@@ -78,7 +78,8 @@ sub NewQuestionaskerDoPost {
|
||||
print GetHeader('', T('Edit Denied'), undef, undef, '403 FORBIDDEN');
|
||||
print $q->p(T('You did not answer correctly.'));
|
||||
print GetFormStart(), QuestionaskerGetQuestion(1),
|
||||
(map { $q->hidden($_, '') }
|
||||
(map { $q->input({-type=>'hidden', -name=>$_,
|
||||
-value=>UnquoteHtml(GetParam($_))}) }
|
||||
qw(title text oldtime summary recent_edit aftertext)), $q->end_form;
|
||||
PrintFooter();
|
||||
# logging to the error log file of the server
|
||||
|
||||
@@ -231,7 +231,8 @@ sub NewReCaptchaDoPost {
|
||||
print $q->start_div({-class=>'error'});
|
||||
print $q->p(T('You did not answer correctly.'));
|
||||
print GetFormStart(), ReCaptchaGetQuestion(1),
|
||||
(map { $q->hidden($_, '') }
|
||||
(map { $q->input({-type=>'hidden', -name=>$_,
|
||||
-value=>UnquoteHtml(GetParam($_))}) }
|
||||
qw(title text oldtime summary recent_edit aftertext)), $q->end_form;
|
||||
print $q->end_div();
|
||||
PrintFooter();
|
||||
|
||||
@@ -1,20 +1,16 @@
|
||||
# Copyright (C) 2004, 2005, 2006 Alex Schroeder <alex@emacswiki.org>
|
||||
# Copyright (C) 2004-2014 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the
|
||||
# Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330
|
||||
# Boston, MA 02111-1307 USA
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/static-copy.pl">static-copy.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Static_Copy_Extension">Static Copy Extension</a></p>';
|
||||
|
||||
@@ -39,6 +35,7 @@ sub DoStatic {
|
||||
}
|
||||
CreateDir($StaticDir);
|
||||
%StaticFiles = ();
|
||||
print '<p>' unless $raw;
|
||||
StaticWriteFiles();
|
||||
print '</p>' unless $raw;
|
||||
PrintFooter() unless $raw;
|
||||
@@ -60,10 +57,20 @@ sub StaticMimeTypes {
|
||||
|
||||
sub StaticWriteFiles {
|
||||
my $raw = GetParam('raw', 0);
|
||||
my $html = GetParam('html', 0);
|
||||
local *ScriptLink = *StaticScriptLink;
|
||||
local *GetDownloadLink = *StaticGetDownloadLink;
|
||||
# get rid of subscribe link in the footer by mail.pl
|
||||
local *GetCommentForm = *MailOldGetCommentForm if defined &MailNewGetCommentForm;
|
||||
foreach my $id (AllPagesList()) {
|
||||
StaticWriteFile($id);
|
||||
if ($StaticAlways > 1
|
||||
or $html
|
||||
or PageIsUploadedFile($id)) {
|
||||
StaticWriteFile($id, $html);
|
||||
}
|
||||
}
|
||||
if ($StaticAlways > 1 or $html) {
|
||||
StaticWriteCss();
|
||||
}
|
||||
}
|
||||
|
||||
@@ -120,18 +127,22 @@ sub StaticFileName {
|
||||
}
|
||||
|
||||
sub StaticWriteFile {
|
||||
my $id = shift;
|
||||
my ($id, $html) = @_;
|
||||
my $raw = GetParam('raw', 0);
|
||||
my $html = GetParam('html', 1);
|
||||
my $filename = StaticFileName($id);
|
||||
OpenPage($id);
|
||||
my ($mimetype, $encoding, $data) = $Page{text} =~ /^\#FILE ([^ \n]+) ?([^ \n]*)\n(.*)/s;
|
||||
return unless $html or $data;
|
||||
open(F,"> $StaticDir/$filename") or ReportError(Ts('Cannot write %s', $filename));
|
||||
my ($mimetype, $encoding, $data) =
|
||||
$Page{text} =~ /^\#FILE ([^ \n]+) ?([^ \n]*)\n(.*)/s;
|
||||
open(F,"> $StaticDir/$filename")
|
||||
or ReportError(Ts('Cannot write %s', $filename));
|
||||
if ($data) {
|
||||
binmode(F);
|
||||
StaticFile($id, $mimetype, $data);
|
||||
} elsif ($html) {
|
||||
binmode(F, ':utf8');
|
||||
StaticHtml($id);
|
||||
} else {
|
||||
print "no data for ";
|
||||
}
|
||||
close(F);
|
||||
chmod 0644,"$StaticDir/$filename";
|
||||
@@ -141,7 +152,6 @@ sub StaticWriteFile {
|
||||
sub StaticFile {
|
||||
my ($id, $type, $data) = @_;
|
||||
require MIME::Base64;
|
||||
binmode(F);
|
||||
print F MIME::Base64::decode($data);
|
||||
}
|
||||
|
||||
@@ -200,7 +210,8 @@ EOT
|
||||
print F $q->div({-class=>'content'}, PageHtml($id)); # this reopens the page currently open
|
||||
# footer
|
||||
my $links = '';
|
||||
if ($OpenPageName !~ /^$CommentsPrefix/) { # fails if $CommentsPrefix is empty!
|
||||
if ($OpenPageName !~ /^$CommentsPrefix/ # fails if $CommentsPrefix is empty!
|
||||
and $IndexHash{$CommentsPrefix . $OpenPageName}) {
|
||||
$links .= ScriptLink(UrlEncode($CommentsPrefix . $OpenPageName),
|
||||
T('Comments on this page'));
|
||||
}
|
||||
@@ -216,6 +227,21 @@ EOT
|
||||
print F '</body></html>';
|
||||
}
|
||||
|
||||
sub StaticWriteCss {
|
||||
my $css;
|
||||
if ($StyleSheet) {
|
||||
$css = GetRaw($StyleSheet);
|
||||
}
|
||||
if (not $css and $IndexHash{$StyleSheetPage}) {
|
||||
$css = GetPageContent($StyleSheetPage);
|
||||
}
|
||||
if (not $css) {
|
||||
$css = GetRaw('http://www.oddmuse.org/default.css');
|
||||
}
|
||||
WriteStringToFile("$StaticDir/static.css", $css) if $css;
|
||||
chmod 0644,"$StaticDir/static.css";
|
||||
}
|
||||
|
||||
*StaticFilesOldSave = *Save;
|
||||
*Save = *StaticFilesNewSave;
|
||||
|
||||
|
||||
@@ -127,10 +127,10 @@ sub NewTagSave { # called within a lock!
|
||||
# an encoded string; the alternative would be to use a form of
|
||||
# freeze and thaw.
|
||||
foreach my $tag (keys %tag) {
|
||||
my %file = map {$_=>1} split(/$FS/, $h{$tag});
|
||||
my %file = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($tag)}));
|
||||
if (not $file{$id}) {
|
||||
$file{$id} = 1;
|
||||
$h{$tag} = join($FS, keys %file);
|
||||
$h{UrlEncode($tag)} = UrlEncode(join($FS, keys %file));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -138,16 +138,16 @@ sub NewTagSave { # called within a lock!
|
||||
# tags used. This allows us to delete the references that no longer
|
||||
# show up without looping through them all. The files are indexed
|
||||
# with a starting underscore because this is an illegal tag name.
|
||||
foreach my $tag (split (/$FS/, $h{"_$id"})) {
|
||||
foreach my $tag (split (/$FS/, UrlDecode($h{UrlEncode("_$id")}))) {
|
||||
# If the tag we're looking at is no longer listed, we have work to
|
||||
# do.
|
||||
if (!$tag{$tag}) {
|
||||
my %file = map {$_=>1} split(/$FS/, $h{$tag});
|
||||
my %file = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($tag)}));
|
||||
delete $file{$id};
|
||||
if (%file) {
|
||||
$h{$tag} = join($FS, keys %file);
|
||||
$h{UrlEncode($tag)} = UrlEncode(join($FS, keys %file));
|
||||
} else {
|
||||
delete $h{$tag};
|
||||
delete $h{UrlEncode($tag)};
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -155,9 +155,9 @@ sub NewTagSave { # called within a lock!
|
||||
# Store the new reverse lookup of all the tags used on the current
|
||||
# page. If no more tags appear on this page, delete the entry.
|
||||
if (%tag) {
|
||||
$h{"_$id"} = join($FS, keys %tag);
|
||||
$h{UrlEncode("_$id")} = UrlEncode(join($FS, keys %tag));
|
||||
} else {
|
||||
delete $h{"_$id"};
|
||||
delete $h{UrlEncode("_$id")};
|
||||
}
|
||||
|
||||
untie %h;
|
||||
@@ -183,18 +183,18 @@ sub NewTagDeletePage { # called within a lock!
|
||||
# For each file in our hash, we have a reverse lookup of all the
|
||||
# tags used. This allows us to delete the references that no longer
|
||||
# show up without looping through them all.
|
||||
foreach my $tag (split (/$FS/, $h{"_$id"})) {
|
||||
my %file = map {$_=>1} split(/$FS/, $h{$tag});
|
||||
foreach my $tag (split (/$FS/, UrlDecode($h{UrlEncode("_$id")}))) {
|
||||
my %file = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($tag)}));
|
||||
delete $file{$id};
|
||||
if (%file) {
|
||||
$h{$tag} = join($FS, keys %file);
|
||||
$h{UrlEncode($tag)} = UrlEncode(join($FS, keys %file));
|
||||
} else {
|
||||
delete $h{$tag};
|
||||
delete $h{UrlEncode($tag)};
|
||||
}
|
||||
}
|
||||
|
||||
# Delete reverse lookup entry.
|
||||
delete $h{"_$id"};
|
||||
delete $h{UrlEncode("_$id")};
|
||||
untie %h;
|
||||
|
||||
# Return any error codes?
|
||||
@@ -217,8 +217,7 @@ sub TagFind {
|
||||
tie %h, "DB_File", $TagFile;
|
||||
my %page;
|
||||
foreach my $tag (@tags) {
|
||||
foreach my $id (split(/$FS/, $h{lc($tag)})) {
|
||||
utf8::decode($id);
|
||||
foreach my $id (split(/$FS/, UrlDecode($h{UrlEncode(lc($tag))}))) {
|
||||
$page{$id} = 1;
|
||||
}
|
||||
}
|
||||
@@ -292,20 +291,20 @@ sub TagCloud {
|
||||
my $max = 0;
|
||||
my $min = 0;
|
||||
my %count = ();
|
||||
foreach my $tag (grep !/^_/, keys %h) {
|
||||
$count{$tag} = split(/$FS/, $h{$tag});
|
||||
$max = $count{$tag} if $count{$tag} > $max;
|
||||
$min = $count{$tag} if not $min or $count{$tag} < $min;
|
||||
foreach my $encoded_tag (grep !/^_/, keys %h) {
|
||||
$count{$encoded_tag} = split(/$FS/, UrlDecode($h{$encoded_tag}));
|
||||
$max = $count{$encoded_tag} if $count{$encoded_tag} > $max;
|
||||
$min = $count{$encoded_tag} if not $min or $count{$encoded_tag} < $min;
|
||||
}
|
||||
untie %h;
|
||||
foreach my $tag (sort keys %count) {
|
||||
my $n = $count{$tag};
|
||||
print $q->a({-href => "$ScriptName?search=tag:" . UrlEncode($tag),
|
||||
foreach my $encoded_tag (sort keys %count) {
|
||||
my $n = $count{$encoded_tag};
|
||||
print $q->a({-href => "$ScriptName?search=tag:" . $encoded_tag,
|
||||
-title => $n,
|
||||
-style => 'font-size: '
|
||||
. int(80+120*($max == $min ? 1 : ($n-$min)/($max-$min)))
|
||||
. '%;',
|
||||
}, NormalToFree($tag)), T(' ... ');
|
||||
}, NormalToFree(UrlDecode($encoded_tag))), T(' ... ');
|
||||
}
|
||||
print '</p></div>';
|
||||
PrintFooter();
|
||||
@@ -352,21 +351,18 @@ sub DoTagsReindex {
|
||||
$Page{text} =~ m/\[\[tag:$FreeLinkPattern\|([^]|]+)\]\]/g);
|
||||
next unless %tag;
|
||||
|
||||
# utf8::encode($id);
|
||||
# back to bytes for the following installation:
|
||||
# This is perl, v5.10.1 (*) built for i486-linux-gnu-thread-multi
|
||||
# (with 56 registered patches, see perl -V for more detail)
|
||||
# (FIXME: get rid of this call, or explain why no UTF-8 can be stored in %h)
|
||||
|
||||
# For each tag we list the files tagged. Add the current file for
|
||||
# all tags.
|
||||
foreach my $tag (keys %tag) {
|
||||
$h{$tag} = $h{$tag} ? $h{$tag} . $FS . $id : $id;
|
||||
my $encoded_tag = UrlEncode($tag);
|
||||
$h{$encoded_tag} = $h{$encoded_tag}
|
||||
? $h{$encoded_tag} . UrlEncode($FS . $id)
|
||||
: UrlEncode($id);
|
||||
}
|
||||
|
||||
# Store the reverse lookup of all the tags used on the current
|
||||
# page.
|
||||
$h{"_$id"} = join($FS, keys %tag);
|
||||
$h{UrlEncode("_$id")} = UrlEncode(join($FS, keys %tag));
|
||||
}
|
||||
|
||||
untie %h;
|
||||
@@ -391,8 +387,8 @@ sub TagList {
|
||||
# open the DB file
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $TagFile;
|
||||
foreach my $id (sort keys %h) {
|
||||
print "$id: " . join(', ', split(/$FS/, $h{$id})) . "\n";
|
||||
foreach my $id (sort map { UrlDecode($_) } keys %h) {
|
||||
print "$id: " . join(', ', split(/$FS/, UrlDecode($h{UrlEncode($id)}))) . "\n";
|
||||
}
|
||||
untie %h;
|
||||
}
|
||||
@@ -416,7 +412,7 @@ sub TagsMenu {
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2005, 2009 Alex Schroeder <alex@gnu.org>
|
||||
Copyright (C) 2005, 2009, 2013 Alex Schroeder <alex@gnu.org>
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
|
||||
@@ -170,6 +170,10 @@ $TexRe = qr{$TexRe};
|
||||
|
||||
push(@MyRules, \&TexRule);
|
||||
|
||||
# use of -- conflicts with MarkupRules such as the following:
|
||||
# $MarkupForcedPairs{'--'} = 'del';
|
||||
$RuleOrder{\&TexRule} = 160;
|
||||
|
||||
sub TexRule {
|
||||
if (m/\G$TexRe/goc) {
|
||||
return $Tex{$1};
|
||||
|
||||
@@ -25,7 +25,9 @@ $defaultTZ = 'UTC';
|
||||
$CookieParameters{time} = '';
|
||||
|
||||
sub TZget {
|
||||
my $dt = DateTime->from_epoch(epoch=>shift);
|
||||
my $ts = shift;
|
||||
$ts = 0 if not defined($ts);
|
||||
my $dt = DateTime->from_epoch(epoch=>$ts);
|
||||
my $tz = GetParam('time', '');
|
||||
# setting time= will use the (defined) empty string, so avoid that
|
||||
$tz = $defaultTZ unless $tz;
|
||||
|
||||
98
modules/toc-js.pl
Normal file
98
modules/toc-js.pl
Normal file
@@ -0,0 +1,98 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
package OddMuse;
|
||||
|
||||
$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/toc-js.pl">toc-js.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Javascript_Table_of_Contents_Extension">Javascript Table of Contents Extension</a></p>';
|
||||
|
||||
use vars qw($TocOutlineLibrary);
|
||||
|
||||
$TocOutlineLibrary = 'http://h5o.googlecode.com/files/outliner.0.5.0.62.js';
|
||||
|
||||
# Add the dojo script to edit pages.
|
||||
push (@MyInitVariables, \&TocScript);
|
||||
|
||||
sub TocScript {
|
||||
# cookie is not initialized yet so we cannot use GetParam
|
||||
# Cross browser compatibility: http://www.tek-tips.com/faqs.cfm?fid=4862
|
||||
# HTML5 Outlines: http://blog.tremily.us/posts/HTML5_outlines/
|
||||
# Required library: http://code.google.com/p/h5o/
|
||||
if (GetParam('action', 'browse') eq 'browse') {
|
||||
$HtmlHeaders .= qq{
|
||||
<script type="text/javascript" src="$TocOutlineLibrary"></script>
|
||||
<script type="text/javascript">
|
||||
|
||||
function addOnloadEvent(fnc) {
|
||||
if ( typeof window.addEventListener != "undefined" )
|
||||
window.addEventListener( "load", fnc, false );
|
||||
else if ( typeof window.attachEvent != "undefined" ) {
|
||||
window.attachEvent( "onload", fnc );
|
||||
}
|
||||
else {
|
||||
if ( window.onload != null ) {
|
||||
var oldOnload = window.onload;
|
||||
window.onload = function ( e ) {
|
||||
oldOnload( e );
|
||||
window[fnc]();
|
||||
};
|
||||
}
|
||||
else
|
||||
window.onload = fnc;
|
||||
}
|
||||
}
|
||||
|
||||
var initToc=function() {
|
||||
|
||||
var outline = HTML5Outline(document.body);
|
||||
if (outline.sections.length == 1) {
|
||||
outline.sections = outline.sections[0].sections;
|
||||
}
|
||||
|
||||
if (outline.sections.length > 1
|
||||
|| outline.sections.length == 1
|
||||
&& outline.sections[0].sections.length > 0) {
|
||||
|
||||
var toc = document.getElementById('toc');
|
||||
|
||||
if (!toc) {
|
||||
var divs = document.getElementsByTagName('div');
|
||||
for (var i = 0; i < divs.length; i++) {
|
||||
if (divs[i].getAttribute('class') == 'toc') {
|
||||
toc = divs[i];
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (!toc) {
|
||||
var h2 = document.getElementsByTagName('h2')[0];
|
||||
if (h2) {
|
||||
toc = document.createElement('div');
|
||||
toc.setAttribute('class', 'toc');
|
||||
h2.parentNode.insertBefore(toc, h2);
|
||||
}
|
||||
}
|
||||
|
||||
if (toc) {
|
||||
var html = outline.asHTML(true);
|
||||
toc.innerHTML = html;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
addOnloadEvent(initToc);
|
||||
</script>
|
||||
};
|
||||
}
|
||||
}
|
||||
@@ -142,7 +142,7 @@ Go!
|
||||
(minor)
|
||||
(次要的)
|
||||
rollback
|
||||
回復
|
||||
回滾
|
||||
new
|
||||
新增
|
||||
All changes for %s
|
||||
@@ -168,13 +168,13 @@ Revision %s
|
||||
Contributors to %s
|
||||
編寫 %s 的作者
|
||||
Missing target for rollback.
|
||||
找不到要回復的目標
|
||||
找不到要回滾的目標
|
||||
Target for rollback is too far back.
|
||||
要回復的目標已太久以前了。
|
||||
要回滾的目標已太久以前了。
|
||||
A username is required for ordinary users.
|
||||
需使用普通用戶名稱
|
||||
Rolling back changes
|
||||
回復修改
|
||||
回滾修改
|
||||
The two revisions are the same.
|
||||
二個版本相同
|
||||
Editing not allowed for %s.
|
||||
@@ -182,9 +182,9 @@ Editing not allowed for %s.
|
||||
Rollback of %s would restore banned content.
|
||||
|
||||
Rollback to %s
|
||||
回復至 %s
|
||||
回滾至 %s
|
||||
%s rolled back
|
||||
%s 已回復
|
||||
%s 已回滾
|
||||
to %s
|
||||
到 %s
|
||||
Index of all pages
|
||||
@@ -644,7 +644,7 @@ SPAM 廣告頁面
|
||||
Cannot find revision %s.
|
||||
無法取得版本 %s 。
|
||||
Revert to revision %1: %2
|
||||
回復至版本 %1: %2
|
||||
回滾至版本 %1: %2
|
||||
Marked as %s.
|
||||
標記為 %s 。
|
||||
Cannot find unspammed revision.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -672,7 +672,7 @@ ordinary changes
|
||||
normale Änderungen
|
||||
Matching page names:
|
||||
Übereinstimmende Seitennamen:
|
||||
Fix page encoding
|
||||
Fix character encoding
|
||||
Zeichenkodierung korrigieren
|
||||
no summary available
|
||||
keine Zusammenfassug vorhanden
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -498,7 +498,7 @@ Interlinks:
|
||||
Too many connections by %s
|
||||
Demasiadas conexiones por %s
|
||||
Please do not fetch more than %1 pages in %2 seconds.
|
||||
Por favor, no visites más de %1 páginas en %s segundos.
|
||||
Por favor, no visites más de %1 páginas en %2 segundos.
|
||||
Check whether the web server can create the directory %s and whether it can create files in it.
|
||||
Comprueba si el servidor web puede crear el directorio %s y si puede crear archivos en él.
|
||||
Copy one of the following stylesheets to %s:
|
||||
|
||||
@@ -148,9 +148,12 @@ sub send_file {
|
||||
warn "No content for $title\n" unless $item->{description};
|
||||
my $link = $item->{link};
|
||||
my $sub = "$root?action=subscriptions";
|
||||
print $fh qq(<p>Visit <a href="$link">$title</a>)
|
||||
my $text = qq(<p>Visit <a href="$link">$title</a>)
|
||||
. qq( or <a href="$sub">manage your subscriptions</a>.</p><hr />)
|
||||
. $item->{description};
|
||||
# prevent 501 Syntax error - line too long
|
||||
$text =~ s/<(p|h[1-6]|[duo]l|pre|li|form|div|blockquote|hr|table|tr)>/\r\n<$1>/gi;
|
||||
print $fh $text;
|
||||
$fh->close;
|
||||
foreach my $subscriber (@subscribers) {
|
||||
send_mail($subscriber, $title, $fh);
|
||||
|
||||
44
t/balanced-page-directories.t
Normal file
44
t/balanced-page-directories.t
Normal file
@@ -0,0 +1,44 @@
|
||||
# Copyright (C) 2014 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 10;
|
||||
use utf8; # tests contain UTF-8 characters and it matters
|
||||
|
||||
clear_pages();
|
||||
|
||||
update_page('HomePage', 'Das ist ein Ei.');
|
||||
ok(-f GetPageFile('HomePage'), 'page file');
|
||||
|
||||
update_page('HomePage', 'This is an egg.');
|
||||
ok(-f GetKeepFile('HomePage', 1), 'keep file');
|
||||
|
||||
update_page('ホームページ', 'これが卵です。');
|
||||
ok(-f GetPageFile('ホームページ'), 'Japanese page file');
|
||||
|
||||
update_page($StyleSheetPage, '/* nothing to see */', '', 0, 1);
|
||||
ok(-f GetPageFile($StyleSheetPage), 'locked page file');
|
||||
ok(-f GetLockedPageFile($StyleSheetPage), 'page lock');
|
||||
|
||||
add_module('balanced-page-directories.pl');
|
||||
|
||||
test_page(get_page('HomePage'), 'This is an egg.');
|
||||
ok(-f GetKeepFile('HomePage', 1), 'keep file');
|
||||
test_page(get_page('ホームページ'), 'これが卵です。');
|
||||
ok(-f GetLockedPageFile($StyleSheetPage), 'page lock');
|
||||
|
||||
# create a new page
|
||||
test_page(update_page('サイトマップ', '日本語ユーザーに向けて'),
|
||||
'日本語ユーザーに向けて');
|
||||
55
t/ban-contributors.t
Normal file
55
t/ban-contributors.t
Normal file
@@ -0,0 +1,55 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 21;
|
||||
|
||||
clear_pages();
|
||||
|
||||
add_module('ban-contributors.pl');
|
||||
$localhost = 'pyrobombus';
|
||||
$ENV{'REMOTE_ADDR'} = $localhost;
|
||||
|
||||
update_page('Test', 'insults');
|
||||
test_page_negative(get_page('action=admin id=Test'), 'Ban contributors');
|
||||
test_page(get_page('action=admin id=Test pwd=foo'), 'Ban contributors');
|
||||
test_page(get_page('action=ban id=Test pwd=foo'), 'pyrobombus', 'Ban!');
|
||||
test_page(get_page('action=ban id=Test host=pyrobombus pwd=foo'),
|
||||
'Location: http://localhost/wiki.pl/BannedHosts');
|
||||
test_page(get_page('BannedHosts'), 'pyrobombus', 'Test');
|
||||
|
||||
clear_pages();
|
||||
add_module('ban-contributors.pl');
|
||||
|
||||
update_page('Test', 'no spam');
|
||||
ok(get_page('action=browse id=Test raw=2')
|
||||
=~ /(\d+) # Do not delete this line/,
|
||||
'raw=2 returns timestamp');
|
||||
$to = $1;
|
||||
ok($to, 'timestamp stored');
|
||||
sleep(1);
|
||||
|
||||
update_page('Test', "http://spam/amoxil/ http://spam/doxycycline/");
|
||||
test_page(get_page("action=rollback id=Test to=$to pwd=foo"),
|
||||
'Rolling back changes', 'These URLs were rolled back',
|
||||
'amoxil', 'doxycycline', 'Consider banning the hostname');
|
||||
test_page(get_page("action=ban id=Test content=amoxil pwd=foo"),
|
||||
'Location: http://localhost/wiki.pl/BannedContent');
|
||||
test_page(get_page('BannedContent'), 'amoxil', 'Test');
|
||||
update_page('Test', "http://spam/amoxil/ http://spam/doxycycline/");
|
||||
$page = get_page("action=rollback id=Test to=$to pwd=foo");
|
||||
test_page($page, 'Rolling back changes', 'These URLs were rolled back',
|
||||
'doxycycline');
|
||||
test_page_negative($page, 'amoxil');
|
||||
34
t/ban-quick-editors.t
Normal file
34
t/ban-quick-editors.t
Normal file
@@ -0,0 +1,34 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 3;
|
||||
|
||||
clear_pages();
|
||||
|
||||
# switch it back on again
|
||||
AppendStringToFile($ConfigFile, "\$SurgeProtection = 1;\n");
|
||||
# make sure the visitors.log is filled
|
||||
$ENV{'REMOTE_ADDR'} = '127.0.0.1';
|
||||
|
||||
add_module('ban-quick-editors.pl');
|
||||
|
||||
get_page('Test');
|
||||
test_page(update_page('Test', 'cannot edit'),
|
||||
'This page is empty');
|
||||
test_page($redirect, 'Editing not allowed');
|
||||
sleep 5;
|
||||
test_page(update_page('Test', 'edit succeeded'),
|
||||
'edit succeeded');
|
||||
32
t/comments.t
32
t/comments.t
@@ -1,24 +1,20 @@
|
||||
# Copyright (C) 2006 Alex Schroeder <alex@emacswiki.org>
|
||||
# Copyright (C) 2006–2014 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the
|
||||
# Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330
|
||||
# Boston, MA 02111-1307 USA
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 35;
|
||||
use Test::More tests => 36;
|
||||
clear_pages();
|
||||
|
||||
AppendStringToFile($ConfigFile, "\$CommentsPrefix = 'Comments on ';\n");
|
||||
@@ -89,11 +85,17 @@ test_page(get_page('Comments_on_Yadda'), 'This is my comment\.', '-- Alex');
|
||||
test_page(get_page('action=rc raw=1'), 'title: Comments on Yadda',
|
||||
'description: This is my comment.', 'generator: Alex');
|
||||
|
||||
# homepage
|
||||
get_page('title=Comments_on_Yadda', 'aftertext=This%20is%20another%20comment.',
|
||||
'username=Alex', 'homepage=http%3a%2f%2fwww%2eoddmuse%2eorg%2f');
|
||||
xpath_test(get_page('Comments_on_Yadda'),
|
||||
'//p[contains(text(),"This is my comment.")]',
|
||||
'//a[@class="url http outside"][@href="http://www.oddmuse.org/"][text()="Alex"]');
|
||||
# variant without protocol
|
||||
get_page('title=Comments_on_Yadda', 'aftertext=This%20is%20another%20comment.',
|
||||
'username=Berta', 'homepage=alexschroeder%2ech');
|
||||
xpath_test(get_page('Comments_on_Yadda'),
|
||||
'//a[@class="url http outside"][@href="http://alexschroeder.ch"][text()="Berta"]');
|
||||
|
||||
my $textarea = '//textarea[@name="aftertext"][@id="aftertext"]';
|
||||
xpath_test(get_page('Comments_on_Yadda'), $textarea);
|
||||
|
||||
@@ -50,15 +50,15 @@ test_page(get_page('action=browse id=HomePage username=Alex'),
|
||||
SKIP: {
|
||||
|
||||
eval { require LWP::UserAgent; };
|
||||
skip "LWP::UserAgent not installed", 5 if $@;
|
||||
skip "LWP::UserAgent not installed", 7 if $@;
|
||||
|
||||
eval { require HTTP::Cookies; };
|
||||
skip "HTTP::Cookies not installed", 5 if $@;
|
||||
skip "HTTP::Cookies not installed", 7 if $@;
|
||||
|
||||
my $wiki = 'http://localhost/cgi-bin/wiki.pl';
|
||||
my $ua = LWP::UserAgent->new;
|
||||
my $response = $ua->get("$wiki?action=version");
|
||||
skip("No wiki running at $wiki", 5)
|
||||
skip("No wiki running at $wiki", 7)
|
||||
unless $response->is_success;
|
||||
|
||||
$ua = LWP::UserAgent->new;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
#!/usr/bin/env perl
|
||||
# Copyright (C) 2006, 2007, 2008, 2009 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2006-2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
@@ -16,7 +16,7 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 107;
|
||||
use Test::More tests => 108;
|
||||
clear_pages();
|
||||
|
||||
add_module('creole.pl');
|
||||
@@ -159,6 +159,8 @@ CamelCaseLink
|
||||
~ does not escape whitespace
|
||||
foo ~bar
|
||||
foo bar
|
||||
| 1|foo |
|
||||
<table class="user"><tr><td align="right">1</td><td>foo </td></tr></table>
|
||||
EOT
|
||||
|
||||
xpath_run_tests(split('\n',<<'EOT'));
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
#!/usr/bin/env perl
|
||||
# Copyright (C) 2008 Weakish Jiang <weakish@gmail.com>
|
||||
# Copyright (C) 2009 Alex Schroeder <alex@gnu.com>
|
||||
# Copyright (C) 2009-2013 Alex Schroeder <alex@gnu.com>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License version 2 as
|
||||
@@ -56,8 +56,6 @@ H<sub>2</sub>O
|
||||
<dl><dt><strong>dt1</strong></dt><dd>dd1</dd></dl>
|
||||
; {{{dt1}}}\n:dd1
|
||||
<dl><dt><code>dt1</code></dt><dd>dd1</dd></dl>
|
||||
;[[http://www.toto.com|toto]] \n :Site of my friend Toto
|
||||
<dl><dt><a class="url http outside" href="http://www.toto.com">toto</a></dt><dd>Site of my friend Toto</dd></dl>
|
||||
; {{{[[http://www.toto.com|toto]]}}} \n : Site of my friend Toto
|
||||
<dl><dt><code>[[http://www.toto.com|toto]]</code></dt><dd>Site of my friend Toto</dd></dl>
|
||||
; what if we have {{{[[http://example.com]]}}} and {{{[[ftp://example.org]]}}}\n: And {{{[[http://example.net]]}}}
|
||||
@@ -75,6 +73,8 @@ H<sub>2</sub>O
|
||||
EOT
|
||||
|
||||
xpath_run_tests(split('\n',<<'EOT'));
|
||||
;[[http://www.toto.com|toto]] \n :Site of my friend Toto
|
||||
//dl/dt[a[@class="url http outside"][@href="http://www.toto.com"][text()="toto"]]/following-sibling::dd[text()="Site of my friend Toto"]
|
||||
##http://example.com##
|
||||
//code/a[@class="url http"][@href="http://example.com"][text()="http://example.com"]
|
||||
##[[wiki page]] will work##
|
||||
|
||||
8
t/css.t
8
t/css.t
@@ -24,13 +24,13 @@ clear_pages();
|
||||
|
||||
# Default
|
||||
xpath_test(get_page('HomePage'),
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/oddmuse.css"]');
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/default.css"]');
|
||||
|
||||
# StyleSheetPage
|
||||
update_page('css', "em { font-weight: bold; }", 'some css', 0, 1);
|
||||
$page = get_page('HomePage');
|
||||
negative_xpath_test($page,
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/oddmuse.css"]');
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/default.css"]');
|
||||
xpath_test($page,
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://localhost/wiki.pl?action=browse;id=css;raw=1;mime-type=text/css"]');
|
||||
|
||||
@@ -38,7 +38,7 @@ xpath_test($page,
|
||||
AppendStringToFile($ConfigFile, "\$StyleSheet = 'http://example.org/test.css';\n");
|
||||
$page = get_page('HomePage');
|
||||
negative_xpath_test($page,
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/oddmuse.css"]',
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/default.css"]',
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://localhost/wiki.pl?action=browse;id=css;raw=1;mime-type=text/css"]');
|
||||
xpath_test($page,
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://example.org/test.css"]');
|
||||
@@ -46,7 +46,7 @@ xpath_test($page,
|
||||
# Parameter
|
||||
$page = get_page('action=browse id=HomePage css=http://example.org/my.css');
|
||||
negative_xpath_test($page,
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/oddmuse.css"]',
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://www.oddmuse.org/default.css"]',
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://localhost/wiki.pl?action=browse;id=css;raw=1;mime-type=text/css"]',
|
||||
'//link[@type="text/css"][@rel="stylesheet"][@href="http://example.org/test.css"]');
|
||||
xpath_test($page,
|
||||
|
||||
38
t/diff.t
38
t/diff.t
@@ -1,27 +1,31 @@
|
||||
# Copyright (C) 2006 Alex Schroeder <alex@emacswiki.org>
|
||||
# Copyright (C) 2006-2013 Alex Schroeder <alex@gnu.org>
|
||||
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the
|
||||
# Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330
|
||||
# Boston, MA 02111-1307 USA
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 21;
|
||||
use Test::More tests => 25;
|
||||
use utf8;
|
||||
|
||||
clear_pages();
|
||||
|
||||
# encoding stuff
|
||||
update_page('dash', "- en ‘dash’\n");
|
||||
update_page('dash', "- en ‘dash’\n— em “dash”\n");
|
||||
test_page(get_page('action=browse diff=1 id=dash'),
|
||||
'<div class="new"><p>> — em “dash”</p></div>',
|
||||
'- en ‘dash’ — em “dash”');
|
||||
|
||||
# Highlighting differences
|
||||
update_page('xah', "When we judge people in society, often, we can see people's true nature not by the official defenses and behaviors, but by looking at the statistics (past records) of their behavior and the circumstances it happens.\n"
|
||||
. "For example, when we look at the leader in human history. Great many of them have caused thousands and millions of intentional deaths. Some of these leaders are hated by many, yet great many of them are adored and admired and respected... (ok, i'm digressing...)\n");
|
||||
@@ -54,11 +58,13 @@ test_page(get_page('action=history id=david'),
|
||||
'Revision 4', 'fourth revision');
|
||||
# using diffrevision=1 will make sure that the third revision is not shown
|
||||
xpath_test(get_page('action=browse diff=1 id=david revision=2 diffrevision=1'),
|
||||
'//p[@class="summary"][text()="Summary: second revision"]',
|
||||
'//div[@class="old"]/p/strong[text()="first"]',
|
||||
'//div[@class="new"]/p/strong[text()="second"]',
|
||||
'//div[@class="content browse"]/p[text()="this is the second revision"]');
|
||||
# check with cache = 0
|
||||
xpath_test(get_page('action=browse diff=1 id=david revision=2 diffrevision=1 cache=0'),
|
||||
'//p[@class="summary"][text()="Summary: second revision"]',
|
||||
'//div[@class="old"]/p/strong[text()="first"]',
|
||||
'//div[@class="new"]/p/strong[text()="second"]',
|
||||
'//div[@class="content browse"]/p[text()="this is the second revision"]');
|
||||
|
||||
55
t/duckduckgo-search.t
Normal file
55
t/duckduckgo-search.t
Normal file
@@ -0,0 +1,55 @@
|
||||
# Copyright (C) 2007–2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 9;
|
||||
clear_pages();
|
||||
|
||||
add_module('duckduckgo-search.pl');
|
||||
|
||||
DuckDuckGoSearchInit();
|
||||
is($DuckDuckGoSearchDomain, undef, 'No $ScriptName');
|
||||
|
||||
$DuckDuckGoSearchDomain = undef;
|
||||
$ScriptName = 'http://www.communitywiki.org/en';
|
||||
DuckDuckGoSearchInit();
|
||||
is($DuckDuckGoSearchDomain, 'communitywiki.org', $ScriptName);
|
||||
|
||||
$DuckDuckGoSearchDomain = undef;
|
||||
$ScriptName = 'http://www.community.org:80/';
|
||||
DuckDuckGoSearchInit();
|
||||
is($DuckDuckGoSearchDomain, 'community.org', $ScriptName);
|
||||
|
||||
$DuckDuckGoSearchDomain = undef;
|
||||
$ScriptName = 'http://www.communitywiki.org';
|
||||
DuckDuckGoSearchInit();
|
||||
is($DuckDuckGoSearchDomain, 'communitywiki.org', $ScriptName);
|
||||
|
||||
$DuckDuckGoSearchDomain = undef;
|
||||
$ScriptName = 'http://emacswiki.org/cgi-bin/emacs';
|
||||
DuckDuckGoSearchInit();
|
||||
is($DuckDuckGoSearchDomain, 'emacswiki.org', $ScriptName);
|
||||
|
||||
$DuckDuckGoSearchDomain = undef;
|
||||
$ScriptName = 'http://localhost/wiki.pl';
|
||||
DuckDuckGoSearchInit();
|
||||
isnt($DuckDuckGoSearchDomain, 'localhost', $ScriptName);
|
||||
|
||||
test_page(get_page('search=alex'),
|
||||
'<title>Wiki: Search for: alex</title>');
|
||||
AppendStringToFile($ConfigFile, "\$ScriptName = 'http://emacswiki.org/';\n");
|
||||
test_page(get_page('search=alex'),
|
||||
'Status: 302',
|
||||
'Location: https://www.duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');
|
||||
@@ -84,7 +84,7 @@ AppendStringToFile($ConfigFile, "use utf8;\n\$CookieParameters{ärger} = 1;\n");
|
||||
test_page(get_page('action=browse id=Test %C3%A4rger=hallo'),
|
||||
'Set-Cookie: Wiki=%C3%A4rger%251ehallo');
|
||||
|
||||
# this causes wide character in print somehow? otherwise harmless
|
||||
# create a test page to test the output in various ways
|
||||
test_page(update_page("Russian", "Русский Hello"),
|
||||
"Русский");
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (C) 2012 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2012–2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
@@ -14,16 +14,31 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 8;
|
||||
use Test::More tests => 22;
|
||||
use utf8; # tests contain UTF-8 characters and it matters
|
||||
|
||||
clear_pages();
|
||||
add_module('fix-encoding.pl');
|
||||
|
||||
# make sure the menu only shows up if it applies to a page
|
||||
# make sure no menu shows if no page is provided
|
||||
|
||||
test_page_negative(get_page('action=admin'), 'action=fix-encoding');
|
||||
test_page(get_page('action=admin id=foo'), 'action=fix-encoding;id=foo');
|
||||
|
||||
# make sure no menu shows up if the page does not exists
|
||||
|
||||
test_page_negative(get_page('action=admin id=foo'),
|
||||
'action=fix-encoding;id=foo',
|
||||
'action=fix-escaping;id=foo');
|
||||
|
||||
# make sure nothing is saved if the page does not exist
|
||||
|
||||
test_page(get_page('action=fix-encoding id=Example'),
|
||||
'Location: http://localhost/wiki.pl/Example');
|
||||
|
||||
test_page(get_page('action=fix-escaping id=Example'),
|
||||
'Location: http://localhost/wiki.pl/Example');
|
||||
|
||||
test_page_negative(get_page('action=rc all=1 showedit=1'), 'fix');
|
||||
|
||||
# make sure nothing is saved if there is no change
|
||||
|
||||
@@ -33,11 +48,28 @@ test_page(update_page('Example', 'Pilgerstätte für die Göttin'),
|
||||
test_page(get_page('action=fix-encoding id=Example'),
|
||||
'Location: http://localhost/wiki.pl/Example');
|
||||
|
||||
test_page_negative(get_page('action=rc showedit=1'), 'fix encoding');
|
||||
test_page(get_page('action=fix-escaping id=Example'),
|
||||
'Location: http://localhost/wiki.pl/Example');
|
||||
|
||||
# here is an actual page you need to fix
|
||||
test_page_negative(get_page('action=rc all=1 showedit=1'),
|
||||
'Fix Character encoding');
|
||||
|
||||
test_page(update_page('Example', 'Pilgerstätte für die Göttin', 'borked encoding'),
|
||||
# the menu doesn't show up if the page exists
|
||||
|
||||
test_page_negative(get_page('action=admin id=Example'),
|
||||
'action=fix-encoding;id=Example',
|
||||
'action=fix-escaping;id=Example');
|
||||
|
||||
# the menu does show up if the page exists and a username is set
|
||||
|
||||
test_page(get_page('action=admin id=Example username=Alex'),
|
||||
'action=fix-encoding;id=Example',
|
||||
'action=fix-escaping;id=Example');
|
||||
|
||||
# here is an actual page with a character encoding error you need to fix
|
||||
|
||||
test_page(update_page('Example', 'Pilgerstätte für die Göttin',
|
||||
'borked encoding'),
|
||||
'Pilgerstätte für die Göttin');
|
||||
|
||||
test_page(get_page('action=fix-encoding id=Example'),
|
||||
@@ -45,3 +77,21 @@ test_page(get_page('action=fix-encoding id=Example'),
|
||||
|
||||
test_page(get_page('Example'),
|
||||
'Pilgerstätte für die Göttin');
|
||||
|
||||
test_page(get_page('action=rc showedit=1'),
|
||||
'Fix character encoding');
|
||||
|
||||
# here is an actual page with an HTML escaping error you need to fix
|
||||
|
||||
test_page(update_page('Example', '&lt;b&gt;bold&lt;/b&gt;',
|
||||
'borked escaping'),
|
||||
'&lt;b&gt;bold&lt;/b&gt;');
|
||||
|
||||
test_page(get_page('action=fix-escaping id=Example'),
|
||||
'Location: http://localhost/wiki.pl/Example');
|
||||
|
||||
test_page(get_page('Example'),
|
||||
'<b>bold</b>');
|
||||
|
||||
test_page(get_page('action=rc showedit=1'),
|
||||
'Fix HTML escapes');
|
||||
|
||||
13
t/journal3.t
13
t/journal3.t
@@ -1,4 +1,4 @@
|
||||
# Copyright (C) 2011 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2011–2014 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
@@ -14,7 +14,7 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 34;
|
||||
use Test::More tests => 35;
|
||||
|
||||
clear_pages();
|
||||
|
||||
@@ -38,7 +38,7 @@ test_page($page, '2011-12-17', '2011-12-16', '2011-12-15',
|
||||
test_page_negative($page, '2011-12-12', '2011-12-11', '2011-12-10',
|
||||
'2011-12-09', '2011-12-08');
|
||||
|
||||
xpath_test($page, '//a[@href="http://localhost/wiki.pl?action=more;num=5;regexp=^\d\d\d\d-\d\d-\d\d;search=;mode=;offset=5"][text()="More..."]');
|
||||
xpath_test($page, '//a[@href="http://localhost/wiki.pl?action=more;num=5;regexp=%5e%5cd%5cd%5cd%5cd-%5cd%5cd-%5cd%5cd;search=;mode=;offset=5"][text()="More..."]');
|
||||
|
||||
# check that the link for more actually works
|
||||
|
||||
@@ -60,7 +60,12 @@ test_page($page, '2011-12-13', '2011-12-12', '2011-12-11',
|
||||
'2011-12-10', '2011-12-09');
|
||||
xpath_test($page, '//a[text()="More..."]');
|
||||
|
||||
# one las check
|
||||
# one last check
|
||||
|
||||
xpath_test_negative(get_page("action=more num=5 offset=6 "),
|
||||
'//a[text()="More..."]');
|
||||
|
||||
# check for unescaped URL
|
||||
|
||||
$page = update_page('Plus', "Using a plus:\n\n<journal 5 \"^.+\">");
|
||||
xpath_test($page, '//a[text()="More..."][@href="http://localhost/wiki.pl?action=more;num=5;regexp=%5e.%2b;search=;mode=;offset=5"]');
|
||||
|
||||
29
t/mail.t
29
t/mail.t
@@ -15,13 +15,40 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 45;
|
||||
use utf8; # tests contain UTF-8 characters and it matters
|
||||
use Test::More tests => 52;
|
||||
|
||||
clear_pages();
|
||||
|
||||
AppendStringToFile($ConfigFile, "\$CommentsPrefix = 'Comments on ';\n");
|
||||
|
||||
add_module('mail.pl');
|
||||
Init(); # set $MailFile
|
||||
|
||||
# tests migration
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $MailFile;
|
||||
$h{'alex@gnu.org'} = 'Unregelmässige_Spieler';
|
||||
$h{'Unregelmässige_Spieler'} = 'alex@gnu.org';
|
||||
untie %h;
|
||||
|
||||
test_page(get_page('action=migrate-subscriptions pwd=foo'),
|
||||
'Migrated 2 rows');
|
||||
test_page(get_page('action=migrate-subscriptions pwd=foo'),
|
||||
'migration not necessary');
|
||||
|
||||
test_page(get_page('action=subscriptionlist pwd=foo raw=1'),
|
||||
'alex@gnu.org Unregelmässige_Spieler',
|
||||
'Unregelmässige_Spieler alex@gnu.org');
|
||||
|
||||
# make a test with a character that cannot be Latin-1 encoded
|
||||
# ★ #x2605 => xE2 #x98 #x85 in UTF-8
|
||||
test_page(get_page('title=Comments_on_%e2%98%85 aftertext=test username=Alex '
|
||||
. 'mail=berta@example.com notify=1'),
|
||||
'Set-Cookie:.*mail%251eberta%40example.com');
|
||||
test_page(get_page('action=subscriptionlist pwd=foo raw=1'),
|
||||
'Comments_on_★ berta@example.com',
|
||||
'berta@example.com Comments_on_★');
|
||||
|
||||
# edit page
|
||||
$page = get_page('Comments_on_Foo');
|
||||
|
||||
97
t/markdown-rule.t
Normal file
97
t/markdown-rule.t
Normal file
@@ -0,0 +1,97 @@
|
||||
#!/usr/bin/env perl
|
||||
# Copyright (C) 2014 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 34;
|
||||
clear_pages();
|
||||
|
||||
add_module('markdown-rule.pl');
|
||||
|
||||
# ApplyRules strips trailing newlines, so write tests accordingly.
|
||||
run_tests(split(/\n/,<<'EOT'));
|
||||
1. one
|
||||
<ol><li>one</li></ol>
|
||||
2. one
|
||||
2. one
|
||||
1. one\n2. two
|
||||
<ol><li>one</li><li>two</li></ol>
|
||||
1. one\n\n2. two
|
||||
<ol><li>one</li><li>two</li></ol>
|
||||
- one
|
||||
<ul><li>one</li></ul>
|
||||
- one\n-- Alex
|
||||
<ul><li>one</li><li>- Alex</li></ul>
|
||||
- one\n\n- Alex
|
||||
<ul><li>one</li><li>Alex</li></ul>
|
||||
this is ***bold italic*** yo!
|
||||
this is <em><strong>bold italic</strong></em> yo!
|
||||
this is **bold**
|
||||
this is <strong>bold</strong>
|
||||
**bold**
|
||||
<strong>bold</strong>
|
||||
*italic*
|
||||
<em>italic</em>
|
||||
foo\nbar
|
||||
foo bar
|
||||
foo\n===\nbar
|
||||
<h2>foo</h2><p>bar</p>
|
||||
foo\n---\nbar
|
||||
<h3>foo</h3><p>bar</p>
|
||||
foo\n=== bar
|
||||
foo === bar
|
||||
foo\n=\nbar
|
||||
<h2>foo</h2><p>bar</p>
|
||||
# foo
|
||||
<h1>foo</h1>
|
||||
## foo
|
||||
<h2>foo</h2>
|
||||
### foo
|
||||
<h3>foo</h3>
|
||||
#### foo
|
||||
<h4>foo</h4>
|
||||
##### foo
|
||||
<h5>foo</h5>
|
||||
###### foo
|
||||
<h6>foo</h6>
|
||||
####### foo
|
||||
<h6># foo</h6>
|
||||
## foo ##
|
||||
<h2>foo ##</h2>
|
||||
bar\n##foo\nbar
|
||||
bar <h2>foo</h2><p>bar</p>
|
||||
```\nfoo\n```\nbar
|
||||
<pre>foo</pre><p>bar</p>
|
||||
```\nfoo\n```
|
||||
<pre>foo</pre>
|
||||
```\nfoo\n``` bar
|
||||
``` foo ``` bar
|
||||
|a|b|\n|c|d|\nbar
|
||||
<table><tr><th>a</th><th>b</th></tr><tr><td>c</td><td>d</td></tr></table><p>bar</p>
|
||||
|a|b|\n|c|d|
|
||||
<table><tr><th>a</th><th>b</th></tr><tr><td>c</td><td>d</td></tr></table>
|
||||
|a
|
||||
<table><tr><th>a</th></tr></table>
|
||||
foo ~~bar~~
|
||||
foo <del>bar</del>
|
||||
EOT
|
||||
|
||||
xpath_run_tests(split('\n',<<'EOT'));
|
||||
[an example](http://example.com/ "Title")
|
||||
//a[@class="url http"][@href="http://example.com/"][@title="Title"][text()="an example"]
|
||||
[an example](http://example.com/)
|
||||
//a[@class="url http"][@href="http://example.com/"][text()="an example"]
|
||||
EOT
|
||||
@@ -14,7 +14,7 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 73;
|
||||
use Test::More tests => 77;
|
||||
use utf8; # tests contain UTF-8 characters and it matters
|
||||
|
||||
clear_pages();
|
||||
@@ -41,6 +41,15 @@ test_page(get_page('action=browse id=Test ns=Muu'),
|
||||
'<title>Wiki Muu: Test</title>',
|
||||
'<p>Mooo!</p>');
|
||||
|
||||
# history
|
||||
xpath_test(get_page('action=history id=Test ns=Muu'),
|
||||
'//table[@class="history"]/tr/td/a[text()="Revision 1"]',
|
||||
'//h1[text()="History of Test"]');
|
||||
|
||||
test_page(get_page('action=history id=Test ns=Muu raw=1'),
|
||||
"link: http://localhost/wiki.pl/Muu\\?action=history;id=Test;raw=1\n",
|
||||
"link: http://localhost/wiki.pl/Muu/Test\n");
|
||||
|
||||
# search
|
||||
$page = get_page('/Muu?search=Mooo raw=1');
|
||||
test_page($page, 'description: Mooo!');
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (C) 2012 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2012–2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
@@ -14,7 +14,7 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 28;
|
||||
use Test::More tests => 29;
|
||||
|
||||
clear_pages();
|
||||
add_module('private-pages.pl');
|
||||
@@ -32,6 +32,10 @@ test_page_negative(update_page('Privat', "#PASSWORD foo\nCats have secrets.\n",
|
||||
'Cats have secrets');
|
||||
test_page($redirect, 'Status: 302');
|
||||
|
||||
# is not deleted by maintenance job
|
||||
my $page = get_page('action=maintain');
|
||||
test_page($page, 'Privat');
|
||||
|
||||
# read it with password
|
||||
my $page = get_page('action=browse id=Privat pwd=foo');
|
||||
test_page_negative($page, 'This page is password protected');
|
||||
|
||||
@@ -55,3 +55,7 @@ test_page(update_page('test', 'answer new question', undef, undef, undef,
|
||||
test_page(get_page('Comments_on_test'),
|
||||
'label for="username"',
|
||||
'say hi');
|
||||
|
||||
# test for corruption of Unicode text
|
||||
update_page('Umlaute', '<Schröder>');
|
||||
test_page($redirect, '<Schröder>')
|
||||
|
||||
20
t/rc.t
20
t/rc.t
@@ -1,4 +1,4 @@
|
||||
# Copyright (C) 2006, 2007, 2008, 2009 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2006–20013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
@@ -15,7 +15,7 @@
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 83;
|
||||
use Test::More tests => 86;
|
||||
|
||||
clear_pages();
|
||||
|
||||
@@ -23,14 +23,22 @@ clear_pages();
|
||||
# with nothing appropriate in them.
|
||||
|
||||
test_page(get_page('action=rc raw=1'), 'title: Wiki');
|
||||
WriteStringToFile($RcFile, "1${FS}test${FS}${FS}test${FS}${FS}${FS}1${FS}${FS}\n");
|
||||
# ts, id, minor, summary, host, username, revision, languages, cluster
|
||||
WriteStringToFile($RcFile, "1${FS}test${FS}${FS}test${FS}127.0.0.1${FS}${FS}1${FS}${FS}\n");
|
||||
test_page_negative(get_page('action=rc raw=1'), 'title: test');
|
||||
test_page(get_page('action=rc raw=1 from=1'), 'title: Wiki', 'title: test',
|
||||
'description: test', 'link: http://localhost/wiki.pl/test',
|
||||
'description: test', 'generator: 127.0.0.1',
|
||||
'link: http://localhost/wiki.pl/test',
|
||||
'last-modified: 1970-01-01T00:00Z', 'revision: 1');
|
||||
ok(rename($RcFile, $RcOldFile), "renamed $RcFile to $RcOldFile");
|
||||
|
||||
test_page(get_page('action=maintain'),
|
||||
'Moving part of the RecentChanges log file',
|
||||
'Moving 1 log entries');
|
||||
|
||||
# make sure it was anonymized
|
||||
test_page(get_page('action=rc raw=1 from=1'), 'title: Wiki', 'title: test',
|
||||
'description: test', 'link: http://localhost/wiki.pl/test',
|
||||
'description: test', 'generator: Anonymous',
|
||||
'link: http://localhost/wiki.pl/test',
|
||||
'last-modified: 1970-01-01T00:00Z', 'revision: 1');
|
||||
|
||||
# Test that newlines are in fact stripped
|
||||
|
||||
38
t/recaptcha.t
Normal file
38
t/recaptcha.t
Normal file
@@ -0,0 +1,38 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
# General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 5;
|
||||
use utf8; # test data is UTF-8 and it matters
|
||||
|
||||
clear_pages();
|
||||
$ENV{'REMOTE_ADDR'}='127.0.0.1';
|
||||
add_module('recaptcha.pl');
|
||||
|
||||
# The recaptcha module used to corrupt UTF-8 encoding and HTML
|
||||
# escaping.
|
||||
|
||||
# non-existing page and no permission
|
||||
test_page(get_page('title=SandBox text="<b>K%C3%BChlschrank</b>"'),
|
||||
'Status: 403',
|
||||
'<b>Kühlschrank</b>');
|
||||
# update it as an admin
|
||||
test_page(update_page('SandBox', '<b>Kühlschrank</b>', undef, undef, 1),
|
||||
'<b>Kühlschrank</b>');
|
||||
# existing page and no permission
|
||||
test_page(get_page('title=SandBox text="<b>K%C3%BChlschrank-test</b>"'),
|
||||
'Status: 403',
|
||||
'<b>Kühlschrank-test</b>');
|
||||
50
t/rollback-extras.t
Normal file
50
t/rollback-extras.t
Normal file
@@ -0,0 +1,50 @@
|
||||
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, either version 3 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 3;
|
||||
|
||||
# simple, single page rollback
|
||||
|
||||
# ($ts, $id, $minor, $summary, $host, $username, $revision, $languages, $cluster)
|
||||
# ($ts, '[[rollback]]', $to, $page)
|
||||
|
||||
clear_pages();
|
||||
WriteStringToFile ($RcFile, "1Aone1\n"); # original
|
||||
AppendStringToFile($RcFile, "2Atwo2\n"); # to be rolled back
|
||||
AppendStringToFile($RcFile, "3A0one3\n"); # back to the original
|
||||
AppendStringToFile($RcFile, "3[[rollback]]1A\n"); # rollback marker
|
||||
|
||||
local $/ = "\n"; # undef in test.pl
|
||||
|
||||
my @lines = GetRcLines(1);
|
||||
is(scalar(@lines), 1, "starting situation contains just one line");
|
||||
is($lines[0][0], 3, "simple rollback starts with 3");
|
||||
|
||||
AppendStringToFile($RcFile, "4Athree4\n");
|
||||
|
||||
# print "GetRcLines\n";
|
||||
# for my $line (GetRcLines(1)) {
|
||||
# my ($ts, $id, $minor, $summary) = @$line;
|
||||
# print "$ts, $id, $minor, $summary\n";
|
||||
# }
|
||||
|
||||
SetParam('all', 1);
|
||||
my @lines = GetRcLines(1);
|
||||
is(scalar(@lines), 4, "using all=1, see all four major revisions");
|
||||
|
||||
|
||||
# This could be an interesting test framework.
|
||||
|
||||
@@ -70,8 +70,8 @@ update_page('NicePage', 'Evil content.', 'vandal one');
|
||||
update_page('OtherPage', 'Other evil content.', 'another vandal');
|
||||
update_page('NicePage', 'Bad content.', 'vandal two');
|
||||
update_page('EvilPage', 'Spam!', 'vandal three');
|
||||
update_page('AnotherEvilPage', 'More Spam!', 'vandal four');
|
||||
update_page('AnotherEvilPage', 'Still More Spam!', 'vandal five');
|
||||
update_page('AnotherEvilPage', 'More Minor Spam!', 'vandal four', 1);
|
||||
update_page('AnotherEvilPage', 'Still More Minor Spam!', 'vandal five', 1);
|
||||
update_page('MinorPage', 'Ramtatam', 'testerror', 1);
|
||||
|
||||
test_page(get_page('NicePage'), 'Bad content');
|
||||
|
||||
@@ -1,21 +1,22 @@
|
||||
# Copyright (C) 2007, 2008, 2009 Alex Schroeder <alex@gnu.org>
|
||||
# Copyright (C) 2007–2014 Alex Schroeder <alex@gnu.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
# This program is free software: you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by the Free
|
||||
# Software Foundation, either version 3 of the License, or (at your option)
|
||||
# any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
||||
# more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
require 't/test.pl';
|
||||
package OddMuse;
|
||||
use Test::More tests => 16;
|
||||
use utf8;
|
||||
use Test::More tests => 36;
|
||||
clear_pages();
|
||||
|
||||
add_module('static-copy.pl');
|
||||
@@ -111,7 +112,40 @@ xpath_test(update_page('HomePage', "Static: [[image:Trogs]]"),
|
||||
. '[@src="/static/Trogs.svgz"]'
|
||||
. '[@alt="Trogs"]');
|
||||
|
||||
# Make sure spaces are translated to underscores (fixed in image.pl)
|
||||
# delete the static pages and regenerate it
|
||||
ok(unlink("$DataDir/static/Trogs.svgz"), "Deleted $DataDir/static/Trogs.svgz");
|
||||
ok(unlink("$DataDir/static/Logo.png"), "Deleted $DataDir/static/Logo.png");
|
||||
|
||||
# StaticWriteFiles must write uploaded files only (since $StaticAlways = 1)
|
||||
$page = get_page('action=static raw=1 pwd=foo');
|
||||
test_page($page, "Trogs", "Logo"); # Remember, a rollback has restored Logo.png
|
||||
test_page_negative($page, "HomePage"); # since it an ordinary page
|
||||
|
||||
ok(-s "$DataDir/static/Trogs.svgz", "$DataDir/static/Trogs.svgz has nonzero size");
|
||||
ok(-s "$DataDir/static/Logo.png", "$DataDir/static/Logo.png has nonzero size");
|
||||
ok(! -e "$DataDir/static/HomePage.html", "$DataDir/static/HomePage.html does not exist");
|
||||
|
||||
# force generation of HomePage using html=1
|
||||
$page = get_page('action=static raw=1 pwd=foo html=1');
|
||||
test_page($page, "Trogs", "Logo", "HomePage");
|
||||
test_page_negative($page, "no data"); # must not skip HomePage!
|
||||
|
||||
ok(-s "$DataDir/static/Trogs.svgz", "$DataDir/static/Trogs.svgz has nonzero size");
|
||||
ok(-s "$DataDir/static/Logo.png", "$DataDir/static/Logo.png has nonzero size");
|
||||
ok(-s "$DataDir/static/HomePage.html", "$DataDir/static/HomePage.html has nonzero size");
|
||||
|
||||
# check that links between pages work as expected
|
||||
xpath_test(update_page("Test", "Link to HomePage. Testing Ümlaute."),
|
||||
'//a[text()="HomePage"][@href="http://localhost/wiki.pl/HomePage"]');
|
||||
test_page(get_page('action=static raw=1 pwd=foo html=1'), 'Test');
|
||||
xpath_test_file("$DataDir/static/Test.html",
|
||||
'//a[text()="HomePage"][@href="HomePage.html"]');
|
||||
test_file("$DataDir/static/Test.html",
|
||||
"Ümlaute");
|
||||
test_file("$DataDir/static/static.css",
|
||||
"body { background-color:#FFF; color:#000; margin:1em 2em; }");
|
||||
|
||||
# make sure spaces are translated to underscores (fixed in image.pl)
|
||||
add_module('image.pl');
|
||||
|
||||
# Now, create real pages. First, we'll use the ordinary image link to
|
||||
|
||||
48
t/tags.t
48
t/tags.t
@@ -45,24 +45,24 @@ xpath_run_tests(split('\n',<<'EOT'));
|
||||
EOT
|
||||
|
||||
update_page('Brilliant', 'Gameologists [[tag:podcast]] [[tag:mag]]');
|
||||
update_page('Pödgecäst', 'Another [[tag:podcast]]');
|
||||
update_page('Pödgecäst´s', 'Another [[tag:podcast]]');
|
||||
update_page('Alex', 'Me! [[tag:Old School]]');
|
||||
|
||||
# open the DB file
|
||||
require DB_File;
|
||||
tie %h, "DB_File", $TagFile;
|
||||
|
||||
%tag = map {$_=>1} split($FS, $h{"_Brilliant"});
|
||||
%tag = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("_Brilliant")}));
|
||||
ok($tag{podcast}, 'Brilliant page tagged podcast');
|
||||
ok($tag{mag}, 'Brilliant page tagged mag');
|
||||
%tag = map {$_=>1} split($FS, $h{"_Pödgecäst"});
|
||||
ok($tag{podcast}, 'Pödgecäst page tagged podcast');
|
||||
%file = map {$_=>1} split($FS, $h{"podcast"});
|
||||
%tag = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("_Pödgecäst´s")}));
|
||||
ok($tag{podcast}, 'Pödgecäst´s page tagged podcast');
|
||||
%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("podcast")}));
|
||||
ok($file{Brilliant}, 'Tag podcast applies to page Brilliant');
|
||||
ok($file{Pödgecäst}, 'Tag podcast applies to page Pödgecäst');
|
||||
%file = map {$_=>1} split($FS, $h{"mag"});
|
||||
ok($file{"Pödgecäst´s"}, 'Tag podcast applies to page Pödgecäst´s');
|
||||
%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("mag")}));
|
||||
ok($file{Brilliant}, 'Tag mag applies to page Brilliant');
|
||||
%file = map {$_=>1} split($FS, $h{"old_school"});
|
||||
%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("old_school")}));
|
||||
ok($file{Alex}, 'Tag Old School applies to page Alex');
|
||||
|
||||
# close the DB file before making changes via the wiki!
|
||||
@@ -73,12 +73,12 @@ update_page('Brilliant', 'Gameologists [[tag:mag]]');
|
||||
# reopen changed file
|
||||
tie %h, "DB_File", $TagFile;
|
||||
|
||||
%tag = map {$_=>1} split($FS, $h{"_Brilliant"});
|
||||
%tag = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("_Brilliant")}));
|
||||
ok(!$tag{podcast}, 'Brilliant page no longer tagged podcast');
|
||||
ok($tag{mag}, 'Brilliant page still tagged mag');
|
||||
%file = map {$_=>1} split($FS, $h{"podcast"});
|
||||
%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("podcast")}));
|
||||
ok(!$file{Brilliant}, 'Tag podcast no longer applies to page Brilliant');
|
||||
ok($file{Pödgecäst}, 'Tag podcast still applies to page Pödgecäst');
|
||||
ok($file{"Pödgecäst´s"}, 'Tag podcast still applies to page Pödgecäst´s');
|
||||
|
||||
# close the DB file before making changes via the wiki!
|
||||
untie %h;
|
||||
@@ -88,8 +88,8 @@ DeletePage('Brilliant');
|
||||
# reopen changed file
|
||||
tie %h, "DB_File", $TagFile;
|
||||
|
||||
ok(!$h{_Brilliant}, 'Brilliant page no longer exists');
|
||||
ok(!exists($h{mag}), 'No page tagged mag exists');
|
||||
ok(!$h{UrlEncode("_Brilliant")}, 'Brilliant page no longer exists');
|
||||
ok(!exists($h{UrlEncode("mag")}), 'No page tagged mag exists');
|
||||
|
||||
# close the DB file before making changes via the wiki!
|
||||
untie %h;
|
||||
@@ -101,46 +101,46 @@ update_page('Jeff', 'a blog [[tag:Old School]]');
|
||||
|
||||
# ordinary search finds Alex
|
||||
$page = get_page('search=podcast raw=1');
|
||||
test_page($page, qw(Pödgecäst Brilliant Sons Alex));
|
||||
test_page($page, qw(Pödgecäst´s Brilliant Sons Alex));
|
||||
|
||||
# tag search skips Alex
|
||||
$page = get_page('search=tag:podcast raw=1');
|
||||
test_page($page, qw(Pödgecäst Brilliant Sons));
|
||||
test_page($page, qw(Pödgecäst´s Brilliant Sons));
|
||||
test_page_negative($page, qw(Alex));
|
||||
|
||||
# tag search is case insensitive
|
||||
$page = get_page('search=tag:PODCAST raw=1');
|
||||
test_page($page, qw(Pödgecäst Brilliant Sons));
|
||||
test_page($page, qw(Pödgecäst´s Brilliant Sons));
|
||||
test_page_negative($page, qw(Alex));
|
||||
|
||||
# exclude tag search skips Brilliant
|
||||
$page = get_page('search=-tag:mag raw=1');
|
||||
test_page($page, qw(Pödgecäst Sons Alex));
|
||||
test_page($page, qw(Pödgecäst´s Sons Alex));
|
||||
test_page_negative($page, qw(Brilliant));
|
||||
|
||||
# combine include and exclude tag search to exclude both Alex and
|
||||
# Brilliant
|
||||
$page = get_page('search=tag:podcast%20-tag:mag raw=1');
|
||||
test_page($page, qw(Pödgecäst Sons));
|
||||
test_page($page, qw(Pödgecäst´s Sons));
|
||||
test_page_negative($page, qw(Brilliant Alex));
|
||||
|
||||
# combine ordinary search with include and exclude tag search to
|
||||
# exclude both Alex and Brilliant
|
||||
$page = get_page('search=kryos%20tag:podcast%20-tag:mag raw=1');
|
||||
test_page($page, qw(Sons));
|
||||
test_page_negative($page, qw(Pödgecäst Brilliant Alex));
|
||||
test_page_negative($page, qw(Pödgecäst´s Brilliant Alex));
|
||||
|
||||
# search for a tag containing spaces
|
||||
$page = get_page('search=tag:old_school raw=1');
|
||||
test_page($page, qw(Jeff));
|
||||
test_page_negative($page, qw(Sons Pödgecäst Brilliant Alex));
|
||||
test_page_negative($page, qw(Sons Pödgecäst´s Brilliant Alex));
|
||||
|
||||
test_page(get_page('action=reindex pwd=foo'),
|
||||
qw(Pödgecäst Brilliant Sons Alex));
|
||||
qw(Pödgecäst´s Brilliant Sons Alex));
|
||||
|
||||
# tag search skips Alex -- repeat test after reindexing
|
||||
$page = get_page('search=tag:podcast raw=1');
|
||||
test_page($page, qw(Pödgecäst Brilliant Sons));
|
||||
test_page($page, qw(Pödgecäst´s Brilliant Sons));
|
||||
test_page_negative($page, qw(Alex));
|
||||
|
||||
add_module('near-links.pl');
|
||||
@@ -160,7 +160,7 @@ test_page_negative($page, qw(AlexSchroeder Foo));
|
||||
|
||||
# check journal pages
|
||||
$page = update_page('Podcasts', '<journal "." search tag:podcast>');
|
||||
test_page($page, qw(Pödgecäst Brilliant Sons));
|
||||
test_page($page, qw(Pödgecäst´s Brilliant Sons));
|
||||
test_page_negative($page, qw(Alex Foo));
|
||||
|
||||
# check the tag cloud
|
||||
@@ -177,4 +177,4 @@ AppendStringToFile($ConfigFile, "\$LocalNamesCollect = 1;\n");
|
||||
update_page('LocalNames', 'test');
|
||||
update_page('Alex', 'is a [[tag:podcast]] after all');
|
||||
$page = get_page('search=tag:podcast raw=1');
|
||||
test_page($page, qw(Pödgecäst Brilliant Sons Alex));
|
||||
test_page($page, qw(Pödgecäst´s Brilliant Sons Alex));
|
||||
|
||||
45
t/test.pl
45
t/test.pl
@@ -18,6 +18,12 @@ use XML::LibXML;
|
||||
use utf8;
|
||||
use vars qw($raw);
|
||||
|
||||
# Test::More explains how to fix wide character in print issues
|
||||
my $builder = Test::More->builder;
|
||||
binmode $builder->output, ":utf8";
|
||||
binmode $builder->failure_output, ":utf8";
|
||||
binmode $builder->todo_output, ":utf8";
|
||||
|
||||
# Import the functions
|
||||
|
||||
$raw = 0; # capture utf8 is the default
|
||||
@@ -26,7 +32,16 @@ $UseConfig = 0; # don't read module files
|
||||
$DataDir = 'test-data';
|
||||
$ENV{WikiDataDir} = $DataDir;
|
||||
require 'wiki.pl';
|
||||
$ENV{PATH} = '/usr/local/bin:' . $ENV{PATH}; # location of perl?
|
||||
|
||||
# Try to guess which Perl we should be using. Since we loaded wiki.pl,
|
||||
# our $ENV{PATH} is set to /bin:/usr/bin in order to find diff and
|
||||
# grep.
|
||||
if ($ENV{PERLBREW_PATH}) {
|
||||
$ENV{PATH} = $ENV{PERLBREW_PATH} . ':' . $ENV{PATH};
|
||||
} elsif (-f '/usr/local/bin/perl') {
|
||||
$ENV{PATH} = '/usr/local/bin:' . $ENV{PATH};
|
||||
}
|
||||
|
||||
Init();
|
||||
use vars qw($redirect);
|
||||
|
||||
@@ -94,7 +109,6 @@ sub name {
|
||||
$_ = shift;
|
||||
s/\n/\\n/g;
|
||||
$_ = '...' . substr($_, -60) if length > 63;
|
||||
utf8::encode($_);
|
||||
return $_;
|
||||
}
|
||||
|
||||
@@ -138,12 +152,24 @@ sub run_macro_tests {
|
||||
|
||||
# one string, many tests
|
||||
sub test_page {
|
||||
my $page = shift;
|
||||
foreach my $test (@_) {
|
||||
my ($page, @tests) = @_;
|
||||
foreach my $test (@tests) {
|
||||
like($page, qr($test), name($test));
|
||||
}
|
||||
}
|
||||
|
||||
# one file, many tests
|
||||
sub test_file {
|
||||
my ($file, @tests) = @_;
|
||||
if (open(F, '< :utf8', $file)) {
|
||||
local $/ = undef;
|
||||
test_page(<F>, @tests);
|
||||
close(F);
|
||||
} else {
|
||||
warn "cannot open $file\n";
|
||||
}
|
||||
}
|
||||
|
||||
# one string, many negative tests
|
||||
sub test_page_negative {
|
||||
my $page = shift;
|
||||
@@ -194,6 +220,17 @@ sub xpath_test {
|
||||
xpath_do(sub { shift > 0; }, "No Matches\n", @_);
|
||||
}
|
||||
|
||||
sub xpath_test_file {
|
||||
my ($file, @tests) = @_;
|
||||
if (open(F, '< :utf8', $file)) {
|
||||
local $/ = undef;
|
||||
xpath_test(<F>, @tests);
|
||||
close(F);
|
||||
} else {
|
||||
warn "cannot open $file\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub negative_xpath_test {
|
||||
xpath_do(sub { shift == 0; }, "Unexpected Matches\n", @_);
|
||||
}
|
||||
|
||||
269
wiki.pl
269
wiki.pl
@@ -1,5 +1,5 @@
|
||||
#! /usr/bin/perl
|
||||
# Copyright (C) 2001-2012
|
||||
# Copyright (C) 2001-2013
|
||||
# Alex Schroeder <alex@gnu.org>
|
||||
# Copyleft 2008 Brian Curry <http://www.raiazome.com>
|
||||
# ... including lots of patches from the UseModWiki site
|
||||
@@ -39,7 +39,8 @@ use vars qw($RssLicense $RssCacheHours @RcDays $TempDir $LockDir $DataDir
|
||||
$KeepDir $PageDir $RcOldFile $IndexFile $BannedContent $NoEditFile $BannedHosts
|
||||
$ConfigFile $FullUrl $SiteName $HomePage $LogoUrl $RcDefault $RssDir
|
||||
$IndentLimit $RecentTop $RecentLink $EditAllowed $UseDiff $KeepDays $KeepMajor
|
||||
$EmbedWiki $BracketText $UseConfig $UseLookup $AdminPass $EditPass $NetworkFile
|
||||
$EmbedWiki $BracketText $UseConfig $UseLookup $AdminPass $EditPass
|
||||
$PassHashFunction $PassSalt $NetworkFile
|
||||
$BracketWiki $FreeLinks $WikiLinks $SummaryHours $FreeLinkPattern $RCName
|
||||
$RunCGI $ShowEdits $LinkPattern $RssExclude $InterLinkPattern $MaxPost $UseGrep
|
||||
$UrlPattern $UrlProtocols $ImageExtensions $InterSitePattern $FS $CookieName
|
||||
@@ -49,7 +50,7 @@ $RssImageUrl $ReadMe $RssRights $BannedCanRead $SurgeProtection $TopLinkBar
|
||||
$LanguageLimit $SurgeProtectionTime $SurgeProtectionViews $DeletedPage
|
||||
%Languages $InterMap $ValidatorLink %LockOnCreation $RssStyleSheet
|
||||
%CookieParameters @UserGotoBarPages $NewComment $HtmlHeaders $StyleSheetPage
|
||||
$ConfigPage $ScriptName $CommentsPrefix @UploadTypes $AllNetworkFiles
|
||||
$ConfigPage $ScriptName $CommentsPrefix $CommentsPattern @UploadTypes $AllNetworkFiles
|
||||
$UsePathInfo $UploadAllowed $LastUpdate $PageCluster %PlainTextPages
|
||||
$RssInterwikiTranslate $UseCache $Counter $ModuleDir $FullUrlPattern
|
||||
$SummaryDefaultLength $FreeInterLinkPattern %InvisibleCookieParameters
|
||||
@@ -95,12 +96,14 @@ $StyleSheetPage = 'css'; # Page for CSS sheet
|
||||
$LogoUrl = ''; # URL for site logo ('' for no logo)
|
||||
$NotFoundPg = ''; # Page for not-found links ('' for blank pg)
|
||||
|
||||
$NewText = "This page is empty.\n"; # New page text
|
||||
$NewComment = "Add your comment here.\n"; # New comment text
|
||||
$NewText = T('This page is empty.') . "\n"; # New page text
|
||||
$NewComment = T('Add your comment here.') . "\n"; # New comment text
|
||||
|
||||
$EditAllowed = 1; # 0 = no, 1 = yes, 2 = comments pages only, 3 = comments only
|
||||
$AdminPass = '' unless defined $AdminPass; # Whitespace separated passwords.
|
||||
$EditPass = '' unless defined $EditPass; # Whitespace separated passwords.
|
||||
$PassHashFunction = '' unless defined $PassHashFunction; # Name of the function to create hashes
|
||||
$PassSalt = '' unless defined $PassSalt; # Salt will be added to any password before hashing
|
||||
|
||||
$BannedHosts = 'BannedHosts'; # Page for banned hosts
|
||||
$BannedCanRead = 1; # 1 = banned cannot edit, 0 = banned cannot read
|
||||
@@ -151,6 +154,7 @@ $TopLinkBar = 1; # 1 = add a goto bar at the top of the page
|
||||
$UserGotoBar = ''; # HTML added to end of goto bar
|
||||
$ValidatorLink = 0; # 1 = Link to the W3C HTML validator service
|
||||
$CommentsPrefix = ''; # prefix for comment pages, eg. 'Comments_on_' to enable
|
||||
$CommentsPattern = undef; # regex used to match comment pages
|
||||
$HtmlHeaders = ''; # Additional stuff to put in the HTML <head> section
|
||||
$IndentLimit = 20; # Maximum depth of nested lists
|
||||
$LanguageLimit = 3; # Number of matches req. for each language
|
||||
@@ -159,7 +163,7 @@ $DocumentHeader = qq(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN")
|
||||
. qq( "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">\n)
|
||||
. qq(<html xmlns="http://www.w3.org/1999/xhtml">);
|
||||
# Checkboxes at the end of the index.
|
||||
@IndexOptions = (['pages', T('Include normal pages'), 1, \&AllPagesList]);
|
||||
@IndexOptions = ();
|
||||
# Display short comments below the GotoBar for special days
|
||||
# Example: %SpecialDays = ('1-1' => 'New Year', '1-2' => 'Next Day');
|
||||
%SpecialDays = ();
|
||||
@@ -289,6 +293,8 @@ sub InitVariables { # Init global session variables for mod_perl!
|
||||
(\$HomePage, \$RCName, \$BannedHosts, \$InterMap, \$StyleSheetPage, \$CommentsPrefix,
|
||||
\$ConfigPage, \$NotFoundPg, \$RssInterwikiTranslate, \$BannedContent, \$RssExclude, );
|
||||
$CommentsPrefix .= '_' if $add_space;
|
||||
$CommentsPattern = "^$CommentsPrefix(.*)"
|
||||
unless defined $CommentsPattern or not $CommentsPrefix;
|
||||
@UserGotoBarPages = ($HomePage, $RCName) unless @UserGotoBarPages;
|
||||
my @pages = sort($BannedHosts, $StyleSheetPage, $ConfigPage, $InterMap,
|
||||
$RssInterwikiTranslate, $BannedContent);
|
||||
@@ -306,6 +312,7 @@ sub InitVariables { # Init global session variables for mod_perl!
|
||||
@MyRules = sort {$RuleOrder{$a} <=> $RuleOrder{$b}} @MyRules; # default is 0
|
||||
ReportError(Ts('Cannot create %s', $DataDir) . ": $!", '500 INTERNAL SERVER ERROR')
|
||||
unless -d $DataDir;
|
||||
@IndexOptions = (['pages', T('Include normal pages'), 1, \&AllPagesList]);
|
||||
foreach my $sub (@MyInitVariables) {
|
||||
my $result = &$sub;
|
||||
$Message .= $q->p($@) if $@;
|
||||
@@ -464,12 +471,12 @@ sub ApplyRules {
|
||||
}
|
||||
Clean(AddHtmlEnvironment('p')); # if dirty block is looked at later, this will disappear
|
||||
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
|
||||
} elsif ($bol && m/\G(\<journal(\s+(\d*))?(\s+"(.*?)")?(\s+(reverse|past|future))?(\s+search\s+(.*))?\>[ \t]*\n?)/cgi) {
|
||||
} elsif ($bol && m/\G(\<journal(\s+(\d*)(,(\d*))?)?(\s+"(.*?)")?(\s+(reverse|past|future))?(\s+search\s+(.*))?\>[ \t]*\n?)/cgi) {
|
||||
# <journal 10 "regexp"> includes 10 pages matching regexp
|
||||
Clean(CloseHtmlEnvironments());
|
||||
Dirty($1);
|
||||
my ($oldpos, $old_) = (pos, $_); # remember these because of the call to PrintJournal()
|
||||
PrintJournal($3, $5, $7, 0, $9); # no offset
|
||||
PrintJournal($3, $5, $7, $9, 0, $11); # no offset
|
||||
Clean(AddHtmlEnvironment('p')); # if dirty block is looked at later, this will disappear
|
||||
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
|
||||
} elsif ($bol && m/\G(\<rss(\s+(\d*))?\s+(.*?)\>[ \t]*\n?)/cgis) {
|
||||
@@ -797,6 +804,7 @@ sub UrlEncode {
|
||||
sub UrlDecode {
|
||||
my $str = shift;
|
||||
$str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/ge;
|
||||
utf8::decode($str); # make internal string
|
||||
return $str;
|
||||
}
|
||||
|
||||
@@ -811,13 +819,13 @@ sub GetRaw {
|
||||
return unless eval { require LWP::UserAgent; };
|
||||
my $ua = LWP::UserAgent->new;
|
||||
my $response = $ua->get($uri);
|
||||
return $response->content if $response->is_success;
|
||||
return $response->decoded_content if $response->is_success;
|
||||
}
|
||||
|
||||
sub DoJournal {
|
||||
print GetHeader(undef, T('Journal'));
|
||||
print $q->start_div({-class=>'content'});
|
||||
PrintJournal(map { GetParam($_, ''); } qw(num regexp mode offset search));
|
||||
PrintJournal(map { GetParam($_, ''); } qw(num num regexp mode offset search));
|
||||
print $q->end_div();
|
||||
PrintFooter();
|
||||
}
|
||||
@@ -827,9 +835,10 @@ sub JournalSort { $b cmp $a }
|
||||
sub PrintJournal {
|
||||
return if $CollectingJournal; # avoid infinite loops
|
||||
local $CollectingJournal = 1;
|
||||
my ($num, $regexp, $mode, $offset, $search) = @_;
|
||||
my ($num, $numMore, $regexp, $mode, $offset, $search) = @_;
|
||||
$regexp = '^\d\d\d\d-\d\d-\d\d' unless $regexp;
|
||||
$num = 10 unless $num;
|
||||
$numMore = $num unless $numMore;
|
||||
$offset = 0 unless $offset;
|
||||
# FIXME: Should pass filtered list of pages to SearchTitleAndBody to save time?
|
||||
my @pages = sort JournalSort (grep(/$regexp/, $search ? SearchTitleAndBody($search) : AllPagesList()));
|
||||
@@ -858,7 +867,9 @@ sub PrintJournal {
|
||||
print $q->start_div({-class=>'journal'});
|
||||
my $next = $offset + PrintAllPages(1, 1, $num, @pages[$offset .. $#pages]);
|
||||
print $q->end_div();
|
||||
print $q->p({-class=>'more'}, ScriptLink("action=more;num=$num;regexp=$regexp;search=$search;mode=$mode;offset=$next", T('More...'), 'more')) if $pages[$next];
|
||||
$regexp = UrlEncode($regexp);
|
||||
$search = UrlEncode($search);
|
||||
print $q->p({-class=>'more'}, ScriptLink("action=more;num=$numMore;regexp=$regexp;search=$search;mode=$mode;offset=$next", T('More...'), 'more')) if $pages[$next];
|
||||
}
|
||||
|
||||
sub PrintAllPages {
|
||||
@@ -878,17 +889,21 @@ sub PrintAllPages {
|
||||
$q->h1($links ? GetPageLink($id)
|
||||
: $q->a({-name=>$id}, UrlEncode(FreeToNormal($id))));
|
||||
PrintPageHtml();
|
||||
if ($comments and $id !~ /^$CommentsPrefix/o) {
|
||||
print $q->p({-class=>'comment'},
|
||||
GetPageLink($CommentsPrefix . $id,
|
||||
T('Comments on this page')));
|
||||
}
|
||||
PrintPageCommentsLink($id, $comments);
|
||||
print $q->end_div();
|
||||
$n++; # pages actually printed
|
||||
}
|
||||
return $i;
|
||||
}
|
||||
|
||||
sub PrintPageCommentsLink {
|
||||
my ($id, $comments) = @_;
|
||||
if ($comments and $CommentsPattern and $id !~ /$CommentsPattern/o) {
|
||||
print $q->p({-class=>'comment'},
|
||||
GetPageLink($CommentsPrefix . $id, T('Comments on this page')));
|
||||
}
|
||||
}
|
||||
|
||||
sub RSS {
|
||||
return if $CollectingJournal; # avoid infinite loops when using full=1
|
||||
local $CollectingJournal = 1;
|
||||
@@ -1022,7 +1037,7 @@ sub GetRss {
|
||||
}
|
||||
my @need_cache = keys %todo;
|
||||
if (keys %todo > 1) { # try parallel access if available
|
||||
eval { # see code example in LWP::Parallel, not LWP::Parllel::UserAgent (no callbacks here)
|
||||
eval { # see code example in LWP::Parallel, not LWP::Parallel::UserAgent (no callbacks here)
|
||||
require LWP::Parallel::UserAgent;
|
||||
my $pua = LWP::Parallel::UserAgent->new();
|
||||
foreach my $uri (keys %todo) {
|
||||
@@ -1034,7 +1049,7 @@ sub GetRss {
|
||||
my $entries = $pua->wait();
|
||||
foreach (keys %$entries) {
|
||||
my $uri = $entries->{$_}->request->uri;
|
||||
$data{$uri} = $entries->{$_}->response->content;
|
||||
$data{$uri} = $entries->{$_}->response->decoded_content;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1161,11 +1176,12 @@ sub GetPageOrEditLink { # use GetPageLink and GetEditLink if you know the result
|
||||
}
|
||||
|
||||
sub GetPageLink { # use if you want to force a link to local pages, whether it exists or not
|
||||
my ($id, $name, $class) = @_;
|
||||
my ($id, $name, $class, $accesskey) = @_;
|
||||
$id = FreeToNormal($id);
|
||||
$name = $id unless $name;
|
||||
$class .= ' ' if $class;
|
||||
return ScriptLink(UrlEncode($id), NormalToFree($name), $class . 'local');
|
||||
return ScriptLink(UrlEncode($id), NormalToFree($name), $class . 'local',
|
||||
undef, undef, $accesskey);
|
||||
}
|
||||
|
||||
sub GetEditLink { # shortcut
|
||||
@@ -1377,7 +1393,7 @@ sub BrowseResolvedPage {
|
||||
print $q->redirect({-uri=>$resolved});
|
||||
} elsif ($class && $class eq 'alias') { # an anchor was found instead of a page
|
||||
ReBrowsePage($resolved);
|
||||
} elsif (not $resolved and $NotFoundPg and $id !~ /^$CommentsPrefix/o) { # custom page-not-found message
|
||||
} elsif (not $resolved and $NotFoundPg and $id !~ /$CommentsPattern/o) { # custom page-not-found message
|
||||
BrowsePage($NotFoundPg);
|
||||
} elsif ($resolved) { # an existing page was found
|
||||
BrowsePage($resolved, GetParam('raw', 0));
|
||||
@@ -1389,7 +1405,7 @@ sub BrowseResolvedPage {
|
||||
sub BrowsePage {
|
||||
my ($id, $raw, $comment, $status) = @_;
|
||||
OpenPage($id);
|
||||
my ($text, $revision) = GetTextRevision(GetParam('revision', ''));
|
||||
my ($text, $revision, $summary) = GetTextRevision(GetParam('revision', ''));
|
||||
$text = $NewText unless $revision or $Page{revision}; # new text for new pages
|
||||
# handle a single-level redirect
|
||||
my $oldId = GetParam('oldid', '');
|
||||
@@ -1421,7 +1437,7 @@ sub BrowsePage {
|
||||
print GetHeader($id, NormalToFree($id), $oldId, undef, $status);
|
||||
my $showDiff = GetParam('diff', 0);
|
||||
if ($UseDiff && $showDiff) {
|
||||
PrintHtmlDiff($showDiff, GetParam('diffrevision', $revision), $revision, $text);
|
||||
PrintHtmlDiff($showDiff, GetParam('diffrevision', $revision), $revision, $text, $summary);
|
||||
print $q->hr();
|
||||
}
|
||||
PrintPageContent($text, $revision, $comment);
|
||||
@@ -1500,7 +1516,7 @@ sub GetRcLines { # starttime, hash of seen pages to use as a second return value
|
||||
my %following = ();
|
||||
my @result = ();
|
||||
# check the first timestamp in the default file, maybe read old log file
|
||||
open(F, '<:encoding(UTF-8)', $RcFile);
|
||||
open(F, '<:utf8', $RcFile);
|
||||
my $line = <F>;
|
||||
my ($ts) = split(/$FS/o, $line); # the first timestamp in the regular rc file
|
||||
if (not $ts or $ts > $starttime) { # we need to read the old rc file, too
|
||||
@@ -1540,30 +1556,30 @@ sub LatestChanges {
|
||||
sub StripRollbacks {
|
||||
my @result = @_;
|
||||
if (not (GetParam('all', 0) or GetParam('rollback', 0))) { # strip rollbacks
|
||||
my ($skip_to, $end, %rollback);
|
||||
my (%rollback);
|
||||
for (my $i = $#result; $i >= 0; $i--) {
|
||||
# some fields have a different meaning if looking at rollbacks
|
||||
my $ts = $result[$i][0];
|
||||
my $id = $result[$i][1];
|
||||
my $target_ts = $result[$i][2];
|
||||
my $target_id = $result[$i][3];
|
||||
# strip global rollbacks
|
||||
if ($skip_to and $ts <= $skip_to) {
|
||||
splice(@result, $i + 1, $end - $i);
|
||||
$skip_to = 0;
|
||||
} elsif ($id eq '[[rollback]]') {
|
||||
if ($id eq '[[rollback]]') {
|
||||
if ($target_id) {
|
||||
$rollback{$target_id} = $target_ts; # single page rollback
|
||||
splice(@result, $i, 1); # strip marker
|
||||
} else {
|
||||
$end = $i unless $skip_to;
|
||||
$skip_to = $target_ts; # cumulative rollbacks!
|
||||
my $end = $i;
|
||||
while ($ts > $target_ts and $i > 0) {
|
||||
$i--; # quickly skip all these lines
|
||||
$ts = $result[$i][0];
|
||||
}
|
||||
splice(@result, $i + 1, $end - $i);
|
||||
$i++; # compensate $i-- in for loop
|
||||
}
|
||||
} elsif ($rollback{$id} and $ts > $rollback{$id}) {
|
||||
splice(@result, $i, 1); # strip rolled back single pages
|
||||
}
|
||||
}
|
||||
splice(@result, 0, $end + 1) if $skip_to; # strip rest if any
|
||||
} else { # just strip the marker left by DoRollback()
|
||||
for (my $i = $#result; $i >= 0; $i--) {
|
||||
splice(@result, $i, 1) if $result[$i][1] eq '[[rollback]]'; # id
|
||||
@@ -1586,7 +1602,7 @@ sub GetRcLinesFor {
|
||||
rcclusteronly rcfilteronly match lang followup);
|
||||
# parsing and filtering
|
||||
my @result = ();
|
||||
open(F, '<:encoding(UTF-8)', $file) or return ();
|
||||
open(F, '<:utf8', $file) or return ();
|
||||
while (my $line = <F>) {
|
||||
chomp($line);
|
||||
my ($ts, $id, $minor, $summary, $host, $username, $revision,
|
||||
@@ -1847,11 +1863,10 @@ sub RcTextRevision {
|
||||
: ($UsePathInfo ? '/' : '?') . UrlEncode($id));
|
||||
print "\n", RcTextItem('title', NormalToFree($id)),
|
||||
RcTextItem('description', $summary),
|
||||
RcTextItem('generator', $username
|
||||
? $username . ' ' . Ts('from %s', $host) : $host),
|
||||
RcTextItem('generator', GetAuthor($host, $username)),
|
||||
RcTextItem('language', join(', ', @{$languages})), RcTextItem('link', $link),
|
||||
RcTextItem('last-modified', TimeToW3($ts)),
|
||||
RcTextItem('revision', $revision);
|
||||
RcTextItem('revision', $revision);
|
||||
}
|
||||
|
||||
sub PrintRcText { # print text rss header and call ProcessRcLines
|
||||
@@ -1940,7 +1955,7 @@ sub RssItem {
|
||||
$rss .= "<description>" . QuoteHtml($summary) . "</description>\n" if $summary;
|
||||
$rss .= "<pubDate>" . $date . "</pubDate>\n";
|
||||
$rss .= "<comments>" . ScriptUrl($CommentsPrefix . UrlEncode($id))
|
||||
. "</comments>\n" if $CommentsPrefix and $id !~ /^$CommentsPrefix/o;
|
||||
. "</comments>\n" if $CommentsPattern and $id !~ /$CommentsPattern/o;
|
||||
$rss .= "<dc:contributor>" . $username . "</dc:contributor>\n" if $username;
|
||||
$rss .= "<wiki:status>" . (1 == $revision ? 'new' : 'updated')
|
||||
. "</wiki:status>\n";
|
||||
@@ -1967,7 +1982,7 @@ sub DoHistory {
|
||||
print GetHttpHeader('text/plain'),
|
||||
RcTextItem('title', Ts('History of %s', NormalToFree($OpenPageName))),
|
||||
RcTextItem('date', TimeToText($Now)),
|
||||
RcTextItem('link', $q->url(-path_info=>1, -query=>1)),
|
||||
RcTextItem('link', ScriptUrl("action=history;id=$OpenPageName;raw=1")),
|
||||
RcTextItem('generator', 'Oddmuse');
|
||||
SetParam('all', 1);
|
||||
my @languages = split(/,/, $Page{languages});
|
||||
@@ -1995,8 +2010,7 @@ sub DoHistory {
|
||||
}
|
||||
@html = (GetFormStart(undef, 'get', 'history'),
|
||||
$q->p($q->submit({-name=>T('Compare')}),
|
||||
# don't use $q->hidden here, the sticky action
|
||||
# value will be used instead
|
||||
# don't use $q->hidden here!
|
||||
$q->input({-type=>'hidden',-name=>'action',-value=>'browse'}),
|
||||
$q->input({-type=>'hidden', -name=>'diff', -value=>'1'}),
|
||||
$q->input({-type=>'hidden', -name=>'id', -value=>$id})),
|
||||
@@ -2077,6 +2091,9 @@ sub DoRollback {
|
||||
my @ids = ();
|
||||
if (not $page) { # cannot just use list length because of ('')
|
||||
return unless UserIsAdminOrError(); # only admins can do mass changes
|
||||
SetParam('showedit', 1); # make GetRcLines return minor edits as well
|
||||
SetParam('all', 1); # prevent LatestChanges from interfering
|
||||
SetParam('rollback', 1); # prevent StripRollbacks from interfering
|
||||
my %ids = map { my ($ts, $id) = @$_; $id => 1; } # make unique via hash
|
||||
GetRcLines($Now - $KeepDays * 86400); # 24*60*60
|
||||
@ids = keys %ids;
|
||||
@@ -2103,31 +2120,52 @@ sub DoRollback {
|
||||
WriteRcLog('[[rollback]]', $page, $to); # leave marker
|
||||
print $q->end_p() . $q->end_div();
|
||||
ReleaseLock();
|
||||
PrintFooter();
|
||||
PrintFooter($page);
|
||||
}
|
||||
|
||||
sub DoAdminPage {
|
||||
my ($id, @rest) = @_;
|
||||
my @menu = (ScriptLink('action=index', T('Index of all pages'), 'index'),
|
||||
ScriptLink('action=version', T('Wiki Version'), 'version'),
|
||||
ScriptLink('action=unlock', T('Unlock Wiki'), 'unlock'),
|
||||
ScriptLink('action=password', T('Password'), 'password'),
|
||||
ScriptLink('action=maintain', T('Run maintenance'), 'maintain'));
|
||||
my @menu = ();
|
||||
push(@menu, ScriptLink('action=index',
|
||||
T('Index of all pages'), 'index'))
|
||||
if $Action{index};
|
||||
push(@menu, ScriptLink('action=version',
|
||||
T('Wiki Version'), 'version'))
|
||||
if $Action{version};
|
||||
push(@menu, ScriptLink('action=unlock',
|
||||
T('Unlock Wiki'), 'unlock'))
|
||||
if $Action{unlock};
|
||||
push(@menu, ScriptLink('action=password',
|
||||
T('Password'), 'password'))
|
||||
if $Action{password};
|
||||
push(@menu, ScriptLink('action=maintain',
|
||||
T('Run maintenance'), 'maintain'))
|
||||
if $Action{maintain};
|
||||
if (UserIsAdmin()) {
|
||||
push(@menu, ScriptLink('action=clear', T('Clear Cache'), 'clear'));
|
||||
if (-f "$DataDir/noedit") {
|
||||
push(@menu, ScriptLink('action=editlock;set=0', T('Unlock site'), 'editlock 0'));
|
||||
} else {
|
||||
push(@menu, ScriptLink('action=editlock;set=1', T('Lock site'), 'editlock 1'));
|
||||
push(@menu, ScriptLink('action=clear',
|
||||
T('Clear Cache'), 'clear'))
|
||||
if $Action{clear};
|
||||
if ($Action{editlock}) {
|
||||
if (-f "$DataDir/noedit") {
|
||||
push(@menu, ScriptLink('action=editlock;set=0',
|
||||
T('Unlock site'), 'editlock 0'));
|
||||
} else {
|
||||
push(@menu, ScriptLink('action=editlock;set=1',
|
||||
T('Lock site'), 'editlock 1'));
|
||||
}
|
||||
}
|
||||
if ($id) {
|
||||
if ($id and $Action{pagelock}) {
|
||||
my $title = NormalToFree($id);
|
||||
if (-f GetLockedPageFile($id)) {
|
||||
push(@menu, ScriptLink('action=pagelock;set=0;id=' . UrlEncode($id),
|
||||
Ts('Unlock %s', $title), 'pagelock 0'));
|
||||
push(@menu, ScriptLink('action=pagelock;set=0;id='
|
||||
. UrlEncode($id),
|
||||
Ts('Unlock %s', $title),
|
||||
'pagelock 0'));
|
||||
} else {
|
||||
push(@menu, ScriptLink('action=pagelock;set=1;id=' . UrlEncode($id),
|
||||
Ts('Lock %s', $title), 'pagelock 1'));
|
||||
push(@menu, ScriptLink('action=pagelock;set=1;id='
|
||||
. UrlEncode($id),
|
||||
Ts('Lock %s', $title),
|
||||
'pagelock 1'));
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -2176,6 +2214,13 @@ sub ScriptLinkDiff {
|
||||
return ScriptLink($action, $text, 'diff');
|
||||
}
|
||||
|
||||
sub GetAuthor {
|
||||
my ($host, $username) = @_;
|
||||
return $username . ' ' . Ts('from %s', $host) if $username and $host;
|
||||
return $username if $username;
|
||||
return T($host); # could be 'Anonymous'
|
||||
}
|
||||
|
||||
sub GetAuthorLink {
|
||||
my ($host, $username) = @_;
|
||||
$username = FreeToNormal($username);
|
||||
@@ -2184,11 +2229,11 @@ sub GetAuthorLink {
|
||||
$username = ''; # Just pretend it isn't there.
|
||||
}
|
||||
if ($username and $RecentLink) {
|
||||
return ScriptLink(UrlEncode($username), $name, 'author', undef, Ts('from %s', $host));
|
||||
return ScriptLink(UrlEncode($username), $name, 'author', undef, $host);
|
||||
} elsif ($username) {
|
||||
return $q->span({-class=>'author'}, $name) . ' ' . Ts('from %s', $host);
|
||||
return $q->span({-class=>'author'}, $name);
|
||||
}
|
||||
return $host;
|
||||
return T($host); # could be 'Anonymous'
|
||||
}
|
||||
|
||||
sub GetHistoryLink {
|
||||
@@ -2334,7 +2379,7 @@ sub GetCss { # prevent javascript injection
|
||||
push (@css, $StyleSheet) if $StyleSheet and not @css;
|
||||
push (@css, "$ScriptName?action=browse;id=" . UrlEncode($StyleSheetPage) . ";raw=1;mime-type=text/css")
|
||||
if $IndexHash{$StyleSheetPage} and not @css;
|
||||
push (@css, 'http://www.oddmuse.org/oddmuse.css') unless @css;
|
||||
push (@css, 'http://www.oddmuse.org/default.css') unless @css;
|
||||
return join('', map { qq(<link type="text/css" rel="stylesheet" href="$_" />) } @css);
|
||||
}
|
||||
|
||||
@@ -2396,11 +2441,11 @@ sub GetFooterLinks {
|
||||
my ($id, $rev) = @_;
|
||||
my @elements;
|
||||
if ($id and $rev ne 'history' and $rev ne 'edit') {
|
||||
if ($CommentsPrefix) {
|
||||
if ($id =~ /^$CommentsPrefix(.*)/o) {
|
||||
push(@elements, GetPageLink($1, undef, 'original'));
|
||||
if ($CommentsPattern) {
|
||||
if ($id =~ /$CommentsPattern/o) {
|
||||
push(@elements, GetPageLink($1, undef, 'original', T('a')));
|
||||
} else {
|
||||
push(@elements, GetPageLink($CommentsPrefix . $id, undef, 'comment'));
|
||||
push(@elements, GetPageLink($CommentsPrefix . $id, undef, 'comment', T('c')));
|
||||
}
|
||||
}
|
||||
if (UserCanEdit($id, 0)) {
|
||||
@@ -2428,8 +2473,8 @@ sub GetFooterLinks {
|
||||
|
||||
sub GetCommentForm {
|
||||
my ($id, $rev, $comment) = @_;
|
||||
if ($CommentsPrefix ne '' and $id and $rev ne 'history' and $rev ne 'edit'
|
||||
and $id =~ /^$CommentsPrefix/o and UserCanEdit($id, 0, 1)) {
|
||||
if ($CommentsPattern ne '' and $id and $rev ne 'history' and $rev ne 'edit'
|
||||
and $id =~ /$CommentsPattern/o and UserCanEdit($id, 0, 1)) {
|
||||
return $q->div({-class=>'comment'}, GetFormStart(undef, undef, 'comment'), # protected by questionasker
|
||||
$q->p(GetHiddenValue('title', $id),
|
||||
GetTextArea('aftertext', $comment ? $comment : $NewComment, 10)), $EditNote,
|
||||
@@ -2487,14 +2532,14 @@ sub GetGotoBar { # ignore $id parameter
|
||||
}
|
||||
|
||||
sub PrintHtmlDiff {
|
||||
my ($type, $old, $new, $text) = @_;
|
||||
my ($type, $old, $new, $text, $summary) = @_;
|
||||
my $intro = T('Last edit');
|
||||
my $diff = GetCacheDiff($type == 1 ? 'major' : 'minor');
|
||||
# compute old revision if cache is disabled or no cached diff is available
|
||||
if (not $old and (not $diff or GetParam('cache', $UseCache) < 1)) {
|
||||
if ($type == 1) {
|
||||
$old = $Page{lastmajor} - 1;
|
||||
($text, $new) = GetTextRevision($Page{lastmajor}, 1)
|
||||
($text, $new, $summary) = GetTextRevision($Page{lastmajor}, 1)
|
||||
unless $new or $Page{lastmajor} == $Page{revision};
|
||||
} elsif ($new) {
|
||||
$old = $new - 1;
|
||||
@@ -2502,6 +2547,8 @@ sub PrintHtmlDiff {
|
||||
$old = $Page{revision} - 1;
|
||||
}
|
||||
}
|
||||
$summary = $Page{summary} if not $summary and not $new;
|
||||
$summary = $q->p({-class=>'summary'}, T('Summary:') . ' ' . $summary) if $summary;
|
||||
if ($old > 0) { # generate diff if the computed old revision makes sense
|
||||
$diff = GetKeptDiff($text, $old);
|
||||
$intro = Tss('Difference between revision %1 and %2', $old,
|
||||
@@ -2512,7 +2559,7 @@ sub PrintHtmlDiff {
|
||||
}
|
||||
$diff =~ s!<p><strong>(.*?)</strong></p>!'<p><strong>' . T($1) . '</strong></p>'!ge;
|
||||
$diff = T('No diff available.') unless $diff;
|
||||
print $q->div({-class=>'diff'}, $q->p($q->b($intro)), $diff);
|
||||
print $q->div({-class=>'diff'}, $q->p($q->b($intro)), $summary, $diff);
|
||||
}
|
||||
|
||||
sub GetCacheDiff {
|
||||
@@ -2667,12 +2714,11 @@ sub OpenPage { # Sets global variables
|
||||
$Page{ts} = $Now;
|
||||
$Page{revision} = 0;
|
||||
if ($id eq $HomePage
|
||||
and (open(F, '<:encoding(UTF-8)', $ReadMe)
|
||||
or open(F, '<:encoding(UTF-8)', 'README'))) {
|
||||
and (open(F, '<:utf8', $ReadMe)
|
||||
or open(F, '<:utf8', 'README'))) {
|
||||
local $/ = undef;
|
||||
$Page{text} = <F>;
|
||||
close F;
|
||||
} elsif ($CommentsPrefix and $id =~ /^$CommentsPrefix(.*)/o) { # do nothing
|
||||
}
|
||||
}
|
||||
$OpenPageName = $id;
|
||||
@@ -2696,15 +2742,15 @@ sub GetTextAtTime { # call with opened page, return $minor if all pages between
|
||||
sub GetTextRevision {
|
||||
my ($revision, $quiet) = @_;
|
||||
$revision =~ s/\D//g; # Remove non-numeric chars
|
||||
return ($Page{text}, $revision) unless $revision and $revision ne $Page{revision};
|
||||
return ($Page{text}, $revision, $Page{summary}) unless $revision and $revision ne $Page{revision};
|
||||
my %keep = GetKeptRevision($revision);
|
||||
if (not %keep) {
|
||||
$Message .= $q->p(Ts('Revision %s not available', $revision)
|
||||
. ' (' . T('showing current revision instead') . ')') unless $quiet;
|
||||
return ($Page{text}, '');
|
||||
return ($Page{text}, '', '');
|
||||
}
|
||||
$Message .= $q->p(Ts('Showing revision %s', $revision)) unless $quiet;
|
||||
return ($keep{text}, $revision);
|
||||
return ($keep{text}, $revision, $keep{summary});
|
||||
}
|
||||
|
||||
sub GetPageContent {
|
||||
@@ -2798,7 +2844,7 @@ sub ExpireKeepFiles { # call with opened page
|
||||
sub ReadFile {
|
||||
my $file = shift;
|
||||
utf8::encode($file); # filenames are bytes!
|
||||
if (open(IN, '<:encoding(UTF-8)', $file)) {
|
||||
if (open(IN, '<:utf8', $file)) {
|
||||
local $/ = undef; # Read complete files
|
||||
my $data=<IN>;
|
||||
close IN;
|
||||
@@ -2998,11 +3044,9 @@ sub FreeToNormal { # trim all spaces and convert them to underlines
|
||||
my $id = shift;
|
||||
return '' unless $id;
|
||||
$id =~ s/ /_/g;
|
||||
if (index($id, '_') > -1) { # Quick check for any space/underscores
|
||||
$id =~ s/__+/_/g;
|
||||
$id =~ s/^_//;
|
||||
$id =~ s/_$//;
|
||||
}
|
||||
$id =~ s/__+/_/g;
|
||||
$id =~ s/^_//;
|
||||
$id =~ s/_$//;
|
||||
return UnquoteHtml($id);
|
||||
}
|
||||
|
||||
@@ -3187,7 +3231,7 @@ sub UserCanEdit {
|
||||
return 1 if UserIsEditor();
|
||||
return 0 if !$EditAllowed or -f $NoEditFile;
|
||||
return 0 if $editing and UserIsBanned(); # this call is more expensive
|
||||
return 0 if $EditAllowed >= 2 and (not $CommentsPrefix or $id !~ /^$CommentsPrefix/o);
|
||||
return 0 if $EditAllowed >= 2 and (not $CommentsPattern or $id !~ /$CommentsPattern/o);
|
||||
return 1 if $EditAllowed >= 3 and ($comment or (GetParam('aftertext', '') and not GetParam('text', '')));
|
||||
return 0 if $EditAllowed >= 3;
|
||||
return 1;
|
||||
@@ -3209,19 +3253,22 @@ sub UserIsBanned {
|
||||
}
|
||||
|
||||
sub UserIsAdmin {
|
||||
return 0 if $AdminPass eq '';
|
||||
my $pwd = GetParam('pwd', '');
|
||||
foreach (split(/\s+/, $AdminPass)) {
|
||||
return 1 if $pwd eq $_;
|
||||
}
|
||||
return 0;
|
||||
return UserHasPassword(GetParam('pwd', ''), $AdminPass);
|
||||
}
|
||||
|
||||
sub UserIsEditor {
|
||||
return 1 if UserIsAdmin(); # Admin includes editor
|
||||
return 0 if $EditPass eq '';
|
||||
my $pwd = GetParam('pwd', ''); # Used for both passwords
|
||||
foreach (split(/\s+/, $EditPass)) {
|
||||
return UserHasPassword(GetParam('pwd', ''), $EditPass);
|
||||
}
|
||||
|
||||
sub UserHasPassword {
|
||||
my ($pwd, $pass) = @_;
|
||||
return 0 if not $pass;
|
||||
if ($PassHashFunction ne '') {
|
||||
no strict 'refs';
|
||||
$pwd = &$PassHashFunction($pwd . $PassSalt);
|
||||
}
|
||||
foreach (split(/\s+/, $pass)) {
|
||||
return 1 if $pwd eq $_;
|
||||
}
|
||||
return 0;
|
||||
@@ -3304,7 +3351,7 @@ sub AllPagesList {
|
||||
if (not $refresh and -f $IndexFile) {
|
||||
my ($status, $rawIndex) = ReadFile($IndexFile); # not fatal
|
||||
if ($status) {
|
||||
%IndexHash = split(/\s+/, $rawIndex);
|
||||
%IndexHash = split(/ /, $rawIndex);
|
||||
@IndexList = sort(keys %IndexHash);
|
||||
return @IndexList;
|
||||
}
|
||||
@@ -3372,7 +3419,7 @@ sub PageIsUploadedFile {
|
||||
if ($IndexHash{$id}) {
|
||||
my $file = GetPageFile($id);
|
||||
utf8::encode($file); # filenames are bytes!
|
||||
open(FILE, '<:encoding(UTF-8)', $file)
|
||||
open(FILE, '<:utf8', $file)
|
||||
or ReportError(Ts('Cannot open %s', $file) . ": $!", '500 INTERNAL SERVER ERROR');
|
||||
while (defined($_ = <FILE>) and $_ !~ /^text: /) {
|
||||
} # read lines until we get to the text key
|
||||
@@ -3466,8 +3513,7 @@ sub PrintSearchResultEntry {
|
||||
my %entry = %{(shift)}; # get value from reference
|
||||
my $regex = shift;
|
||||
if (GetParam('raw', 0)) {
|
||||
$entry{generator} = $entry{username} . ' ' if $entry{username};
|
||||
$entry{generator} .= Ts('from %s', $entry{host}) if $entry{host};
|
||||
$entry{generator} = GetAuthor($entry{host}, $entry{username});
|
||||
foreach my $key (qw(title description size last-modified generator username host)) {
|
||||
print RcTextItem($key, $entry{$key});
|
||||
}
|
||||
@@ -3678,7 +3724,7 @@ sub AddComment {
|
||||
my $author = GetParam('username', T('Anonymous'));
|
||||
my $homepage = GetParam('homepage', '');
|
||||
$homepage = 'http://' . $homepage
|
||||
if $homepage and not substr($homepage,0,7) eq 'http://';
|
||||
if $homepage and $homepage !~ /^($UrlProtocols):/;
|
||||
$author = "[$homepage $author]" if $homepage;
|
||||
$string .= "\n----\n\n" if $string and $string ne "\n";
|
||||
$string .= $comment . "\n\n"
|
||||
@@ -3771,9 +3817,9 @@ sub MergeRevisions { # merge change from file2 to file3 into file1
|
||||
# Note: all diff and recent-list operations should be done within locks.
|
||||
sub WriteRcLog {
|
||||
my ($id, $summary, $minor, $revision, $username, $host, $languages, $cluster) = @_;
|
||||
my $rc_line = join($FS, $Now, $id, $minor, $summary, $host,
|
||||
my $line = join($FS, $Now, $id, $minor, $summary, $host,
|
||||
$username, $revision, $languages, $cluster);
|
||||
AppendStringToFile($RcFile, $rc_line . "\n");
|
||||
AppendStringToFile($RcFile, $line . "\n");
|
||||
}
|
||||
|
||||
sub UpdateDiffs { # this could be optimized, but isn't frequent enough
|
||||
@@ -3794,8 +3840,7 @@ sub DoMaintain {
|
||||
return;
|
||||
}
|
||||
}
|
||||
RequestLockOrError();
|
||||
print $q->p(T('Main lock obtained.')), '<p>', T('Expiring keep files and deleting pages marked for deletion');
|
||||
print '<p>', T('Expiring keep files and deleting pages marked for deletion');
|
||||
# Expire all keep files
|
||||
foreach my $name (AllPagesList()) {
|
||||
print $q->br(), GetPageLink($name);
|
||||
@@ -3808,7 +3853,10 @@ sub DoMaintain {
|
||||
ExpireKeepFiles();
|
||||
}
|
||||
}
|
||||
print '</p>', $q->p(Ts('Moving part of the %s log file.', $RCName));
|
||||
print '</p>';
|
||||
RequestLockOrError();
|
||||
print $q->p(T('Main lock obtained.'));
|
||||
print $q->p(Ts('Moving part of the %s log file.', $RCName));
|
||||
# Determine the number of days to go back
|
||||
my $days = 0;
|
||||
foreach (@RcDays) {
|
||||
@@ -3823,17 +3871,18 @@ sub DoMaintain {
|
||||
}
|
||||
# Move the old stuff from rc to temp
|
||||
my @rc = split(/\n/, $data);
|
||||
my $i;
|
||||
for ($i = 0; $i < @rc ; $i++) {
|
||||
my ($ts) = split(/$FS/o, $rc[$i]);
|
||||
my @tmp = ();
|
||||
for my $line (@rc) {
|
||||
my ($ts, $id, $minor, $summary, $host, @rest) = split(/$FS/o, $line);
|
||||
last if ($ts >= $starttime);
|
||||
push(@tmp, join($FS, $ts, $id, $minor, $summary, 'Anonymous', @rest));
|
||||
}
|
||||
print $q->p(Ts('Moving %s log entries.', $i));
|
||||
if ($i) {
|
||||
my @temp = splice(@rc, 0, $i);
|
||||
print $q->p(Ts('Moving %s log entries.', scalar(@tmp)));
|
||||
if (@tmp) {
|
||||
# Write new files, and backups
|
||||
AppendStringToFile($RcOldFile, join("\n",@temp) . "\n");
|
||||
AppendStringToFile($RcOldFile, join("\n", @tmp) . "\n");
|
||||
WriteStringToFile($RcFile . '.old', $data);
|
||||
splice(@rc, 0, scalar(@tmp)); # strip
|
||||
WriteStringToFile($RcFile, @rc ? join("\n",@rc) . "\n" : '');
|
||||
}
|
||||
if (opendir(DIR, $RssDir)) { # cleanup if they should expire anyway
|
||||
|
||||
59
wikicopy
59
wikicopy
@@ -42,6 +42,7 @@ our ($opt_v, $opt_w);
|
||||
|
||||
my $usage = qq{$0 [-i URL] [-d STRING] [-t SECONDS]
|
||||
\t[-u USERNAME] [-p PASSWORD] [-w USERNAME:PASSWORD]
|
||||
\t[-q QUESTION] [-a ANSWER] [-z SECRET]
|
||||
\t[SOURCE] TARGET
|
||||
|
||||
SOURCE and TARGET are the base URLs for the two wikis. Visiting these
|
||||
@@ -61,18 +62,15 @@ If you use -d instead of providing a SOURCE, all the pages will be
|
||||
replaced with STRING. This is useful when replacing the page content
|
||||
with "DeletedPage", for example.
|
||||
|
||||
Your copies on the target wiki will show up on the list of changes as
|
||||
anonymous edits. If you want to provide a username, you can use -u to
|
||||
do so.
|
||||
|
||||
If you want to copy pages to a locked wiki or if you need to overwrite
|
||||
locked target pages, you need to provide a password using -p.
|
||||
|
||||
On the other hand, if your wiki is protected by so-called "basic
|
||||
authentication" -- that is, if you need to provide a username and
|
||||
password before you can even view the site -- then you can pass
|
||||
those along using the -w option. Separate username and password
|
||||
using a colon.
|
||||
-d Delete target pages instead of providing SOURCE (default: none)
|
||||
-s The summary for RecentChanges (default: none)
|
||||
-u The username for RecentChanges (default: none)
|
||||
-p The password to use for locked pages (default: none)
|
||||
-w The username:password combo for basic authentication (default:none)
|
||||
-q The question number to answer (default: 0, ie. the first question)
|
||||
-a The answer to the question (default: none)
|
||||
-z Alternatively, the secret key (default: question)
|
||||
-v Verbose output for debugging (default: none)
|
||||
|
||||
Examples:
|
||||
|
||||
@@ -111,17 +109,31 @@ sub GetRaw {
|
||||
return $response->content if $response->is_success;
|
||||
}
|
||||
|
||||
sub PostRaw {
|
||||
my ($uri, $id, $data, $username, $password) = @_;
|
||||
sub post {
|
||||
my ($uri, $id, $data, $minor, $summary, $username, $password,
|
||||
$question, $answer, $secret) = @_;
|
||||
my $ua = RequestAgent->new;
|
||||
my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
|
||||
username=>$username, pwd=>$password});
|
||||
my %params = (title=>$id, text=>$data, raw=>1,
|
||||
username=>$username, pwd=>$password,
|
||||
summary=>$summary, question_num=>$question,
|
||||
answer=>$answer, $secret=>1,
|
||||
recent_edit=>$minor);
|
||||
if ($opt_v) {
|
||||
foreach my $key (keys %params) {
|
||||
my $value = $params{$key} || '(none)';
|
||||
$value = substr($value,0,50) . '...'
|
||||
if $key eq 'text' and length($value) > 53;
|
||||
warn "$key: $value\n";
|
||||
}
|
||||
}
|
||||
my $response = $ua->post($uri, \%params);
|
||||
my $status = $response->code . ' ' . $response->message;
|
||||
warn "POST $id failed: $status.\n" unless $response->is_success;
|
||||
}
|
||||
|
||||
sub copy {
|
||||
my ($source, $replacement, $target, $interval, $username, $password,
|
||||
my ($source, $replacement, $target, $interval, $minor, $summary,
|
||||
$username, $password, $question, $answer, $secret,
|
||||
@pages) = @_;
|
||||
foreach my $id (@pages) {
|
||||
print "$id\n";
|
||||
@@ -129,18 +141,18 @@ sub copy {
|
||||
# fix URL for other wikis
|
||||
my $data = $replacement || GetRaw("$source?action=browse;id=$page;raw=1");
|
||||
next unless $data;
|
||||
PostRaw($target, $id, $data, $username, $password);
|
||||
post($target, $id, $data, $minor, $summary, $username, $password,
|
||||
$question, $answer, $secret);
|
||||
sleep($interval);
|
||||
}
|
||||
}
|
||||
|
||||
sub main {
|
||||
our($opt_i, $opt_t, $opt_d, $opt_u, $opt_p);
|
||||
getopts('i:t:d:u:p:w:v');
|
||||
our($opt_m, $opt_i, $opt_t, $opt_d, $opt_s, $opt_u, $opt_p,
|
||||
$opt_q, $opt_a, $opt_z);
|
||||
getopts('mi:t:d:s:u:p:q:a:z:w:v');
|
||||
my $interval = $opt_t ? $opt_t : 5;
|
||||
my $replacement = $opt_d;
|
||||
my $username = $opt_u;
|
||||
my $password = $opt_p;
|
||||
my ($source, $target);
|
||||
$source = shift(@ARGV) unless $replacement;
|
||||
$target = shift(@ARGV);
|
||||
@@ -157,7 +169,8 @@ sub main {
|
||||
}
|
||||
}
|
||||
die "The list of pages is missing. Did you use -i?\n" unless @pages;
|
||||
copy($source, $replacement, $target, $interval, $username, $password,
|
||||
copy($source, $replacement, $target, $interval, $opt_m ? 'on' : '', $opt_s,
|
||||
$opt_u, $opt_p, $opt_q, $opt_a, $opt_z||'question',
|
||||
@pages);
|
||||
}
|
||||
|
||||
|
||||
3
wikiput
3
wikiput
@@ -84,7 +84,8 @@ sub post {
|
||||
if ($opt_v) {
|
||||
foreach my $key (keys %params) {
|
||||
my $value = $params{$key} || '(none)';
|
||||
$value = substr($value,0,50) . '...' if $key eq 'text' and length($value) > 53;
|
||||
$value = substr($value,0,50) . '...'
|
||||
if $key eq 'text' and length($value) > 53;
|
||||
warn "$key: $value\n";
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user