Compare commits

...

104 Commits

Author SHA1 Message Date
Aleks-Daniel Jakimenko
f8ac7a2818 aawrapperdiv.pl: wrap PrintFooter correctly 2015-09-06 02:55:36 +03:00
Aleks-Daniel Jakimenko
1cd33b691c Fix for issue #1 on github
Changing everything to return objects is a worthy goal, but for now we have
taken enough destructive steps towards it. Therefore, this commit fixes the
problem in backwards compatible way (by adding one more parameter to the
signatures).

Note that this additional parameter is NOT a timestamp, it is a whole page
object. Which means that we are still moving towards our goal of using page
objects everywhere, this commit is just doing it in a backwards-compatible
way.
2015-09-06 01:10:29 +03:00
Aleks-Daniel Jakimenko
9d7e5b43c0 Test for Issue #1 on github 2015-09-05 23:54:43 +03:00
Aleks-Daniel Jakimenko
1c4e082755 Return objects where it begs for it
sub ParseData is fully backwards compatible. If some module runs it in list
context, then it will get listified hash like previously. New code should
always run it in scalar context though (everything in our code base
was changed according to that).

sub GetTextRevision is not backwards compatible (don't let “wantarray” usage
to confuse you). Most modules do not touch that subroutine, so we are probably
fine (modules from our git repo that do use were changed accordingly).

“EncodePage(%$page)” looks wrong. It seems like we should change it to accept
hash ref.
2015-09-04 04:55:48 +03:00
Aleks-Daniel Jakimenko
31c02d6e95 oddmuse-quickstart: some progress 2015-08-26 07:05:44 +03:00
Aleks-Daniel Jakimenko
26bf8a3043 oddmuse-quickstart: progress (still not ready) 2015-08-25 07:09:37 +03:00
Aleks-Daniel Jakimenko
ac21a8e6a4 Group pages with comment pages in page index 2015-08-25 04:14:16 +03:00
Aleks-Daniel Jakimenko
a000937768 https links in README 2015-08-24 03:00:56 +03:00
Aleks-Daniel Jakimenko
4eef4d2d76 No more /o, modifiers sorted alphabetically 2015-08-23 21:22:12 +03:00
Alex Schroeder
92410a1f5c add-link.pl: Fix footer 2015-08-23 13:32:41 +02:00
Aleks-Daniel Jakimenko
aa89d08e08 atom.pl: use XML::Atom explicitly
So that it is easier to find the required dependency
2015-08-20 14:59:00 +03:00
Aleks-Daniel Jakimenko
244ddb5157 run-tests: fixed wrong git path 2015-08-20 07:19:06 +03:00
Aleks-Daniel Jakimenko
9c3456c963 run-tests: do push as well 2015-08-20 06:54:41 +03:00
Aleks-Daniel Jakimenko
ad9afbf5ba GPL license for Alexine scripts 2015-08-20 06:47:53 +03:00
Aleks-Daniel Jakimenko
bc079133f7 New script new-release (autoupdate source links) 2015-08-20 06:45:32 +03:00
Aleks-Daniel Jakimenko
69a0f3ed23 Alexine image 2015-08-19 11:28:30 +03:00
Aleks-Daniel Jakimenko
1fc3600329 run-tests: print only 7 characters of a commit 2015-08-19 11:19:31 +03:00
Aleks-Daniel Jakimenko
c1141cd610 run-tests: another repository link
This repository will not only hold test data, but it
will also have some other files associated with Alexine bot.
2015-08-19 11:12:36 +03:00
Aleks-Daniel Jakimenko
300d86b2cd run-tests: fixed newlines 2015-08-19 11:10:48 +03:00
Aleks-Daniel Jakimenko
d609a857c0 run-tests: fixed typo, OK status edits are now minor 2015-08-19 10:57:31 +03:00
Aleks-Daniel Jakimenko
8e98298777 run-tests: fix wikiput path 2015-08-19 10:47:49 +03:00
Aleks-Daniel Jakimenko
0642fad8f8 Afterfix for 5462b21 (disallow minor comments)
Test added as well
2015-08-19 10:17:49 +03:00
Aleks-Daniel Jakimenko
d10d76c475 run-tests: secret key specified 2015-08-19 10:05:45 +03:00
Aleks-Daniel Jakimenko
8aa2f04995 New run-tests script (part of Alexine) 2015-08-19 08:53:21 +03:00
Alex Schroeder
b3a1f199c1 Renamed MailCommentAdditions to MailFormAddition 2015-08-18 12:44:08 +02:00
Alex Schroeder
9fbf8a6f39 Use @MyFormChanges in mail.pl
This also requires a change in gravatar.pl because we can no longer test
for MailNewGetCommentForm. Instead, we test @MyFormChanges as variables
are being initialized and if MailCommentAdditions is already on it, we
don't add GravatarFormAddition.
2015-08-18 12:37:18 +02:00
Alex Schroeder
c96b9bb71c static-copy.pl: do not mess with GetCommentForm
This used to be necessary because we used PrintFooter. As static-copy.pl
no longer uses PrintFooter, this futzing is unnecessary and was removed.
2015-08-18 12:35:31 +02:00
Alex Schroeder
71ff0f7de3 askpage.t: new 2015-08-18 11:23:55 +02:00
Alex Schroeder
89fa22d1c9 Introducing @MyFormChanges
GetEditForm and GetCommentForm will now call all the subs in
@FormChanges in order to let them change the generated HTML. This is
used by all the modules that used to hook into either of these two
functions.

A typical change from questionasker.pl:

push(@MyFormChanges, \&QuestionAddTo);

sub QuestionAddTo {
  my ($form, $type, $upload) = @_;
  if (not $upload
      and not QuestionaskerException(GetId())
      and not $QuestionaskerRememberAnswer && GetParam($QuestionaskerSecretKey, 0)
      and not UserIsEditor()) {
    my $question = QuestionaskerGetQuestion();
    $form =~ s/(.*)<p>(.*?)<label for="username">/$1$question<p>$2<label for="username">/;
  }
  return $form;
}

This commit als moves from &$foo to $foo->() based on a recommendation
in Modern Perl by Conway.
2015-08-18 11:11:13 +02:00
Alex Schroeder
7582aaaba1 askpage.pl: don't hook into GetCommentForm
When GetCommentForm is part of @MyFooters, changing it turns into a
problem. We're hooking into GetTextArea instead.
2015-08-18 11:07:51 +02:00
Alex Schroeder
58e9a1e240 use v5.10 everywhere + enabled test in meta.t 2015-08-18 10:48:03 +02:00
Alex Schroeder
bd39fe5d38 recaptcha.pl: same fix as questionasker.pl
We need to replace the old reference in @MyFooters with the new code
reference.
2015-08-18 09:44:43 +02:00
Alex Schroeder
1c776e1080 Undo the commit of version numbers 2015-08-17 16:54:07 +02:00
Alex Schroeder
d088887337 Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-17 14:22:15 +02:00
Alex Schroeder
0ba76bafb2 oddmuse-2.2.6.pl: use $q->end_form
This silences the errors about $q->endform not existing in newer CGI
versions.
2015-08-17 14:20:25 +02:00
Aleks-Daniel Jakimenko
c7756a8861 Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-17 15:12:20 +03:00
Aleks-Daniel Jakimenko
5462b215be Disallow minor comments when $EditAllowed is 3
Otherwise people can sneak some comments in
2015-08-17 15:11:18 +03:00
Alex Schroeder
f98374df9b PrintFooter relies on @MyFooters
We already called all the subs on @MyFooters and printed the result,
but this commit moves all the code from PrintFooters into subs and
puts those subs on @MyFooters. This allows us to write modules that
can better control where exactly their output should appear. In this
case the change was required in order to allow the Google +1 module to
coexist with code that maybe prints the comment form for all pages.

For example, knowing that the Google +1 sub is the first on one the
list because of unshift(@MyFooters, \&GooglePlusPrintFooter), we can
now write the following:

splice(@MyFooters, 1, 0, \&MyCommentsInTheFooter);

sub MyCommentsInTheFooter {
  my ($id, $rev, $comment) = @_;
  if (not $GooglePlusThisPagePrintedJournal
      and (GetParam('action', 'browse') eq 'browse'
           and $id and $CommentsPrefix
	   and $id ne $RCName
      	   and $id !~ /^$CommentsPrefix(.*)/o)) {

    my $target = $CommentsPrefix . $id;
    my $page = '';
    $page = PageHtml($target) if $IndexHash{$target};
    return $q->div({-class=>'comment'},
		   $q->h2(T('Comments')),
		   $page)
	. GetCommentForm("$CommentsPrefix$id", $rev, $comment);
  }
}

The Google +1 extension was also fixed to not triger the EFF's Privacy
Badger. This is OK because we're using a two step button: The user
needs to click a button before we're loading the script from Google.
2015-08-17 13:39:34 +02:00
Alex Schroeder
4614990e04 upgrade-files.t: wipe /tmp/mywikidb
If you're running this test on a system that did not get /tmp wiped in
a 30 days (as happens after a reboot on some systems), then this test
used to fail. The files from the last run will not be changed and
therefore they will not show up in Recent Changes. This commit wipes
$UseModWiki::DataDir before running the test.
2015-08-17 13:35:27 +02:00
Alex Schroeder
6658886b72 alex-2015.css: fix CSS errors 2015-08-17 11:17:04 +02:00
Alex Schroeder
5130a92f9c upgrade_files.pl: Get rid of a warning
Using $q->param in list context...
2015-08-16 09:55:36 +02:00
Alex Schroeder
a602bc0678 search.t: test grouping of search terms 2015-08-16 09:23:33 +02:00
Alex Schroeder
09efd911e6 silence warnings about $q->param
$q->param in list context can be problematic. At the same time, we don't
want to depend on $q->multi_param because it was only added in CGI 4.08
(2014). That's why we're setting $CGI::LIST_CONTEXT_WARN = 0 instead.
2015-08-15 22:48:12 +02:00
Alex Schroeder
958c118649 upgrade-files.t: upgrade-files.pl was moved 2015-08-15 21:54:06 +02:00
Alex Schroeder
c031898184 summary.t: XSS in summaries was fixed
Similar to the previous commit: there was a test that basically ensured
that XSS attacks were possible.
2015-08-15 21:45:17 +02:00
Alex Schroeder
d32ebaddc8 rss.t: XSS in summaries was fixed
Thus it is revealed that the old version of the test was making sure
that XSS was possible via the edit summary. Oh dear.
2015-08-15 21:22:05 +02:00
Alex Schroeder
9c90bba602 SearchHighlight unless raw
The recent reorganization of the search code always calls
SearchHighlight, even if the raw parameter is set. This causes a test in
namespace.t to fail.
2015-08-15 21:17:02 +02:00
Alex Schroeder
93cc1578d0 encoding.t: fix test
When we decided to no longer show changes to the cookie, we knew that we
would have to change some of the tests. This commit does that for
encoding.t. The tests that looked at the HTML document now look at the
footer of an edit.
2015-08-15 21:03:26 +02:00
Alex Schroeder
79610f7490 cookie.t: fix tests
When we decided to no longer show changes to the cookie, we knew that we
would have to change some of the tests. This commit does that for
cookie.t. All the tests that looked at the HTML document now look at the
HTTP response headers.
2015-08-15 16:05:16 +02:00
Alex Schroeder
be2b87635c big-brother.t: increase $VisitorTime to 10
We had decreased $VisitorTime to 5 back in commit 6bc9531...
"big-brother.t: reduce $VisitorTime to 5". As it turns out, under
certain circumstances, this time window is too short for my laptop, so
I'm increasing it again.
2015-08-15 15:55:12 +02:00
Alex Schroeder
8e38179b66 our $q
The recent change to $q->remote_addr() necessitated the addition of our
$q to a few modules.
2015-08-15 10:32:11 +02:00
Alex Schroeder
1300cfad52 Reintroducing Filtered
When the GrepFiltered sub was removed, we didn't check our modules. As
it turns out, tags.pl and mac.pl hooked into this sub to do their job. A
simple no-op Filtered sub was reintroduced for those modules.

Also, all instances of $UseGrep were removed.
2015-08-15 10:02:14 +02:00
Alex Schroeder
bc6ae67a9a xss.t: testing search & replace 2015-08-10 17:50:29 +02:00
Alex Schroeder
c989bdab1d Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-10 14:23:18 +02:00
Alex Schroeder
3d339a2bf5 Fix HTML escaping of search terms
The existing code basically used HTML quoted regular expressions on HTML
quoted pages. This meant that you could not search and replace HTML
tags, for example. This commit tries to fix it.
2015-08-10 14:18:22 +02:00
Alex Schroeder
ac7d68d134 search.t: do not test without $PATH
There is no need to test a fallback when grep is unavailable because we
got rid of $UseGrep.
2015-08-10 10:30:58 +02:00
Aleks-Daniel Jakimenko
a50c2da042 New quickstart script to help creating a new wiki 2015-08-08 05:08:22 +03:00
Aleks-Daniel Jakimenko
6ccf5b7c14 Getting rid of %InvisibleCookieParameters
This is no longer required because we don't print cookies nowadays.
2015-08-08 03:40:23 +03:00
Aleks-Daniel Jakimenko
7a54eff9b1 No more visible cookies
Displaying the cookie is dangerous. If someone finds a way to perform XSS
attack, then he could steal the cookies just by looking at the page contents.

Please note that otherwise cookie contents are not visible from javascript
due to httponly flag.

This feature was not really useful anyway.
2015-08-08 03:22:56 +03:00
Aleks-Daniel Jakimenko
3c2ff5577b cart.pl: use strict and AddModuleDescription 2015-08-07 02:43:46 +03:00
Aleks-Daniel Jakimenko
d721704a1f cart.pl: whitespace issues 2015-08-07 02:36:35 +03:00
Aleks-Daniel Jakimenko
2ba67e1d8b Just “cart”, no bfc 2015-08-07 02:32:37 +03:00
Aleks-Daniel Jakimenko
eb0a4b6416 Found a newer version of Cart Extension 2015-08-07 02:32:07 +03:00
Aleks-Daniel Jakimenko
7f9b23a704 cart-bfc.pl module stolen from http://bfc.sfsu.edu/source/cart-bfc.pl 2015-08-07 02:26:10 +03:00
Aleks-Daniel Jakimenko
1576c80c9f flashbox.pl deleted because nobody likes Flash 2015-08-07 01:59:19 +03:00
Aleks-Daniel Jakimenko
894748b6b8 Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-06 02:44:19 +03:00
Aleks-Daniel Jakimenko
a70618c3be Moving a whole bunch of files 2015-08-06 02:43:57 +03:00
Alex Schroeder
7e92227414 wiki.pl: HTML changes to search form
The search form used to nest delete checkbox and its label, now it uses
the -for attribute instead (and a title attribute with a little help
text).
2015-08-05 16:52:05 +02:00
Alex Schroeder
57788b375a pdf.pl: deleted 2015-08-05 12:25:03 +02:00
Alex Schroeder
b363cb535f wiki.css: code with white-space: pre-wrap; 2015-08-04 13:49:52 +02:00
Alex Schroeder
e31662cda6 wiki.css: padding-top: none changed to 0 2015-08-04 13:43:00 +02:00
Alex Schroeder
ec84200a0b wiki.css: fix typo: no ';' after a block 2015-08-04 13:42:21 +02:00
Alex Schroeder
6f5a4f974c Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-04 13:35:29 +02:00
Alex Schroeder
7d7383de7f wiki.css: code gets grey background
Just code, not pre.
2015-08-04 13:34:51 +02:00
Alex Schroeder
892d462e53 Get rid of $UseGrep
With a wiki having 5934 pages:

alex@kallobombus:~/alexschroeder.ch$ for f in $(seq 10); do (time perl wiki.pl search=kabelbinder grep=0) 2>&1 1>/dev/null|grep user; done
user	0m5.816s
user	0m5.954s
user	0m5.878s
user	0m6.100s
user	0m6.043s
user	0m5.971s
user	0m5.900s
user	0m6.003s
user	0m6.065s
user	0m6.098s
alex@kallobombus:~/alexschroeder.ch$ for f in $(seq 10); do (time perl wiki.pl search=kabelbinder grep=1) 2>&1 1>/dev/null|grep user; done
user	0m6.126s
user	0m6.105s
user	0m6.109s
user	0m6.167s
user	0m6.205s
user	0m5.980s
user	0m6.107s
user	0m6.047s
user	0m6.200s
user	0m6.133s
2015-08-04 11:31:00 +02:00
Alex Schroeder
4e26f0ea37 wiki.css: code gets grey background 2015-08-04 09:57:11 +02:00
Alex Schroeder
ca0a429027 xss.t: verify alt attributes are ok 2015-08-03 09:33:19 +02:00
Aleks-Daniel Jakimenko
d72ee44c3d Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-02 23:44:48 +03:00
Alex Schroeder
5b8caecee9 Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-08-02 22:19:02 +02:00
Ingo Belka
9e58992459 “title” attribute for uploaded images
Uploaded images had no tooltips in Firefox because there was
no “title” attribute.

This change has a positive impact on creole.pl because
Creole Extension is using GetDownloadLink core subroutine.
2015-08-02 23:18:30 +03:00
Alex Schroeder
408df36c0b Fix XSS attack in RSS feeds
If the page content is not printed, then the page summary is plain text.
In other words, it needs to be HTML-quoted.
2015-08-02 22:18:02 +02:00
Aleks-Daniel Jakimenko
46183d0246 Now we will always use httponly cookie flag
If XSS ever comes through, we don't want it to read passwords or do wiki
actions (like editing pages).

Although it does not protect against MitM attacks (all data sent through
HTTP is sent as plaintext, therefore it is easy to get the cookies),
still it gives a protection against script-kiddies. Use HTTPS to get
it completely secure.

This is a prerequisite for anti-CSRF Double Submit Cookies.
2015-08-02 16:14:34 +03:00
Alex Schroeder
3e6de210f8 xss.t: new 2015-07-31 18:03:17 +02:00
Aleks-Daniel Jakimenko
f50b617b76 Fix XSS in diffs 2015-07-31 18:44:22 +03:00
Alex Schroeder
2c4df27922 Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse 2015-07-31 15:38:10 +02:00
Alex Schroeder
823f518615 Replace GetRemoteHost with $q->remote_addr() 2015-07-31 09:35:51 +02:00
Alex Schroeder
2a2987ac79 undo-double-quotes.pl
The conversion of : at the beginning of a line into [quote] bbCode had sometimes left me with consecutive quotes:

: a
: b

Turned into:

[quote]
a
[/quote]

[quote]
b
[/quote]

And this script turns that back into:

[quote]
a

b
[/quote]
2015-07-29 15:52:29 +02:00
Alex Schroeder
dfd97d4958 undo-local-names.pl and undo-usemod.pl
When I decided to drop Wiki Wirds, uninstall the Local Names Extension
and uninstall the Usemod Markup Extension from my homepage, I had a
lot of markup that would no longer work. These are the files I used to
migrate my data directory.
2015-07-29 15:38:30 +02:00
Alex Schroeder
826d1cd6ef Fix test for good regular expression 2015-07-29 10:34:14 +02:00
Alex Schroeder
642cec5e7d Fix utf8 encoding and enable meta test
We now check POD and code with two separate checks. One checks for use
utf8, the other checks for =encoding utf8.
2015-07-28 23:02:23 +02:00
Alex Schroeder
dfa71cb2e3 Revert "Changed EN DASH to - in copyright lines"
This reverts commit 06c7fedec0.
2015-07-28 22:44:53 +02:00
Alex Schroeder
5ed32a6d3f meta.t: enable use utf8 test 2015-07-28 22:16:02 +02:00
Alex Schroeder
06c7fedec0 Changed EN DASH to - in copyright lines
The EN DASH is not really required in year ranges such as 2012–2015 when
we're talking about comments in source code that is probably being
displayed in a fixed font anyway. Changing back to an ordinary hypen
allows us to make a meaningful test for use utf8.
2015-07-28 22:14:37 +02:00
Alex Schroeder
b29ce6c44d agree-disagree.pl: fix leading whitespace 2015-07-28 21:59:47 +02:00
Alex Schroeder
ef6d9172f5 agree-disagree.pl: fix issues 2015-07-28 21:58:15 +02:00
Alex Schroeder
eaf4433505 meta.t: 404handler.pl is not a real module 2015-07-28 21:52:41 +02:00
Alex Schroeder
259dc5c27d meta.t: test for AddModuleDescription 2015-07-28 11:15:28 +02:00
Alex Schroeder
e606016ece 404handler.pl: use our for variables 2015-07-28 10:55:13 +02:00
Alex Schroeder
c7692fad5b upload.pl: fix missing my 2015-07-28 10:49:42 +02:00
Alex Schroeder
3206947b6b Remove trailing whitespace
I love those meta tests.
2015-07-28 10:47:21 +02:00
Alex Schroeder
1eb5bb06a5 oddmuse-curl.el: help users see reload command 2015-07-28 10:44:04 +02:00
Aleks-Daniel Jakimenko
0b4007ff5a meta.t: nice suggestion in "perl -c" test 2015-07-28 06:20:54 +03:00
Aleks-Daniel Jakimenko
92c64bbba9 Tests for our Refactoring efforts (some tests are failing)
Some tests are failing because of the actual problems.
We should fix those.
2015-07-28 06:10:38 +03:00
Aleks-Daniel Jakimenko
f7d5430451 New old module agree-disagree.pl (copied from wiki) 2015-07-28 03:35:33 +03:00
275 changed files with 2606 additions and 1274 deletions

View File

@@ -1,5 +1,5 @@
This is the README file distributed together with the
[[http://oddmuse.org/|Oddmuse]] script.
[[https://oddmuse.org/|Oddmuse]] script.
== Installing Oddmuse on a Debian System running Apache
@@ -82,7 +82,7 @@ putting their names in {{{[[double square brackets]]}}}.
Enjoy your wiki experience.
Visit http://www.oddmuse.org/ to learn more about the translation
Visit https://www.oddmuse.org/ to learn more about the translation
files and modules that are part of this package.
== Apache

View File

@@ -292,6 +292,7 @@ sub main {
Init(); # read config file (no modules!)
$ScriptName = $site; # undo setting in the config file
$FullUrl = $site; #
InitPageVariables(); # call again: $ScriptName was wrong
binmode(STDOUT,':utf8');
$q->charset('utf8');
if ($q->path_info eq '/source') {

View File

@@ -602,7 +602,7 @@ This command is used to reflect new pages to `oddmuse-pages-hash'."
("{{{.*?}}}"
0 '(face shadow
help-echo "Creole code"))
("^{{{\n\\(.*\n\\)+?}}}\n"
("^{{{\\(.*\n\\)+?}}}\n"
0 '(face shadow
help-echo "Creole multiline code")))
"Implement markup rules for the Creole markup extension.
@@ -841,7 +841,9 @@ WIKI is the name of the wiki as defined in `oddmuse-wikis',
PAGENAME is the pagename of the page you want to edit. If the
page is already in a buffer, pop to that buffer instead of
loading the page Use a prefix argument to force a reload of the
page."
page. Use \\[oddmuse-reload] to reload the list of pages
available if you changed the URL in `oddmuse-wikis' or if other
people have been editing the wiki in the mean time."
(interactive (oddmuse-pagename))
(make-directory (concat oddmuse-directory "/" wiki) t)
(let ((name (concat wiki ":" pagename)))

114
contrib/undo-double-quotes.pl Executable file
View File

@@ -0,0 +1,114 @@
#! /usr/bin/perl -w
# Copyright (C) 2015 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 utf8;
use strict;
use warnings;
undef $/; # slurp
my %index = ();
my $verbose = '';
sub write_file {
my ($file, $data) = @_;
return unless $data;
open(my $fh, '>:utf8', $file) or die "Cannot write $file: $!";
print $fh $data;
close($fh);
}
sub replacement_block {
my ($block, $pos, @no_go) = @_;
while (@no_go) {
my $first = shift @no_go;
print "Is $pos between " . $first->[0] . " and " . $first->[1] . "?\n" if $verbose;
return $block if $pos >= $first->[0] and $pos <= $first->[1];
}
return "";
}
sub translate_file {
my ($data) = @_;
my @no_go = ();
while ($data =~ /( <nowiki>.*?<\/nowiki>
| <code>.*?<\/code>
| ^ <pre> (.*\n)+ <\/pre>
| ^ {{{ (.*\n)+ }}} )/gmx) {
push @no_go, [pos($data) - length $1, pos($data)];
print "no go from " . $no_go[-1]->[0] . ".." . $no_go[-1]->[1] . " for $1\n" if $verbose;
}
# The problem is that these replacements don't adjust @no_go! Perhaps it is good enough?
my $subs = '';
$subs = $subs || $data =~ s/ ( \[\/quote\] \n \n \[quote\] ) /replacement_block($1, pos($data), @no_go)/gex;
return $data if $subs;
}
sub read_file {
my $file = shift;
open(my $fh, '<:utf8', $file) or die "Cannot read $file: $!";
my $data = <$fh>;
close($fh);
return $data;
}
sub main {
my ($dir) = @_;
mkdir($dir . '-new') or die "Cannot create $dir-new: $!";
print "Indexing files\n";
foreach my $file (glob("$dir/.* $dir/*")) {
next unless $file =~ /$dir\/(.+)/;
my $id = $1;
next if $id eq ".";
next if $id eq "..";
$index{$id} = 1;
}
print "Converting files\n";
foreach my $id (sort keys %index) {
# this is where you debug a particular page
# $verbose = $id eq '2014-12-18_Emacs_Wiki_Migration';
write_file("$dir-new/$id", translate_file(read_file("$dir/$id")));
}
}
use Getopt::Long;
my $dir = 'raw';
my $help = '';
GetOptions ("dir=s" => \$dir,
"help" => \$help);
if ($help) {
print qq{
Usage: $0 [--dir=DIR]
You need to use the raw.pl script to create a directory full of raw
wiki text files.
--dir=DIR is where the raw wiki text files are. Default: raw. The
converted files will be stored in DIR-new, ie. in raw-new by
default.
Example: $0 --dir=~/alexschroeder/raw
}
} else {
main ($dir);
}

170
contrib/undo-local-names.pl Executable file
View File

@@ -0,0 +1,170 @@
#! /usr/bin/perl -w
# Copyright (C) 2015 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 utf8;
use strict;
use warnings;
undef $/; # slurp
my %index = ();
my $verbose = '';
my $LinkPattern = '(\p{Uppercase}+\p{Lowercase}+\p{Uppercase}\p{Alphabetic}*)';
my $FreeLinkPattern = "([-,.()'%&?;<> _1-9A-Za-z\x{0080}-\x{fffd}]|[-,.()'%&?;<> _0-9A-Za-z\x{0080}-\x{fffd}][-,.()'%&?;<> _0-9A-Za-z\x{0080}-\x{fffd}]+)";
my $UrlProtocols = 'http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|prospero|telnet|gopher|irc|feed';
my $UrlChars = '[-a-zA-Z0-9/@=+$_~*.,;:?!\'"()&#%]'; # see RFC 2396
my $FullUrlPattern="((?:$UrlProtocols):$UrlChars+)"; # when used in square brackets
# either a single letter, or a string that begins with a single letter and ends with a non-space
my $words = '([A-Za-z\x{0080}-\x{fffd}](?:[-%.,:;\'"!?0-9 A-Za-z\x{0080}-\x{fffd}]*?[-%.,:;\'"!?0-9A-Za-z\x{0080}-\x{fffd}])?)';
# zero-width assertion to prevent km/h from counting
my $nowordstart = '(?:(?<=[^-0-9A-Za-z\x{0080}-\x{fffd}])|^)';
# zero-width look-ahead assertion to prevent km/h from counting
my $nowordend = '(?=[^-0-9A-Za-z\x{0080}-\x{fffd}]|$)';
my $IrcNickRegexp = qr{[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*};
sub FreeToNormal { # trim all spaces and convert them to underlines
my $id = shift;
return '' unless $id;
$id =~ s/ /_/g;
$id =~ s/__+/_/g;
$id =~ s/^_//;
$id =~ s/_$//;
return $id;
}
sub parse_local_names {
my $filename = shift;
print "Reading $filename\n";
open(my $fh, '<:utf8', $filename) or die "Cannot read $filename: $!";
my $data = <$fh>;
close($fh);
print "Parsing $filename\n";
my %names = ();
while ($data =~ m/\[$FullUrlPattern\s+([^\]]+?)\]/g) {
my ($page, $url) = ($2, $1);
my $id = FreeToNormal($page);
$names{$id} = $url;
}
return \%names;
}
sub write_file {
my ($file, $data) = @_;
return unless $data;
open(my $fh, '>:utf8', $file) or die "Cannot write $file: $!";
print $fh $data;
close($fh);
}
sub replacement {
my ($names, $id, $pos, @no_go) = @_;
while (@no_go) {
my $first = shift @no_go;
print "Is $pos between " . $first->[0] . " and " . $first->[1] . "?\n" if $verbose;
return $id if $pos >= $first->[0] and $pos <= $first->[1];
}
return "[[$id]]" if exists $index{$id}; # local page exists
return $id unless $names->{$id};
return '[' . $names->{$id} . ' ' . $id . ']';
}
sub translate_file {
my ($names, $data) = @_;
my @no_go = ();
while ($data =~ /( <nowiki>.*?<\/nowiki>
| <code>.*?<\/code>
| ^ <pre> (.*\n)+ <\/pre>
| ^ {{{ (.*\n)+ }}}
| ${nowordstart} \* ${words} \* ${nowordend}
| ${nowordstart} \/ ${words} \/ ${nowordend}
| ${nowordstart} \_ ${words} \_ ${nowordend}
| ${nowordstart} \! ${words} \! ${nowordend}
| \[\[ $FreeLinkPattern .*? \]\]
| \[ $FullUrlPattern \s+ [^\]]+? \]
| ^( \h+.+\n )+
| ^(?: \[? \d\d?:\d\d (?:am|pm)? \]? )? \s* < $IrcNickRegexp > )/gmx) {
push @no_go, [pos($data) - length $1, pos($data)];
print "no go from " . $no_go[-1]->[0] . ".." . $no_go[-1]->[1] . " for $1\n" if $verbose;
}
my $subs = $data =~ s/(?<![:![])\b$LinkPattern(?![:])/replacement($names, $1, pos($data), @no_go)/ge;
return $data if $subs;
}
sub read_file {
my $file = shift;
open(my $fh, '<:utf8', $file) or die "Cannot read $file: $!";
my $data = <$fh>;
close($fh);
return $data;
}
sub main {
my ($dir, $local_names) = @_;
mkdir($dir . '-new') or die "Cannot create $dir-new: $!";
my $names = parse_local_names("$dir/$local_names");
print "Indexing files\n";
foreach my $file (glob("$dir/.* $dir/*")) {
next unless $file =~ /$dir\/(.+)/;
my $id = $1;
next if $id eq ".";
next if $id eq "..";
next if $id eq "$local_names";
$index{$id} = 1;
}
print "Converting files\n";
foreach my $id (sort keys %index) {
# this is where you debug a particular page
# $verbose = $id eq '2014-12-18_Emacs_Wiki_Migration';
write_file("$dir-new/$id", translate_file($names, read_file("$dir/$id")));
}
}
use Getopt::Long;
my $names = 'LocalNames';
my $dir = 'raw';
my $help = '';
GetOptions ("names=s" => \$names,
"dir=s" => \$dir,
"help" => \$help);
if ($help) {
print qq{
Usage: $0 [--dir=DIR] [--names=LocalNames]
You need to use the raw.pl script to create a directory full of raw
wiki text files.
--dir=DIR is where the raw wiki text files are. Default: raw. The
converted files will be stored in DIR-new, ie. in raw-new by
default.
--names=LocalNames is the page name with all the local names on
it. Default: LocalNames
Example: $0 --dir=~/alexschroeder/raw --names=Names
}
} else {
main ($dir, $names);
}

128
contrib/undo-usemod.pl Executable file
View File

@@ -0,0 +1,128 @@
#! /usr/bin/perl -w
# Copyright (C) 2015 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 utf8;
use strict;
use warnings;
undef $/; # slurp
my %index = ();
my $verbose = '';
sub write_file {
my ($file, $data) = @_;
return unless $data;
open(my $fh, '>:utf8', $file) or die "Cannot write $file: $!";
print $fh $data;
close($fh);
}
sub replacement_block {
my ($block, $pos, @no_go) = @_;
while (@no_go) {
my $first = shift @no_go;
print "Is $pos between " . $first->[0] . " and " . $first->[1] . "?\n" if $verbose;
return $block if $pos >= $first->[0] and $pos <= $first->[1];
}
return "[quote]\n" . join("\n", split(/ \n :+ \h? /x, $block)) . "[/quote]\n";
}
sub replacement {
my ($block, $tag, $pos, @no_go) = @_;
while (@no_go) {
my $first = shift @no_go;
print "Is $pos between " . $first->[0] . " and " . $first->[1] . "?\n" if $verbose;
return $block if $pos >= $first->[0] and $pos <= $first->[1];
}
return $tag . $block . $tag;
}
sub translate_file {
my ($data) = @_;
my @no_go = ();
while ($data =~ /( <nowiki>.*?<\/nowiki>
| <code>.*?<\/code>
| ^ <pre> (.*\n)+ <\/pre>
| ^ {{{ (.*\n)+ }}} )/gmx) {
push @no_go, [pos($data) - length $1, pos($data)];
print "no go from " . $no_go[-1]->[0] . ".." . $no_go[-1]->[1] . " for $1\n" if $verbose;
}
# The problem is that these replacements don't adjust @no_go! Perhaps it is good enough?
my $subs = '';
$subs = $subs || $data =~ s/ ''' (.*?) ''' /replacement($1, '**', pos($data), @no_go)/gxe;
$subs = $subs || $data =~ s/ '' (.*?) '' /replacement($1, '\/\/', pos($data), @no_go)/gxe;
$subs = $data =~ s/ ^ :+ \h? ( .* \n (?: .+ \n ) * ) /replacement_block($1, pos($data), @no_go)/gmxe;
return $data if $subs;
}
sub read_file {
my $file = shift;
open(my $fh, '<:utf8', $file) or die "Cannot read $file: $!";
my $data = <$fh>;
close($fh);
return $data;
}
sub main {
my ($dir) = @_;
mkdir($dir . '-new') or die "Cannot create $dir-new: $!";
print "Indexing files\n";
foreach my $file (glob("$dir/.* $dir/*")) {
next unless $file =~ /$dir\/(.+)/;
my $id = $1;
next if $id eq ".";
next if $id eq "..";
$index{$id} = 1;
}
print "Converting files\n";
foreach my $id (sort keys %index) {
# this is where you debug a particular page
# $verbose = $id eq '2014-12-18_Emacs_Wiki_Migration';
write_file("$dir-new/$id", translate_file(read_file("$dir/$id")));
}
}
use Getopt::Long;
my $dir = 'raw';
my $help = '';
GetOptions ("dir=s" => \$dir,
"help" => \$help);
if ($help) {
print qq{
Usage: $0 [--dir=DIR]
You need to use the raw.pl script to create a directory full of raw
wiki text files.
--dir=DIR is where the raw wiki text files are. Default: raw. The
converted files will be stored in DIR-new, ie. in raw-new by
default.
Example: $0 --dir=~/alexschroeder/raw
}
} else {
main ($dir);
}

View File

@@ -100,7 +100,7 @@
}
@font-face {
font-family: 'Symbola';
src: local('Symbola'), url('/fonts/Symbola.woff') format('woff') url('/fonts/Symbola.ttf') format('truetype');
src: local('Symbola'), url('/fonts/Symbola.woff') format('woff'), url('/fonts/Symbola.ttf') format('truetype');
}
body, rss {
@@ -271,7 +271,7 @@ label[for="searchlang"], #searchlang, .header input[type="submit"] {
visibility: hidden; position: absolute;
}
/* wrap on the iphone */
@media media only screen and (max-device-width: 480px) {
@media only screen and (max-device-width: 480px) {
}
.header input {

View File

@@ -188,7 +188,7 @@ div.footer hr {
div.content > div.comment {
border-top: none;
padding-top: none;
padding-top: 0;
border-left: 1ex solid #bbb;
padding-left: 1ex;
}
@@ -213,7 +213,12 @@ pre {
tt, pre, code {
font-size: 80%;
};
}
code {
background: #eee;
white-space: pre-wrap;
}
@font-face {
font-family: 'Gentium Basic';

View File

@@ -27,7 +27,7 @@ my @path = split(/\//, $ENV{REDIRECT_URL});
my $file = $path[$#path];
# for dynamic pages
use vars qw($NotFoundHandlerExceptionsPage);
our ($NotFoundHandlerExceptionsPage);
$NotFoundHandlerExceptionsPage = 'NoCachePages';
$RunCGI = 0;
do $script;

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('aawrapperdiv.pl', 'WrapperDiv Module');
@@ -35,8 +36,7 @@ sub WrapperGetHeader {
*PrintFooter = \&WrapperPrintFooter;
sub WrapperPrintFooter {
my ($id, $rev, $comment) = @_;
print $q->start_div({-class=>'wrapper close'});
print $q->end_div(), $q->end_div();
OldPrintFooter($id, $rev, $comment);
OldPrintFooter(@_);
}

View File

@@ -14,6 +14,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('accesskeys.pl', 'Links With AccessKeys Extension');
@@ -21,7 +22,7 @@ our (@MyRules, $FreeLinkPattern);
push(@MyRules, \&LinksWithAccessKeys);
sub LinksWithAccessKeys {
if (m/\G(\[\[$FreeLinkPattern\{(.)\}\]\])/cog) {
if (m/\G(\[\[$FreeLinkPattern\{(.)\}\]\])/cg) {
my ($id, $key) = ($2, $3);
Dirty($1);
$id = FreeToNormal($id);

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
our ($q, %Page, %Action, $IndexFile, $PageDir, $KeepDir, @MyAdminCode, $RefererDir);
@@ -39,7 +40,7 @@ sub AdminPowerDelete {
} else {
print $q->p(GetPageLink($id) . ' ' . T('deleted'));
WriteRcLog($id, Ts('Deleted %s', $id), 0, $Page{revision},
GetParam('username', ''), GetRemoteHost(), $Page{languages},
GetParam('username', ''), $q->remote_addr(), $Page{languages},
GetCluster($Page{text}));
}
# Regenerate index on next request
@@ -88,10 +89,10 @@ sub AdminPowerRename {
# RecentChanges
OpenPage($new);
WriteRcLog($id, Ts('Renamed to %s', $new), 0, $Page{revision},
GetParam('username', ''), GetRemoteHost(), $Page{languages},
GetParam('username', ''), $q->remote_addr(), $Page{languages},
GetCluster($Page{text}));
WriteRcLog($new, Ts('Renamed from %s', $id), 0, $Page{revision},
GetParam('username', ''), GetRemoteHost(), $Page{languages},
GetParam('username', ''), $q->remote_addr(), $Page{languages},
GetCluster($Page{text}));
print $q->p(Tss('Renamed %1 to %2.', GetPageLink($id), GetPageLink($new)));
ReleaseLock();

View File

@@ -15,6 +15,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('adsense.pl', 'AdSense Module');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('advanced-uploads.pl', 'Advanced File Upload Extension');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('age.pl', 'Age Indication Extension');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('aggregate.pl', 'Front Page Extension');
@@ -25,7 +26,7 @@ our ($q, $bol, %Action, %Page, $OpenPageName, $UseDiff, $UsePathInfo, $RssStyleS
push(@MyRules, \&AggregateRule);
sub AggregateRule {
if ($bol && m/\G(&lt;aggregate\s+((("[^\"&]+",?\s*)+)|(sort\s+)?search\s+(.+?))&gt;)/gc) {
if ($bol && m/\G(&lt;aggregate\s+((("[^\"&]+",?\s*)+)|(sort\s+)?search\s+(.+?))&gt;)/cg) {
Clean(CloseHtmlEnvironments());
Dirty($1);
my ($oldpos, $old_, $str, $sort, $search) = ((pos), $_, $3, $5, $6);
@@ -125,8 +126,8 @@ sub DoAggregate {
}
}
foreach my $id (@pages) {
my %data = ParseData(ReadFileOrDie(GetPageFile(FreeToNormal($id))));
my $page = $data{text};
my $data = ParseData(ReadFileOrDie(GetPageFile(FreeToNormal($id))));
my $page = $data->{text};
my $size = length($page);
my $i = index($page, "\n=");
my $j = index($page, "\n----");
@@ -135,13 +136,13 @@ sub DoAggregate {
$page =~ s/^=.*\n//; # if it starts with a header
my $name = $id;
$name =~ s/_/ /g;
my $date = TimeToRFC822($data{ts});
my $host = $data{host};
my $username = $data{username};
my $date = TimeToRFC822($data->{ts});
my $host = $data->{host};
my $username = $data->{username};
$username = QuoteHtml($username);
$username = $host unless $username;
my $minor = $data{minor};
my $revision = $data{revision};
my $minor = $data->{minor};
my $revision = $data->{revision};
my $cluster = GetCluster($page);
my $description = ToString(sub { ApplyRules(QuoteHtml($page), 1, 0, undef, 'p') });
$description .= $q->p(GetPageLink($id, T('Learn more...')))

119
modules/agree-disagree.pl Normal file
View File

@@ -0,0 +1,119 @@
# Copyright (C) 2005 Bayle Shanks http://purl.net/net/bshanks
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
# Free Software Foundation, Inc.
# 59 Temple Place, Suite 330
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
our ($Now, @MyMacros, @MyRules, $DefaultStyleSheet, $q, $bol);
AddModuleDescription('agree-disagree.pl', 'AgreeDisagreePlugin');
push(@MyRules, \&AgreeDisagreeSupportRule);
push(@MyMacros, sub{ s/\[\+\]/"[+:" . GetParam('username', T('Anonymous'))
. ':' . TimeToText($Now) . "]"/eg });
push(@MyMacros, sub{ s/\[\+(:[^]:]+)\]/"[+$1:" . TimeToText($Now) . "]"/eg });
push(@MyMacros, sub{ s/\[\-\]/"[-:" . GetParam('username', T('Anonymous'))
. ':' . TimeToText($Now) . "]"/eg });
push(@MyMacros, sub{ s/\[\-(:[^]:]+)\]/"[-$1:" . TimeToText($Now) . "]"/eg });
$DefaultStyleSheet .= <<'EOT' unless $DefaultStyleSheet =~ /div\.agree/; # mod_perl?
div.agreeCount {
float: left;
clear: left;
background-color: Green;
padding-left: .5em;
padding-right: .5em;
padding-top: .5em;
padding-bottom: .5em;
}
div.disagreeCount {
float: left;
clear: right;
background-color: Red;
padding-left: .5em;
padding-right: .5em;
padding-top: .5em;
padding-bottom: .5em;
}
div.agreeNames {
float: left;
background-color: Green;
font-size: xx-small;
display: none;
}
div.disagreeNames {
float: left;
background-color: Red;
font-size: xx-small;
display: none;
}
EOT
my %AgreePortraits = ();
sub AgreeDisagreeSupportRule {
if ($bol) {
if ($bol && m/(\G(\s*\[\+(.*?)\]|\s*\[-(.*?)\])+)/cgs) {
my $votes = $1;
my @ayes = ();
my @nayes = ();
while ($votes =~ m/\G.*?\[\+(.*?)\]/cgs) {
my ($ignore, $name, $time) = split(/:/, $1, 3);
push(@ayes, $name);
}
my $votes2 = $votes;
while ($votes2 =~ m/\G.*?\[-(.*?)\]/cgs) {
my ($ignore, $name, $time) = split(/:/, $1, 3);
push(@nayes, $name);
}
my $html = CloseHtmlEnvironments() ;
$html .= $q->div({-class=>'agreeCount'}) . ($#ayes+1) . ' ' . '</div>' ;
$html .= $q->div({-class=>'agreeNames'}) . printNames(@ayes) . '</div>' ;
$html .= $q->div({-class=>'disagreeCount'}) . ' ' . ($#nayes+1) . '</div>' ;
$html .= $q->div({-class=>'disagreeNames'}) . printNames(@nayes) . '</div>' ;
return $html;
}
}
return undef;
}
sub printNames {
my @names = @_;
my $html = '';
foreach my $name (@names) {
$html .= "$name<br>";
}
return $html;
}

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('all.pl', 'All Action');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('anchors.pl', 'Local Anchor Extension');
@@ -20,13 +21,13 @@ our ($q, %Page, $FootnoteNumber, $FreeLinkPattern, @MyRules, $BracketWiki);
push(@MyRules, \&AnchorsRule);
sub AnchorsRule {
if (m/\G\[\[\#$FreeLinkPattern\]\]/gc) {
if (m/\G\[\[\#$FreeLinkPattern\]\]/cg) {
return $q->a({-href=>'#' . FreeToNormal($1), -class=>'local anchor'}, $1);
} elsif ($BracketWiki && m/\G\[\[\#$FreeLinkPattern\|([^\]]+)\]\]/gc) {
} elsif ($BracketWiki && m/\G\[\[\#$FreeLinkPattern\|([^\]]+)\]\]/cg) {
return $q->a({-href=>'#' . FreeToNormal($1), -class=>'local anchor'}, $2);
} elsif ($BracketWiki && m/\G(\[\[$FreeLinkPattern\#$FreeLinkPattern\|([^\]]+)\]\])/cog
or m/\G(\[\[\[$FreeLinkPattern\#$FreeLinkPattern\]\]\])/cog
or m/\G(\[\[$FreeLinkPattern\#$FreeLinkPattern\]\])/cog) {
} elsif ($BracketWiki && m/\G(\[\[$FreeLinkPattern\#$FreeLinkPattern\|([^\]]+)\]\])/cg
or m/\G(\[\[\[$FreeLinkPattern\#$FreeLinkPattern\]\]\])/cg
or m/\G(\[\[$FreeLinkPattern\#$FreeLinkPattern\]\])/cg) {
# This one is not a dirty rule because the output is always a page
# link, never an edit link (unlike normal free links).
my $bracket = (substr($1, 0, 3) eq '[[[');
@@ -46,7 +47,7 @@ sub AnchorsRule {
$text = $id unless $text;
$text =~ s/_/ /g;
return ScriptLink(UrlEncode($id), $text, $class, undef, $title);
} elsif (m/\G\[\:$FreeLinkPattern\]/gc) {
} elsif (m/\G\[\:$FreeLinkPattern\]/cg) {
return $q->a({-name=>FreeToNormal($1), -class=>'anchor'}, '');
}
return;

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('antispam.pl', 'Antispam Module');
@@ -33,7 +34,7 @@ push(@MyRules, \&MaskEmailRule);
sub MaskEmailRule {
# Allow [email@foo.bar Email Me] links
if (m/\G\[($EmailRegExp(\s\w+)*\s*)\]/igc) {
if (m/\G\[($EmailRegExp(\s\w+)*\s*)\]/cgi) {
my $chunk = $1;
$chunk =~ s/($EmailRegExp)//i;
my $email = $1;
@@ -50,7 +51,7 @@ sub MaskEmailRule {
return "<a href=\"mailto:$email\">$chunk</a>";
}
if (m/\G($EmailRegExp)/igc) {
if (m/\G($EmailRegExp)/cgi) {
my $email = $1;
if ($DoMaskEmail) {
my $masked="";

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('archive.pl', 'Archive Extension');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('askpage.pl', 'Ask Page Extension');
@@ -50,12 +51,14 @@ sub NewAskPageDoPost {
OldAskPageDoPost($id, @_); # keep original functionality for regular edits
}
*OldAskPageGetCommentForm=\&GetCommentForm;
*GetCommentForm=\&NewAskPageGetCommentForm;
sub NewAskPageGetCommentForm {
my ($id, $rev, $comment) = @_;
$comment = $NewQuestion if not $comment and $id eq $AskPage;
OldAskPageGetCommentForm(@_);
*OldAskPageGetTextArea=\&GetTextArea;
*GetTextArea=\&NewAskPageGetTextArea;
sub NewAskPageGetTextArea {
my ($name, $text, @rest) = @_;
if ($name eq 'aftertext' and not $text and GetId() eq $AskPage) {
$text = $NewQuestion;
}
OldAskPageGetTextArea($name, $text, @rest);
}
*OldAskPageJournalSort=\&JournalSort;

View File

@@ -14,7 +14,9 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
use XML::Atom;
use XML::Atom::Entry;
use XML::Atom::Link;
use XML::Atom::Person;

View File

@@ -1,5 +1,6 @@
#!/usr/bin/env perl
use strict;
use v5.10;
# ====================[ autolock.pl ]====================
@@ -174,7 +175,7 @@ sub UserCanEditAutoLockFix {
return 0 if $LockOnCreation{$id} and not -f GetPageFile($id); # new page
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 $CommentsPrefix or $id !~ /^$CommentsPrefix/);
return 1 if $EditAllowed >= 3 and ($comment or (GetParam('aftertext', '') and not GetParam('text', '')));
return 0 if $EditAllowed >= 3;
return 1;

View File

@@ -20,6 +20,7 @@
# ie: http://search.cpan.org/CPAN/authors/id/C/CH/CHAMAS/MLDBM-2.01.tar.gz
use strict;
use v5.10;
use Fcntl;
use MLDBM qw( DB_File Storable );

View File

@@ -11,6 +11,7 @@
# http://www.oddmuse.org/cgi-bin/oddmuse/Backlinks_Extension
use strict;
use v5.10;
AddModuleDescription('backlinks.pl', 'Backlinks Extension');

View File

@@ -25,6 +25,7 @@ the IP or hostname will be added to the C<BannedHosts> page for you.
=cut
use strict;
use v5.10;
our ($q, $Now, %Page, $OpenPageName, %Action, $UrlPattern, $BannedContent, $BannedHosts, @MyAdminCode);
AddModuleDescription('ban-contributors.pl', 'Ban Contributors Extension');
@@ -123,10 +124,10 @@ sub NewBanContributorsWriteRcLog {
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;
my $old = GetTextRevision($Page{revision} - 1, 1)->{text};
my %urls = map {$_ => 1 } $old =~ /$UrlPattern/g;
# we open the file again to force a load of the despammed page
foreach my $url ($Page{text} =~ /$UrlPattern/og) {
foreach my $url ($Page{text} =~ /$UrlPattern/g) {
delete($urls{$url});
}
# we also remove any candidates that are already banned

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2013 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20132015 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
@@ -16,10 +16,11 @@
# editors will be logged.
use strict;
use v5.10;
AddModuleDescription('ban-quick-editors.pl', 'Banning Quick Editors');
our ($Now, %RecentVisitors, $SurgeProtection);
our ($q, $Now, %RecentVisitors, $SurgeProtection);
*BanQuickOldUserIsBanned = \&UserIsBanned;
*UserIsBanned = \&BanQuickNewUserIsBanned;
@@ -29,7 +30,7 @@ sub BanQuickNewUserIsBanned {
if (not $rule
and $SurgeProtection # need surge protection
and GetParam('title')) {
my $name = GetParam('username', GetRemoteHost());
my $name = GetParam('username', $q->remote_addr());
my @entries = @{$RecentVisitors{$name}};
# $entry[0] is $Now after AddRecentVisitor
my $ts = $entries[1];

View File

@@ -13,14 +13,17 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('banned-regexps.pl', 'Banning Regular Expressions');
=h1 Compatibility
=encoding utf8
=head1 Compatibility
This extension works with logbannedcontent.pl.
=h1 Example content for the BannedRegexps page:
=head1 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.

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('bbcode.pl', 'bbCode Extension');
@@ -60,12 +61,12 @@ sub bbCodeRule {
return AddHtmlEnvironment('strong', qq{class="highlight"}); }
elsif ($tag eq 'url') {
if ($option) {
$option =~ /^($UrlProtocols)/o;
$option =~ /^($UrlProtocols)/;
my $class = "url $1";
return AddHtmlEnvironment('a', qq{href="$option" class="$class"}); }
elsif (/\G$FullUrlPattern\s*\[\/url\]/cogi) {
elsif (/\G$FullUrlPattern\s*\[\/url\]/cgi) {
return GetUrl($1); }}
elsif ($tag eq 'img' and /\G$FullUrlPattern\s*\[\/img\]/cogi) {
elsif ($tag eq 'img' and /\G$FullUrlPattern\s*\[\/img\]/cgi) {
return GetUrl($1, undef, undef, 1); } # force image
elsif ($tag eq 'quote') {
my $html = CloseHtmlEnvironments();

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('big-brother.pl', 'Big Brother Extension');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('blockquote.pl', 'Comments on Text Formatting Rules');
@@ -27,10 +28,10 @@ push(@MyRules, \&BlockQuoteRule);
sub BlockQuoteRule {
# indented text using : with the option of spanning multiple text
# paragraphs (but not lists etc).
if (InElement('blockquote') && m/\G(\s*\n)+:[ \t]*/cog) {
if (InElement('blockquote') && m/\G(\s*\n)+:[ \t]*/cg) {
return CloseHtmlEnvironmentUntil('blockquote')
. AddHtmlEnvironment('p');
} elsif ($bol && m/\G(\s*\n)*:[ \t]*/cog) {
} elsif ($bol && m/\G(\s*\n)*:[ \t]*/cg) {
return CloseHtmlEnvironments()
. AddHtmlEnvironment('blockquote')
. AddHtmlEnvironment('p');

View File

@@ -18,6 +18,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('calendar.pl', 'Calendar Extension');
@@ -73,7 +74,7 @@ sub Cal {
$link .= ScriptLink('action=collect;match=' . UrlEncode($re), $day, 'local collection' . $class);
}
$link;
}}ge;
}}eg;
$cal =~ s{(\S+) (\d\d\d\d)}{{
my ($month_text, $year_text) = ($1, $2);
my $date = sprintf("%d-%02d", $year, $mon);
@@ -117,22 +118,22 @@ sub DoCollect {
push(@MyRules, \&CalendarRule);
sub CalendarRule {
if (/\G(calendar:(\d\d\d\d))/gc) {
if (/\G(calendar:(\d\d\d\d))/cg) {
my $oldpos = pos;
Clean(CloseHtmlEnvironments());
Dirty($1);
PrintYearCalendar($2);
pos = $oldpos;
return AddHtmlEnvironment('p');
} elsif (/\G(month:(\d\d\d\d)-(\d\d))/gc) {
} elsif (/\G(month:(\d\d\d\d)-(\d\d))/cg) {
my $oldpos = pos;
Clean(CloseHtmlEnvironments());
Dirty($1);
print Cal($2, $3);
pos = $oldpos;
return AddHtmlEnvironment('p');
} elsif (/\G(month:([+-]\d\d?))/gc
or /\G(\[\[month:([+-]\d\d?) $FreeLinkPattern\]\])/gc) {
} elsif (/\G(month:([+-]\d\d?))/cg
or /\G(\[\[month:([+-]\d\d?) $FreeLinkPattern\]\])/cg) {
my $oldpos = pos;
Clean(CloseHtmlEnvironments());
Dirty($1);

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('canonical.pl', 'Canonical Names');

180
modules/cart.pl Normal file
View File

@@ -0,0 +1,180 @@
# Copyright (C) 2008 Eric Hsu <apricotan@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 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
# Free Software Foundation, Inc.
# 59 Temple Place, Suite 330
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
use utf8;
AddModuleDescription('cart.pl', 'Cart Extension');
our ($q, %Action, $UserGotoBar, $CookieName);
our ($CartPic, $CartName, %Cart, $ShowCart, @CartOrdered);
my $LOADED_CART_JS;
# ============
# = cart-bfc =
# ============
# This is a simple shopping cart for pages!
# Requires searchpaged-bfc.pl.
# We make a checkbox that onChange, uses Yahoo! UI Cookie 2.6 (note we need 2.6!) routines to set a subcookie.
# We have the cookie "$CartName" (by default $Cookiename . "Cart")
# which holds the actual cart and is managed almost entirely
# in client-side javascript. That means the checkboxes directly control the cookie.
# If you want a little picture of a cart, you can set the URL at $CartPic.
# InitCart loads the cookie values into %Cart. $Cart->{$pagename}=1 if it's in the cart.
# In theory cookies are capped at 4K. Our page names are capped around 90ish chars. That leaves room for 40 maximal names in the cart. Probably enough.
# We'll need the cookie values for
# action=cart;subaction=show; along with other future subactions (download in latex, bibtex)
# we'll feed this display to a variant of search display.
# I'll have to check oddmuse.pl.
# load Yahoo UI code bit to manage subcookies.
$Action{cart} = \&DoCart;
sub DoCart {
# foreach $key (keys %Cart) {
# push @cart, $key if ($Cart{"$key"});
# }
DoSearch(\@CartOrdered);
}
$UserGotoBar .= '<a href="?action=cart;cache=0">View Cart</a>';
# Manage Cart Routines
#push @MyPrintSearchResultsPrefix, \&PrintCheckboxTableStart;
#push @MyPrintSearchResultsSuffix, \&PrintCheckboxTableEnd;
# I can't hack into Init, so let's tap into InitCookie.
# We also tap into Cookie() to arrange writing out our cleaned up Cart.
*OldInitCookie = *InitCookie;
*InitCookie = *InitCookieAndCart;
# To get a checkbox in the titles of pages, we patch GetHeader.
*OldGetHeader = *GetHeader;
*GetHeader = *GetHeaderAndCart;
sub InitCookieAndCart {
OldInitCookie();
InitCart();
}
sub GetHeaderAndCart {
my ($id, $title, $oldId, $nocache, $status) = @_;
my $result = OldGetHeader(@_);
return ($result) unless ($id);
my $checkbox = MakeCheckbox($id);
$checkbox = qq(<span class="cart-checkbox" style="float:right">$checkbox</span>);
$result =~ s/(<\/h1>)/$checkbox$1/;
return ($result);
}
# We load the contents of our Cart cookie into the global %Cart and @CartOrdered
sub InitCart {
$CartName = $CookieName . "Cart" unless (defined ($CartName) );
my @pairs;
%Cart = ();
@CartOrdered = ();
if ($q->cookie($CartName)) {
# @pairs = split(/&/, $q->cookie($CartName));
@pairs = $q->cookie($CartName);
foreach my $pair (@pairs) {
# my $encodedequals = UrlEncode("=");
my ($name, $val)= split(/\=/, $pair);
$Cart{"$name"}=$val;
push @CartOrdered, $name;
}
}
}
sub PrintCheckboxTableStart {
my ($name, $regex, $text, $type) = @_;
my $html;
$html .= "<table><tr>";
my $checkbox = MakeCheckbox(@_);
$html .= qq(<td valign=top>$checkbox</td>);
$html .= "<td valign=top>";
print $html;
}
sub PrintCheckboxTableEnd {
my ($name, $regex, $text, $type) = @_;
my $html;
$html .= "</td>";
$html .= "</tr></table>";
print $html;
}
sub MakeCheckbox {
my ($name, $regex, $text, $type) = @_;
my $html;
return unless ($ShowCart);
unless ($LOADED_CART_JS) {
$html .= '<script type="text/javascript" src="http://yui.yahooapis.com/combo?2.7.0/build/yahoo/yahoo-min.js&2.7.0/build/cookie/cookie-min.js&2.7.0/build/event/event-min.js"></script>';
$LOADED_CART_JS=1;
}
my $selected = qq(checked="yes") if ($Cart{"$name"});
$html .=<<HTMLEND;
$CartPic<input type="checkbox" value="cart" id="$name-set" title="Add To Cart" $selected/> <br>
<script type="text/javascript">
(function(){
YAHOO.util.Event.on("$name-set", "change", function(){
var value = YAHOO.util.Cookie.getSub("$CartName", "$name");
if (value == 1 ) { YAHOO.util.Cookie.removeSub("$CartName", "$name"); }
else { YAHOO.util.Cookie.setSub("$CartName", "$name", 1 ); }
});
})();
</script>
HTMLEND
return $html unless ($q->param('action') eq 'edit' || $q->param('Preview'));
# no checkboxes for edit pages.
return;
}
__END__
=
(0.7) Load JS libraries on first checkbox (so won't load if we are editing).
(0.6) Changed the JS source to be Yahoo's CDN.
(0.51) Use CSS class cart-checkbox for the cart checkbox! That way, we can remove them for printouts, for instance.
(0.5) Our hack of cookies was not working cross-platform. We have a mismatch because our attempts to send out a cookie from oddmuse were getting the contents encoded and unreadable for the YUI routines. Instead,we will use removeSub to avoid ever having to send the cookie back from our server!
(0.4) Now every page title has a checkbox floated to the right, which controls the cart status.
(0.3) Allow cart editing from cart display. Currently, doesn't seem to affect the cart.
(0.2) Cart now displays.
(0.1) Cart is now persistent and is edited by the checkboxes.

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('checkbox.pl', 'Checklist Extension');
@@ -76,7 +77,7 @@ sub DoCheckBox{
$summary{$3} = 0 if $2 eq 'x' or $2 eq 'X';
"${1}[[ :${3}]]";
}
}eig;
}egi;
SetParam('text', $text);
SetParam('summary', join(', ', map {
if ($summary{$_}) {

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('clustermap.pl', 'ClusterMap Module');
@@ -61,7 +62,7 @@ foreach (@ClusterMapAdminPages){
}
sub ClusterMapRule {
if (/\G^([\n\r]*\<\s*clustermap\s*\>\s*)$/mgc) {
if (/\G^([\n\r]*\<\s*clustermap\s*\>\s*)$/cgm) {
Dirty($1);
my $oldpos = pos;
my $oldstr = $_;

View File

@@ -14,6 +14,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('comment-div-wrapper.pl', 'Comment Div Wrapper Extension');
@@ -29,7 +30,7 @@ sub CommentDivWrapper {
return $q->start_div({-class=>'userComment'});
}
}
if ($OpenPageName =~ /$CommentsPattern/o) {
if ($OpenPageName =~ /$CommentsPattern/) {
if ($bol and m/\G(\s*\n)*----+[ \t]*\n?/cg) {
my $html = CloseHtmlEnvironments()
. ($CommentDiv++ > 0 ? $q->end_div() : $q->h2({-class=>'commentsHeading'}, T('Comments:'))) . $q->start_div({-class=>'userComment'})

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('commentcount.pl', 'Comment Count Extension');
@@ -51,7 +52,7 @@ sub NewCommentcountScriptLink {
if ($CommentsPrefix && $action =~ /^$CommentsPrefix(.*)/) { # TODO use $CommentsPattern ?
# Add the number of comments here
my $id = $action;
$id =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/ge; # undo urlencode
$id =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eg; # undo urlencode
my $comments = GetPageContent($id);
my $num = 0;
if($comments =~ /=== (\d+) Comments?\. ===/) {

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('compilation.pl', 'Compilation Extension');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('context.pl', 'Calendar Extension');

View File

@@ -24,6 +24,7 @@
# Of course, you can customize this to store more information
use strict;
use v5.10;
AddModuleDescription('creationdate.pl', 'CreationDate Module');

View File

@@ -1,5 +1,6 @@
#!/usr/bin/env perl
use strict;
use v5.10;
# ====================[ creole.pl ]====================
@@ -217,7 +218,7 @@ sub CreoleRule {
}
# escape next char (and prevent // in URLs from enabling italics)
# ~
elsif (m/\G(~($FullUrlPattern|\S))/cgo) {
elsif (m/\G(~($FullUrlPattern|\S))/cg) {
return
($CreoleTildeAlternative and
index( 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -233,12 +234,12 @@ sub CreoleRule {
# {{{preformatted code}}}
elsif (m/\G\{\{\{(.*?}*)\}\}\}/cg) { return $q->code($1); }
# download: {{pic}} and {{pic|text}}
elsif (m/\G(\{\{$FreeLinkPattern$CreoleLinkTextPattern\}\})/cgos) {
elsif (m/\G(\{\{$FreeLinkPattern$CreoleLinkTextPattern\}\})/cgs) {
my $text = $4 || $2;
return GetCreoleLinkHtml($1, GetDownloadLink(FreeToNormal($2), 1, undef, $text), $text);
}
# image link: {{url}} and {{url|text}}
elsif (m/\G\{\{$FullUrlPattern$CreoleLinkTextPattern\}\}/cgos) {
elsif (m/\G\{\{$FullUrlPattern$CreoleLinkTextPattern\}\}/cgs) {
return GetCreoleImageHtml(
$q->a({-href=> UnquoteHtml($1),
-class=> 'image outside'},
@@ -249,7 +250,7 @@ sub CreoleRule {
}
# image link: [[link|{{pic}}]] and [[link|{{pic|text}}]]
elsif (m/\G(\[\[$FreeLinkPattern$CreoleLinkPipePattern
\{\{$FreeLinkPattern$CreoleLinkTextPattern\}\}\]\])/cgosx) {
\{\{$FreeLinkPattern$CreoleLinkTextPattern\}\}\]\])/cgsx) {
my $text = $5 || $2;
return GetCreoleLinkHtml($1, GetCreoleImageHtml(
ScriptLink(UrlEncode(FreeToNormal($2)),
@@ -260,7 +261,7 @@ sub CreoleRule {
}
# image link: [[link|{{url}}]] and [[link|{{url|text}}]]
elsif (m/\G(\[\[$FreeLinkPattern$CreoleLinkPipePattern
\{\{$FullUrlPattern$CreoleLinkTextPattern\}\}\]\])/cgosx) {
\{\{$FullUrlPattern$CreoleLinkTextPattern\}\}\]\])/cgsx) {
my $text = $5 || $2;
return GetCreoleLinkHtml($1, GetCreoleImageHtml(
ScriptLink(UrlEncode(FreeToNormal($2)),
@@ -271,7 +272,7 @@ sub CreoleRule {
}
# image link: [[url|{{pic}}]] and [[url|{{pic|text}}]]
elsif (m/\G(\[\[$FullUrlPattern$CreoleLinkPipePattern
\{\{$FreeLinkPattern$CreoleLinkTextPattern\}\}\]\])/cgosx) {
\{\{$FreeLinkPattern$CreoleLinkTextPattern\}\}\]\])/cgsx) {
my $text = $5 || $2;
return GetCreoleLinkHtml($1, GetCreoleImageHtml(
$q->a({-href=> UnquoteHtml($2), -class=> 'image outside'},
@@ -282,7 +283,7 @@ sub CreoleRule {
}
# image link: [[url|{{url}}]] and [[url|{{url|text}}]]
elsif (m/\G\[\[$FullUrlPattern$CreoleLinkPipePattern
\{\{$FullUrlPattern$CreoleLinkTextPattern\}\}\]\]/cgosx) {
\{\{$FullUrlPattern$CreoleLinkTextPattern\}\}\]\]/cgsx) {
return GetCreoleImageHtml(
$q->a({-href=> UnquoteHtml($1), -class=> 'image outside'},
$q->img({-src=> UnquoteHtml($2),
@@ -291,7 +292,7 @@ sub CreoleRule {
-class=> 'url outside'})));
}
# link: [[url]] and [[url|text]]
elsif (m/\G\[\[$FullUrlPattern$CreoleLinkTextPattern\]\]/cgos) {
elsif (m/\G\[\[$FullUrlPattern$CreoleLinkTextPattern\]\]/cgs) {
# Permit embedding of Creole syntax within link text. (Rather complicated,
# but it does the job remarkably.)
my $link_url = $1;
@@ -304,7 +305,7 @@ sub CreoleRule {
return GetUrl($link_url, $link_text, 1);
}
# link: [[page]] and [[page|text]]
elsif (m/\G(\[\[$FreeLinkPattern$CreoleLinkTextPattern\]\])/cgos) {
elsif (m/\G(\[\[$FreeLinkPattern$CreoleLinkTextPattern\]\])/cgs) {
my $markup = $1;
my $page_name = $2;
my $link_text = $4 ? CreoleRuleRecursive($4, @_) : $page_name;
@@ -314,7 +315,7 @@ sub CreoleRule {
}
# interlink: [[Wiki:page]] and [[Wiki:page|text]]
elsif ($is_interlinking and
m/\G(\[\[$FreeInterLinkPattern$CreoleLinkTextPattern\]\])/cgos) {
m/\G(\[\[$FreeInterLinkPattern$CreoleLinkTextPattern\]\])/cgs) {
my $markup = $1;
my $interlink = $2;
my $interlink_text = $4;

View File

@@ -1,5 +1,6 @@
#!/usr/bin/env perl
use strict;
use v5.10;
# ====================[ creoleaddition.pl ]====================

View File

@@ -1,5 +1,6 @@
#!/usr/bin/env perl
use strict;
use v5.10;
# ====================[ crossbar.pl ]====================

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('crumbs.pl', 'List Parent Pages Extension');
@@ -27,8 +28,8 @@ $RuleOrder{\&CrumbsRule} = -10; # run before default rules!
sub CrumbsRule {
if (not (pos) # first!
and (($WikiLinks && /\G($LinkPattern\n)/cgo)
or ($FreeLinks && /\G(\[\[$FreeLinkPattern\]\]\n)/cgo))) {
and (($WikiLinks && /\G($LinkPattern\n)/cg)
or ($FreeLinks && /\G(\[\[$FreeLinkPattern\]\]\n)/cg))) {
my $oldpos = pos; # will be trashed below
my $cluster = FreeToNormal($2);
my %seen = ($cluster => 1);

View File

@@ -1,4 +1,5 @@
use strict;
use v5.10;
=head1 NAME

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('csv.pl', 'Comments on Long Table Markup Extension');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('dates.pl', 'Dates Extension');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('delete-all.pl');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
our ($q, $Now, %IndexHash, %Action, %Page, $OpenPageName, $FS, $BannedContent, $RcFile, $RcDefault, @MyAdminCode, $FullUrlPattern, $DeletedPage, $StrangeBannedContent);
@@ -132,14 +133,14 @@ sub DespamPage {
# from DoHistory()
my @revisions = sort {$b <=> $a} map { m|/([0-9]+).kp$|; $1; } GetKeepFiles($OpenPageName);
foreach my $revision (@revisions) {
my ($text, $rev) = GetTextRevision($revision, 1); # quiet
my ($revisionPage, $rev) = GetTextRevision($revision, 1); # quiet
if (not $rev) {
print ': ' . Ts('Cannot find revision %s.', $revision);
return;
} elsif (not DespamBannedContent($text)) {
} elsif (not DespamBannedContent($revisionPage->{text})) {
my $summary = Tss('Revert to revision %1: %2', $revision, $rule);
print ': ' . $summary;
Save($OpenPageName, $text, $summary) unless GetParam('debug', 0);
Save($OpenPageName, $revisionPage->{text}, $summary) unless GetParam('debug', 0);
return;
}
}

View File

@@ -14,6 +14,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('diff.pl', 'Diff Action Extension');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('div-foo.pl', 'Div Foo Extension');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('dojo.pl', 'Using Dojo Instead Of Wiki Markup');
@@ -29,7 +30,7 @@ $DojoTheme = 'tundra';
push (@MyRules, \&WysiwygRule);
sub WysiwygRule {
if (m/\G(&lt;.*?&gt;)/gc) {
if (m/\G(&lt;.*?&gt;)/cg) {
return $1 if substr($1,5,6) eq 'script'
or substr($1,4,6) eq 'script';
return UnquoteHtml($1);

View File

@@ -22,6 +22,7 @@
# JavaScript enabled for this to work.
use strict;
use v5.10;
AddModuleDescription('doubleclick.pl', 'Doubleclick Extension');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('download.pl', 'Download Extension');
@@ -27,8 +28,8 @@ push( @MyRules, \&DownloadSupportRule );
# [[download:page name|alternate title]]
sub DownloadSupportRule {
if (m/\G(\[\[download:$FreeLinkPattern\|([^\]]+)\]\])/cog
or m!\G(\[\[download:$FreeLinkPattern\]\])!cog) {
if (m/\G(\[\[download:$FreeLinkPattern\|([^\]]+)\]\])/cg
or m!\G(\[\[download:$FreeLinkPattern\]\])!cg) {
Dirty($1);
print GetDownloadLink($2, undef, undef, $3);
return '';

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
use File::Glob ':glob';
our ($DraftDir);
@@ -28,7 +29,7 @@ push(@MyInitVariables, \&DraftInit);
sub DraftInit {
if (GetParam('Draft', '')) {
SetParam('action', 'draft') ; # Draft button used
} elsif (-f "$DraftDir/" . GetParam('username', GetRemoteHost()) # draft exists
} elsif (-f "$DraftDir/" . GetParam('username', $q->remote_addr()) # draft exists
and $FooterNote !~ /action=draft/) { # take care of mod_perl persistence
$FooterNote = $q->p(ScriptLink('action=draft', T('Recover Draft'))) . $FooterNote;
}
@@ -38,7 +39,7 @@ $Action{draft} = \&DoDraft;
sub DoDraft {
my $id = shift;
my $draft = $DraftDir . '/' . GetParam('username', GetRemoteHost());
my $draft = $DraftDir . '/' . GetParam('username', $q->remote_addr());
if ($id) {
my $text = GetParam('text', '');
ReportError(T('No text to save'), '400 BAD REQUEST') unless $text;
@@ -47,10 +48,10 @@ sub DoDraft {
SetParam('msg', T('Draft saved')); # invalidate cache
print GetHttpHeader('', T('Draft saved'), '204 NO CONTENT');
} elsif (-f $draft) {
my %data = ParseData(ReadFileOrDie($draft));
my $data = ParseData(ReadFileOrDie($draft));
unlink ($draft);
$Message .= $q->p(T('Draft recovered'));
DoEdit($data{id}, $data{text}, 1);
DoEdit($data->{id}, $data->{text}, 1);
} else {
ReportError(T('No draft available to recover'), '404 NOT FOUND');
}

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('duckduckgo-search.pl', 'Use DuckDuckGo For Searches');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('dynamic-comments.pl', 'Dynamic Comments Extension');

View File

@@ -28,6 +28,7 @@
#
use strict;
use v5.10;
AddModuleDescription('dynlogo.pl', 'Dynamic Logo');

View File

@@ -15,6 +15,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('edit-assist.pl', 'Edit Assist Extension');

View File

@@ -14,6 +14,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('edit-cluster.pl', 'Edit Cluster Extension');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('edit-paragraphs.pl', 'Edit Paragraphs Extension');

View File

@@ -11,6 +11,7 @@
# http://www.oddmuse.org/cgi-bin/oddmuse/Email_Quote_Extension
use strict;
use v5.10;
AddModuleDescription('emailquote.pl', 'Email Quote Extension');
@@ -20,14 +21,14 @@ push(@MyRules, \&EmailQuoteRule);
sub EmailQuoteRule {
# > on a line of its own should work
if ($bol && m/\G(\s*\n)*((\&gt;))+\n/cog) {
if ($bol && m/\G(\s*\n)*((\&gt;))+\n/cg) {
return $q->p();
}
# > hi, you mentioned that:
# >> I don't like Oddmuse.
# > in last letter.
elsif ($bol && m/\G(\s*\n)*((\&gt;)+)[ \t]/cog
or InElement('dd') && m/\G(\s*\n)+((\&gt;)+)[ \t]/cog) {
elsif ($bol && m/\G(\s*\n)*((\&gt;)+)[ \t]/cg
or InElement('dd') && m/\G(\s*\n)+((\&gt;)+)[ \t]/cg) {
my $leng = length($2) / 4;
return CloseHtmlEnvironmentUntil('dd') . OpenHtmlEnvironment('dl',$leng, 'quote')
. $q->dt() . AddHtmlEnvironment('dd');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('emoji.pl', 'Smilies');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('enclosure.pl', 'Podcasting');
@@ -27,7 +28,7 @@ push(@MyRules, \&EnclosureRule);
# [[enclosure:url|size in bytes|mime type]]
sub EnclosureRule {
if (m!\G\[\[enclosure:\s*$FreeLinkPattern(\|([^\]]+))?\]\]!ogci) {
if (m!\G\[\[enclosure:\s*$FreeLinkPattern(\|([^\]]+))?\]\]!cgi) {
my $id = FreeToNormal($1);
# Make sure we don't add duplicates; we will add non-existing
# enclosures as well. We test for existence only when the RSS feed
@@ -55,8 +56,8 @@ sub NewEnclosureRssItem {
my $id = shift;
my $rss = OldEnclosureRssItem($id, @_);
require MIME::Base64;
my %data = ParseData(ReadFileOrDie(GetPageFile($id)));
my @enclosures = split(' ', $data{enclosures});
my $data = ParseData(ReadFileOrDie(GetPageFile($id)));
my @enclosures = split(' ', $data->{enclosures});
my $enclosures = '';
foreach my $enclosure (@enclosures) {
# Don't add the enclosure if the page has been deleted in the mean

View File

@@ -24,6 +24,7 @@
# the css classes div.question and div.answer.
use strict;
use v5.10;
AddModuleDescription('faq.pl', 'FAQ Extension');
@@ -37,10 +38,10 @@ $FaqAnswerText = "Answer: " unless $FaqAnswerText;
push(@MyRules, \&FaqRule);
sub FaqRule {
if ($bol && m/\GQ: (.+)/gc) {
if ($bol && m/\GQ: (.+)/cg) {
return $q->a({name=>'FAQ_' . UrlEncode($1)},'')
. $q->div({class=>'question'}, $FaqQuestionText . $1);
} elsif ($bol && m/\GA:[ \t]*/gc) {
} elsif ($bol && m/\GA:[ \t]*/cg) {
return CloseHtmlEnvironments()
. AddHtmlEnvironment('div', "class='answer'") . $FaqAnswerText;
}

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA,
use strict;
use v5.10;
AddModuleDescription('fckeditor.pl', 'Using FCKeditor In Addition To Wiki Markup');
@@ -28,7 +29,7 @@ $FCKeditorHeight = 400; # Pixel
push (@MyRules, \&WysiwygRule);
sub WysiwygRule {
if (m/\G(&lt;.*?&gt;)/gc) {
if (m/\G(&lt;.*?&gt;)/cg) {
return $1 if substr($1,5,6) eq 'script'
or substr($1,4,6) eq 'script';
return UnquoteHtml($1);

View File

@@ -11,6 +11,7 @@
# http://www.oddmuse.org/cgi-bin/oddmuse/Field_List_Extension
use strict;
use v5.10;
AddModuleDescription('fieldlist.pl', 'Field List Extension');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('find.pl', 'Find Extension');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('fix-encoding.pl', 'Fix Encoding');

View File

@@ -1,257 +0,0 @@
#!/usr/bin/env perl
use strict;
# ====================[ flashbox.pl ]====================
=head1 NAME
flashbox - An Oddmuse module for embedding offsite-hosted Flash videos within
an Oddmuse Wiki page - especially those hosted by Google Videos,
YouTube, and SlideShare.
=head1 INSTALLATION
flashbox is easily installable: move this file into the B<wiki/modules/>
directory of your Oddmuse Wiki.
=cut
AddModuleDescription('flashbox.pl', 'Flashbox Extension');
our ($bol, @MyRules, %RuleOrder);
# ....................{ CONFIGURATION }....................
=head1 CONFIGURATION
flashbox is easily configurable: set these variables in the B<wiki/config.pl>
file for your Oddmuse Wiki.
=cut
our ($FlashboxWidth,
$FlashboxHeight);
=head2 $FlashboxWidth
The width of the HTML object "frame" for Flash videos, in pixels.
The default value for this variable is (usually) fine.
=cut
$FlashboxWidth = 420;
=head2 $FlashboxHeight
The height of the HTML object "frame" for Flash videos, in pixels. For any
specific width, a height roughly 83.33% of that width tends to provide a
respectable frame for viewing Flash videos.
The default value for this variable is (usually) fine.
=cut
$FlashboxHeight = 350;
# ....................{ MARKUP }....................
=head1 MARKUP
flashbox provides a few new markup rules. These are:
=over
=item [[GoogleVideo:${GoogleVideoID}]]
=over
=item Embeds the Google Video uniquely identified by ${GoogleVideoID} into the
Oddmuse Wiki page, where ${GoogleVideoID} is the signed integer
following the "docID" parameter in the Google Video URL for that video;
for example, [[GoogleVideo:8649250863235826256]] embeds Derrick Jensen's
"Endgame: Part I" Google Video into the Oddmuse Wiki page.
=back
=item [[YouTube:${YouTubeVideoID}]]
=over
=item Embeds the YouTube video uniquely identified by ${YouTubeVideoID} into the
Oddmuse Wiki page, where ${YouTubeVideoID} is the string following the
"watch?v" parameter in the YouTube URL for that video; for example,
[[YouTube:Q1ZeXnmDZMQ]] embeds James Howard Kunstler's "The Tragedy of
Suburbia TED Talk" YouTube video into the Oddmuse Wiki page.
=back
=item [[SlideShare:${SlideSharePresentationID}]]
=over
=item Embeds the SlideShare presentation uniquely identified by
${SlideSharePresentationID} into the Oddmuse Wiki page, where
${SlideSharePresentationID} is a string composed of the title for that
presentation and an arbitrary signed integer. Unfortunately, this string
is more difficult to obtain than for Google Video and YouTube; for any
given presentation, see the small "Embed" box on that presentation's
SlideShare page and the string following the "doc" parameter in that
box. For example,
[[SlideShare:the-tyranny-of-human-civilization-13479]] embeds
huer1278ft's "The Tyranny of Human Civilization" SlideShare presentation
into the Oddmuse Wiki page.
=back
=back
=cut
push(@MyRules, \&FlashboxRule);
# "FlashboxRule" conflicts with "CreoleRule"-style interpretation of "[[...]]"
# syntax; and must, thus, be applied before that rule.
$RuleOrder{\&FlashboxRule} = -11;
sub FlashboxRule {
if (/\G\[\[googlevideo:([0-9-]+)\]\]/cgi) {
return FlashboxHtml('googlevideo',
"http://video.google.com/googleplayer.swf?docId=${1}&hl=en");
}
elsif (/\G\[\[slideshare:([a-z0-9-]+)\]\]/cgi) {
return FlashboxHtml('slideshare',
"http://static.slideshare.net/swf/ssplayer2.swf?doc=${1}");
}
elsif (/\G\[\[youtube:([a-z0-9-_]{11})\]\]/cgi) {
return FlashboxHtml('youtube',
"http://www.youtube.com/v/${1}");
}
return;
}
sub FlashboxHtml {
my ($paragraph_class, $flashbox_url) = @_;
return
($bol
? CloseHtmlEnvironments().AddHtmlEnvironment('p', qq~class="flashbox ${paragraph_class}"~)
: '').qq~
<object width="${FlashboxWidth}" height="${FlashboxHeight}">
<param name="movie" value="${flashbox_url}"/>
<param name="pluginurl" value="http://www.macromedia.com/go/getflashplayer"/>
<param name="quality" value="high"/>
<param name="wmode" value="transparent"/>
<param name="allowFullScreen" value="true"/>
<param name="allowScriptAccess" value="always"/>
<embed type="application/x-shockwave-flash"
width="${FlashboxWidth}" height="${FlashboxHeight}"
src="${flashbox_url}"
wmode="transparent"
allowscriptaccess="always" allowfullscreen="true"/>
</object>~;
}
=head1 CSS
flashbox also provides a few new HTML classes for CSS-stylizing the HTML emitted
by these markup rules. Of necessity, flashbox embeds Flash videos in an
"<object>...</object>" HTML tag-set; technically, therefore, you can stylize
such videos with a CSS selector resembling:
# This CSS selector selects all HTML-embedded objects (e.g., Flash videos).
object {
# These CSS properties are supposed to horizontally center such objects;
# however, they do not.
margin: 1.500em auto;
padding: 1.500em 0.000em 0.500em 0.000em;
text-align: center;
text-indent: 0.000em;
}
Unfortunately, most browsers ignore most CSS properties on the CSS "object"
selector (including those in the example, above).
To circumvent this, flashbox enwraps all block-level, flashbox-specific markup
(i.e., flashbox-specific markup preceded by at least two newlines) within an
HTML paragraph having two unique classes. This HTML paragraph, unlike the
"<object>...</object>" HTML tag-set, is styleable by all browsers via CSS
selection of these classes:
=over
=item "flashbox"; and
=item "googlevideo", "youtube", or "slideshare" - according to which offsite host
a Flash video is embedded from.
=back
Let's illustrate with a crude example. Suppose some Oddmuse Wiki page contains
this text markup:
In this compelling reading of his, perhaps, most well-read poetry, Carl Sagan
thunders the truth, Vangelis supplies the angels harp and music, and YouTube
plies the photo-montage seas of "this pale, blue dot": our Earth, from afar.
[[YouTube:p86BPM1GV8M]]
Then, flashbox transmutes that text markup into HTML markup resembling:
<p>
In this compelling reading of his, perhaps, most well-read poetry, Carl Sagan
thunders the truth, Vangelis supplies the angels harp and music, and YouTube
plies the photo-montage seas of "this pale, blue dot": our Earth, from afar.
</p>
<p class="flashbox youtube">
<object width="420" height="350">
<param name="movie" value="http://www.youtube.com/v/p86BPM1GV8M"/>
<param name="pluginurl" value="http://www.macromedia.com/go/getflashplayer"/>
<embed type="application/x-shockwave-flash"
width="420" height="350"
src="http://www.youtube.com/v/p86BPM1GV8M"/>
</object>
</p>
Then, your CSS stylesheet can style this HTML markup with CSS resembling:
# This CSS selector selects flashbox-embedded Flash videos.
p.flashbox {
# These CSS properties horizontally center such videos.
margin: 1.500em auto;
padding: 1.500em 0.000em 0.500em 0.000em;
text-align: center;
text-indent: 0.000em;
}
# This CSS selector selects flashbox-embedded, YouTube-specific Flash videos.
p.youtube {
# These CSS properties background and border such videos.
background: #334466;
border: #112255 0.125em solid;
}
Wew! There; that wasn't so gruesomely detailed, was it?
=head1 SEE ALSO
The oddmuse.org "YouTube" page off which this Oddmuse extension was founded, at:
L<http://www.oddmuse.org/cgi-bin/oddmuse/YouTube>
=head1 COPYRIGHT AND LICENSE
The information below applies to everything in this distribution,
except where noted.
Copyleft 2008 by B.w.Curry <http://www.raiazome.com>.
This file 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 file 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 file; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
=cut

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('flickrgallery.pl', 'FlickrGallery Module');
@@ -65,7 +66,7 @@ $RuleOrder{\&FlickrGalleryRule} = -10;
sub FlickrGalleryRule {
# This code is used when Markdown is not available
if (/\G^([\n\r]*\&lt;\s*FlickrSet:\s*(\d+)\s*\&gt;\s*)$/mgci) {
if (/\G^([\n\r]*\&lt;\s*FlickrSet:\s*(\d+)\s*\&gt;\s*)$/cgim) {
my $oldpos = pos;
my $oldstr = $_;
@@ -78,7 +79,7 @@ sub FlickrGalleryRule {
return '';
}
if (/\G^([\n\r]*\&lt;\s*FlickrPhoto:\s*(\d+)\s*([a-z0-9]*?)\s*($size)?\s*\&gt;\s*)$/mgci) {
if (/\G^([\n\r]*\&lt;\s*FlickrPhoto:\s*(\d+)\s*([a-z0-9]*?)\s*($size)?\s*\&gt;\s*)$/cgim) {
my $oldpos = pos;
my $oldstr = $_;
@@ -102,13 +103,13 @@ sub MarkdownFlickrGalleryRule {
^&lt;FlickrSet:\s*(\d+)\s*\>
}{
FlickrGallery($1);
}xmgei;
}egimx;
$text =~ s{
^&lt;FlickrPhoto:\s*(\d+)\s*([a-z0-9]*?)\s*($size)?\s*\>
}{
GetFlickrPhoto($1,$2,$3);
}xmgei;
}egimx;
return $text
}
@@ -134,7 +135,7 @@ sub FlickrGallery {
$result = $FlickrHeaderTemplate;
$result =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/gee;
$result =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/eeg;
# Get list of photos and process them
$url = $FlickrBaseUrl . "?method=flickr.photosets.getPhotos&api_key=" .
@@ -152,7 +153,7 @@ sub FlickrGallery {
my $footer = $FlickrFooterTemplate;
$footer =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/gee;
$footer =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/eeg;
$result .= $footer;
return $result;
@@ -191,7 +192,7 @@ sub FlickrPhoto {
my $output = $FlickrImageTemplate;
$output =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/gee;
$output =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/eeg;
return $output
}

View File

@@ -1,8 +1,11 @@
#!/usr/bin/env perl
use strict;
use v5.10;
# ====================[ footnotes.pl ]====================
=encoding utf8
=head1 NAME
footnotes - An Oddmuse module for adding footnotes to Oddmuse Wiki pages.
@@ -239,13 +242,13 @@ sub FootnotesRule {
# Footnotes and the set of all footnotes must be marked so as to ensure their
# reevaluation, as each of the footnotes might contain Wiki markup requiring
# reevaluation (like, say, free links).
if (m/\G($FootnotePattern)(?=([ \t]*$FootnotePattern)?)/gcos) {
if (m/\G($FootnotePattern)(?=([ \t]*$FootnotePattern)?)/cgs) {
Dirty($1); # do not cache the prefixing "\G"
my $footnote_text = $2;
my $is_adjacent_footnote = defined $3;
# A number range (e.g., "2-5") of references to other footnotes.
if ($footnote_text =~ m/^(\d+)-(\d+)$/o) {
if ($footnote_text =~ m/^(\d+)-(\d+)$/) {
my ($footnote_number_first, $footnote_number_last) = ($1, $2);
# '&#x2013;', below, is the HTML entity for a Unicode en-dash.
print $q->a({-href=> '#footnotes' .$footnote_number_first,
@@ -258,7 +261,7 @@ sub FootnotesRule {
}, $footnote_number_last.($is_adjacent_footnote ? ', ' : ''));
}
# A number (e.g., "5") implying reference to another footnote.
elsif ($footnote_text =~ m/^(\d+)$/o) {
elsif ($footnote_text =~ m/^(\d+)$/) {
my $footnote_number = $1;
print $q->a({-href=> '#footnotes' .$footnote_number,
-title=> 'Footnote #'.$footnote_number,
@@ -282,7 +285,7 @@ sub FootnotesRule {
return '';
}
# The "<footnotes>" list of all footnotes at the foot of a page.
elsif ($bol && m/\G($FootnotesPattern)/gcios) {
elsif ($bol && m/\G($FootnotesPattern)/cgis) {
Clean(CloseHtmlEnvironments());
Dirty($1); # do not cache the prefixing "\G"

View File

@@ -19,6 +19,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('form_timeout.pl', 'Form Timeout Extension');

View File

@@ -1,5 +1,6 @@
#!/usr/bin/env perl
use strict;
use v5.10;
# ====================[ forms.pl ]====================
@@ -18,9 +19,9 @@ sub FormsRule {
my $oldpos = pos;
Clean(CloseHtmlEnvironments());
Dirty($form);
$form =~ s/\%([a-z]+)\%/GetParam($1)/ge;
$form =~ s/\%([a-z]+)\%/GetParam($1)/eg;
$form =~ s/\$([a-z]+)\$/$q->span({-class=>'param'}, GetParam($1))
.$q->input({-type=>'hidden', -name=>$1, -value=>GetParam($1)})/ge;
.$q->input({-type=>'hidden', -name=>$1, -value=>GetParam($1)})/eg;
print UnquoteHtml($form);
pos = $oldpos;
return AddHtmlEnvironment('p');

View File

@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('fractions.pl', 'Fractions');

View File

@@ -7,7 +7,7 @@
#
# Codes reused from questionasker.pl for Oddmuse
# Copyright (C) 2004 Brock Wilcox <awwaiid@thelackthereof.org>
# Copyright (C) 2006, 2007 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20062015 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
@@ -23,10 +23,11 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('gd_security_image.pl', 'GD Security Image Extension');
our ($q, $Now, %Action, $FullUrl, $LinkPattern, $FreeLinks, $FreeLinkPattern, $WikiLinks, $DataDir, $ModuleDir, @MyInitVariables, %CookieParameters, %InvisibleCookieParameters);
our ($q, $Now, %Action, $FullUrl, $LinkPattern, $FreeLinks, $FreeLinkPattern, $WikiLinks, $DataDir, $ModuleDir, @MyInitVariables, %CookieParameters, @MyFormChanges);
=head1 DESCRIPTION
@@ -239,9 +240,9 @@ sub GdSecurityImageCheck {
if ($answer ne '' && GdSecurityImageIsValidId($id)) {
my ($status, $data) = ReadFile(GdSecurityImageGetTicketFile($id));
if ($status) {
my %page = ParseData($data);
if ($page{generation_time} + $GdSecurityImageDuration > $Now) {
if ($answer eq $page{string}) {
my $page = ParseData($data);
if ($page->{generation_time} + $GdSecurityImageDuration > $Now) {
if ($answer eq $page->{string}) {
$GdSecurityImageId = '';
if (!$GdSecurityImageRememberAnswer) {
SetParam('gd_security_image_id', '');
@@ -324,22 +325,10 @@ sub NewGdSecurityImageDoPost {
return (OldGdSecurityImageDoPost(@params));
}
*OldGdSecurityImageGetEditForm = \&GetEditForm;
*GetEditForm = \&NewGdSecurityImageGetEditForm;
sub NewGdSecurityImageGetEditForm {
return GdSecurityImageAddTo(OldGdSecurityImageGetEditForm(@_), $_[1]);
}
*OldGdSecurityImageGetCommentForm = \&GetCommentForm;
*GetCommentForm = \&NewGdSecurityImageGetCommentForm;
sub NewGdSecurityImageGetCommentForm {
return GdSecurityImageAddTo(OldGdSecurityImageGetCommentForm(@_));
}
push(@MyFormChanges, \&GdSecurityImageAddTo);
sub GdSecurityImageAddTo {
my ($form, $upload) = @_;
my ($form, $type, $upload) = @_;
if (not $upload
and not GdSecurityImageException(GetId())
and not UserIsEditor()) {
@@ -396,7 +385,5 @@ sub GdSecurityImageInitVariables {
$GdSecurityImagePngToAA = "$ModuleDir/pngtoaa";
$CookieParameters{'gd_security_image_id'} = '';
$InvisibleCookieParameters{'gd_security_image_id'} = 1;
$CookieParameters{'gd_security_image_answer'} = '';
$InvisibleCookieParameters{'gd_security_image_answer'} = 1;
}

View File

@@ -14,6 +14,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('git-another.pl', 'Another Git Extension');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
=head1 NAME

View File

@@ -17,6 +17,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
our ($q);
our ($GoogleCustomSearchEngine);

View File

@@ -18,41 +18,72 @@ use v5.10;
AddModuleDescription('google-plus-one.pl', 'Google Plus One Module');
our ($q, @MyAdminCode, %Action);
our ($q, $RCName, @MyFooters, @MyAdminCode, %Action, @MyInitVariables, $CommentsPrefix);
my $data_uri = 'data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEwAAAAYCAMAAABnVuv4AAAAhFBMVEUAAAD////MzMz5+fkWau+zs7Pg4OD39/fh4eHu7u7z8/Pk5OTm5ubX19fx8fHj4+N+fn5jY2Ojo6N/f3/r7Ov29vbq6ero6Oj19fUVau0XafC3zO3q6ulKie2dve89ge1yoexkmeyNsepZk+/T3u4weu4jcu7E1Ox9p+rExMTX4vLi6PBsAh6oAAAAAXRSTlMAQObYZgAAAWtJREFUOMvFldluwjAQRU24LgHTpAsEgglL2Nv//7/OeGLLqlTXD5V6HM/c2NJRMJGilClSGCW8DbwEXgPvA+QqRylKI66kLNiKUZri72X6OQOdKxtn8E+yCTMOjQdBhbvEbNkkA5EBoJKULdc0ltHksv447ZaM7JJMNO1PstLZ9Gw2W9PgSxJXe4V1QZZIxiIGI4AbWs5hso1lFY0BwLXzEcBnWK8qJ9uIDKxlMbjyKnex6SoCcO2CKy7xupxZG57GKSBBbsSmp56btYC1t+l5v9vhNI0QmZyZVC+DPKa4IlkHR8f5gD4hQyzb0AhntvAcuo5U3YHzvrWLCJZFmlZ+pp/Rv9k022a75do0ABWKHCTJ9e0923Bmn6ij92xOrAaA1YpvLPZzCrJO+yxLE2Rm7rnfpfc4UjV+x2TLzEBtAvURvYnIl9UDJU8qcsmSL9myMoNs2VMGWtVZHxT9+N310ErVRYpaCToD9QXtvTL0OWiBLQAAAABJRU5ErkJggg==';
# Two step Google +1 button to protect your privacy: show this at the bottom
# of every form.
# Make sure journal pages set a global variable which we then use to
# hide the +1 button.
*MyOldGetCommentForm=*GetCommentForm;
*GetCommentForm=*MyNewGetCommentForm;
*OldGooglePlusPrintJournal = \&PrintJournal;
*PrintJournal = \&NewGooglePlusPrintJournal;
sub MyNewGetCommentForm {
return MyOldGetCommentForm(@_) . qq{
my $GooglePlusThisPagePrintedJournal;
push(@MyInitVariables, sub {
$GooglePlusThisPagePrintedJournal = 0;
});
sub NewGooglePlusPrintJournal {
$GooglePlusThisPagePrintedJournal = 1;
return OldGooglePlusPrintJournal(@_);
}
# Use a two step Google +1 button to protect your privacy: show this
# at the bottom of every page but not on comment pages, Recent
# changes, and pages that printed a journal.
unshift(@MyFooters, \&GooglePlusPrintFooter);
sub GooglePlusPrintFooter {
my ($id, $rev, $comment) = @_;
if (not $GooglePlusThisPagePrintedJournal
and (GetParam('action', 'browse') eq 'plusone'
or (GetParam('action', 'browse') eq 'browse'
and $id
and $id ne $RCName
and (not $CommentsPrefix or $id !~ /^$CommentsPrefix(.*)/)))) {
return q{
<!-- start of Google+ -->
<script type="text/javascript">
function loadScript(jssource,thelink) {
function loadScript(jssource,link_id) {
// add javascript
var jsnode = document.createElement('script');
jsnode.setAttribute('type','text/javascript');
jsnode.setAttribute('src',jssource);
document.getElementsByTagName('head')[0].appendChild(jsnode);
document.getElementById(thelink).innerHTML = "";
// add button
var butn = document.createElement('div');
butn.setAttribute('class', 'g-plusone');
butn.setAttribute('id', 'my_plusone');
var link = document.getElementById(link_id);
link.parentNode.insertBefore(butn, link);
// hide the link
link.innerHTML = "";
}
var plus1source = "https://apis.google.com/js/plusone.js";
</script>
<a id="plus1" href="javascript:loadScript(plus1source,'plus1')">
<img src="$data_uri" alt="Show Google +1" />
</a>
<!-- <g:plusone></g:plusone> -->
<div class="g-plusone" id="my_plusone"></div>
<script type="text/javascript">
document.getElementById("my_plusone").setAttribute("data-size", "medium");
document.getElementById("my_plusone").setAttribute("data-href", document.location.href);
</script>
<p id="plus1">
<a href="javascript:loadScript(plus1source,'plus1')">
<img src="/pics/plusone-h24.png" alt="Show Google +1" />
</a>
</p>
<!-- end of Google+ -->
};
}
}
# Google +1 list
# Google +1 list
push(@MyAdminCode, sub {
my ($id, $menuref, $restref) = @_;
@@ -71,7 +102,7 @@ sub DoPlusOne {
foreach my $id (AllPagesList()) {
push(@pages, $id) if $id =~ /^\d\d\d\d-\d\d-\d\d/;
}
splice(@pages, 0, $#pages - 19); # last 20 items
splice(@pages, 0, $#pages - 19); # last 20 items
print "<ul>";
foreach my $id (@pages) {
my $url = ScriptUrl(UrlEncode($id));

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('google-search.pl', 'Use Google For Searches');

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
our (%Page, %IndexHash, %AdminPages, $HomePage, $RCName, @MyInitVariables, $LinkPattern, $FreeLinkPattern, $FullUrlPattern, $InterLinkPattern, $UserGotoBar, @UserGotoBarPages);
@@ -38,7 +39,7 @@ sub GotobarInit {
@UserGotoBarPages = ();
$UserGotoBar = '';
my $count = 0;
while ($Page{text} =~ m/($LinkPattern|\[\[$FreeLinkPattern\]\]|\[\[$FreeLinkPattern\|([^\]]+)\]\]|\[$InterLinkPattern\s+([^\]]+?)\]|\[$FullUrlPattern[|[:space:]]([^\]]+?)\])/og) {
while ($Page{text} =~ m/($LinkPattern|\[\[$FreeLinkPattern\]\]|\[\[$FreeLinkPattern\|([^\]]+)\]\]|\[$InterLinkPattern\s+([^\]]+?)\]|\[$FullUrlPattern[|[:space:]]([^\]]+?)\])/g) {
my $page = $2||$3||$4||$6||$8;
my $text = $5||$7||$9;
$UserGotoBar .= ' ' if $UserGotoBar;

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2010 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20102015 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
@@ -13,12 +13,13 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
AddModuleDescription('gravatar.pl', 'Gravatar');
use Digest::MD5 qw(md5_hex);
our ($q, $bol, %CookieParameters, $FullUrlPattern, @MyRules, @MyInitVariables);
our ($q, $bol, %CookieParameters, $FullUrlPattern, @MyRules, @MyInitVariables, @MyFormChanges);
# Same as in mail.pl
$CookieParameters{mail} = '';
@@ -28,7 +29,7 @@ my $gravatar_regexp = "\\[\\[gravatar:(?:$FullUrlPattern )?([^\n:]+):([0-9a-f]+)
push(@MyRules, \&GravatarRule);
sub GravatarRule {
if ($bol && m!\G$gravatar_regexp!cog) {
if ($bol && m!\G$gravatar_regexp!cg) {
my $url = $1;
my $gravatar = "https://secure.gravatar.com/avatar/$3";
my $name = FreeToNormal($2);
@@ -45,13 +46,12 @@ sub GravatarRule {
return;
}
*GravatarOldGetCommentForm = \&GetCommentForm;
*GetCommentForm = \&GravatarNewGetCommentForm;
sub GravatarFormAddition {
my ($html, $type) = @_;
# gravatars only make sense for comments
return $html unless $type eq 'comment';
sub GravatarNewGetCommentForm {
my $html = GravatarOldGetCommentForm(@_);
# the implementation in mail.pl takes precedence!
return $html if defined &MailNewGetCommentForm;
my $addition = $q->span({-class=>'mail'},
$q->label({-for=>'mail'}, T('Email: '))
. ' ' . $q->textfield(-name=>'mail', -id=>'mail',
@@ -63,6 +63,12 @@ sub GravatarNewGetCommentForm {
push(@MyInitVariables, \&AddGravatar);
sub AddGravatar {
# the implementation in mail.pl takes precedence!
if (not grep { $_ == \&MailFormAddition } @MyFormChanges) {
push(@MyFormChanges, \&GravatarFormAddition);
}
my $aftertext = UnquoteHtml(GetParam('aftertext'));
my $mail = GetParam('mail');
$mail =~ s/^[ \t]+//;
@@ -84,6 +90,6 @@ sub AddGravatar {
sub GravatarNewGetSummary {
my $summary = GravatarOldGetSummary(@_);
$summary =~ s/^$gravatar_regexp *//o;
$summary =~ s/^$gravatar_regexp *//;
return $summary;
}

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('grep.pl');
@@ -44,7 +45,7 @@ sub PrintGrep {
foreach my $id (AllPagesList()) {
my $text = GetPageContent($id);
next if (TextIsFile($text)); # skip files
while ($text =~ m{($regexp)}ig) {
while ($text =~ m{($regexp)}gi) {
print $q->li(GetPageLink($id) . ': ' . $1);
}
}

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('header-and-footer-templates.pl', 'Comments on HTML Templates');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('headers.pl', 'Header Markup Extension');
@@ -40,7 +41,7 @@ $RuleOrder{\&HeadersRule} = 95;
sub HeadersRule {
my $oldpos = pos;
if ($bol && (m/\G((.+?)[ \t]*\n(---+|===+)[ \t]*\n)/gc)) {
if ($bol && (m/\G((.+?)[ \t]*\n(---+|===+)[ \t]*\n)/cg)) {
my $html = CloseHtmlEnvironments() . ($PortraitSupportColorDiv ? '</div>' : '');
if (substr($3,0,1) eq '=') {
$html .= $q->h2($2);

View File

@@ -18,6 +18,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('headlines.pl', 'Headlines Extension');
@@ -31,7 +32,7 @@ push(@MyRules, \&HeadlinesRule);
$HeadlineNumber = 20;
sub HeadlinesRule {
if (m/\G(\&lt;headlines(:(\d+))?\&gt;)/gci) {
if (m/\G(\&lt;headlines(:(\d+))?\&gt;)/cgi) {
if (($3) and ($3>0)) {$HeadlineNumber = $3;};
Clean(CloseHtmlEnvironments());
Dirty($1);

View File

@@ -1,8 +1,12 @@
#!/usr/bin/env perl
use strict;
use v5.10;
use utf8;
# ====================[ hibernal.pl ]====================
=encoding utf8
=head1 NAME
hibernal - An Oddmuse module for improved multi- and single-blogging.
@@ -1208,7 +1212,7 @@ sub GetHibernalArchiveMonth {
~e;
$html_month =~ s~( {1,2})(\d{1,2})\b~
$1.GetHibernalArchiveMonthDay($post_name_regexp, $year, $month, $2)
~ge;
~eg;
# Float the HTML for each month horizontally past the month preceding it;
# failure to float months in this manner causes these months to stack

View File

@@ -25,6 +25,7 @@
# page cluster.
use strict;
use v5.10;
AddModuleDescription('hiddenpages.pl', 'Hidden Pages Extension');

View File

@@ -1,4 +1,5 @@
use strict;
use v5.10;
=head1 NAME

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('html-template.pl', 'HTML Templates');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('html-uploads.pl', 'Restricted HTML Upload');

View File

@@ -11,6 +11,7 @@
# http://www.oddmuse.org/cgi-bin/oddmuse/Html_Comment_Extension
use strict;
use v5.10;
AddModuleDescription('htmlcomment.pl', 'Html Comment Extension');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('htmllinks.pl', 'HtmlLinks Module');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('image.pl', 'Image Extension');
@@ -31,7 +32,7 @@ push(@MyRules, \&ImageSupportRule);
sub ImageSupportRule {
my $result = undef;
if (m!\G\[\[image((/[a-z]+)*)( external)?:\s*([^]|]+?)\s*(\|[^]|]+?)?\s*(\|[^]|]*?)?\s*(\|[^]|]*?)?\s*(\|[^]|]*?)?\s*\]\](\{([^}]+)\})?!gc) {
if (m!\G\[\[image((/[a-z]+)*)( external)?:\s*([^]|]+?)\s*(\|[^]|]+?)?\s*(\|[^]|]*?)?\s*(\|[^]|]*?)?\s*(\|[^]|]*?)?\s*\]\](\{([^}]+)\})?!cg) {
my $oldpos = pos;
my $class = 'image' . $1;
my $external = $3;

View File

@@ -13,6 +13,7 @@
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
use Digest::SHA qw(sha256_hex);

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('index.pl', 'Index Extension');

View File

@@ -17,6 +17,7 @@
# Boston, MA 02111-1307 USA
use strict;
use v5.10;
AddModuleDescription('irc.pl', 'IRC Log Extension');
@@ -32,7 +33,7 @@ $IrcLinkNick = 0;
# This adds an extra <br> at the beginning. Alternatively, add it to
# the last line, or only add it when required.
sub IrcRule {
if ($bol && m/\G(?:\[?(\d\d?:\d\d(?:am|pm)?)\]?)?\s*&lt;($IrcNickRegexp)&gt; ?/gc) {
if ($bol && m/\G(?:\[?(\d\d?:\d\d(?:am|pm)?)\]?)?\s*&lt;($IrcNickRegexp)&gt; ?/cg) {
my ($time, $nick) = ($1, $2);
my ($error) = ValidId($nick);
# if we're in a dl, close the open dd but not the dl. (if we're

Some files were not shown because too many files have changed in this diff Show More