102 lines
2.6 KiB
Perl
102 lines
2.6 KiB
Perl
|
package Git::Mediawiki;
|
||
|
|
|
||
|
|
use 5.008;
|
||
|
|
use strict;
|
||
|
|
use POSIX;
|
||
|
|
use Git;
|
||
|
|
|
||
|
|
BEGIN {
|
||
|
|
|
||
|
|
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
|
||
|
|
|
||
|
|
# Totally unstable API.
|
||
|
|
$VERSION = '0.01';
|
||
|
|
|
||
|
|
require Exporter;
|
||
|
|
|
||
|
|
@ISA = qw(Exporter);
|
||
|
|
|
||
|
|
@EXPORT = ();
|
||
|
|
|
||
|
|
# Methods which can be called as standalone functions as well:
|
||
|
|
@EXPORT_OK = qw(clean_filename smudge_filename connect_maybe
|
||
|
|
EMPTY HTTP_CODE_OK HTTP_CODE_PAGE_NOT_FOUND);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Mediawiki filenames can contain forward slashes. This variable decides by which pattern they should be replaced
|
||
|
|
use constant SLASH_REPLACEMENT => '%2F';
|
||
|
|
|
||
|
|
# Used to test for empty strings
|
||
|
|
use constant EMPTY => q{};
|
||
|
|
|
||
|
|
# HTTP codes
|
||
|
|
use constant HTTP_CODE_OK => 200;
|
||
|
|
use constant HTTP_CODE_PAGE_NOT_FOUND => 404;
|
||
|
|
|
||
|
|
sub clean_filename {
|
||
|
|
my $filename = shift;
|
||
|
|
$filename =~ s{@{[SLASH_REPLACEMENT]}}{/}g;
|
||
|
|
# [, ], |, {, and } are forbidden by MediaWiki, even URL-encoded.
|
||
|
|
# Do a variant of URL-encoding, i.e. looks like URL-encoding,
|
||
|
|
# but with _ added to prevent MediaWiki from thinking this is
|
||
|
|
# an actual special character.
|
||
|
|
$filename =~ s/[\[\]\{\}\|]/sprintf("_%%_%x", ord($&))/ge;
|
||
|
|
# If we use the uri escape before
|
||
|
|
# we should unescape here, before anything
|
||
|
|
|
||
|
|
return $filename;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub smudge_filename {
|
||
|
|
my $filename = shift;
|
||
|
|
$filename =~ s{/}{@{[SLASH_REPLACEMENT]}}g;
|
||
|
|
$filename =~ s/ /_/g;
|
||
|
|
# Decode forbidden characters encoded in clean_filename
|
||
|
|
$filename =~ s/_%_([0-9a-fA-F][0-9a-fA-F])/sprintf('%c', hex($1))/ge;
|
||
|
|
return substr($filename, 0, NAME_MAX-length('.mw'));
|
||
|
|
}
|
||
|
|
|
||
|
|
sub connect_maybe {
|
||
|
|
my $wiki = shift;
|
||
|
|
if ($wiki) {
|
||
|
|
return $wiki;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $remote_name = shift;
|
||
|
|
my $remote_url = shift;
|
||
|
|
my ($wiki_login, $wiki_password, $wiki_domain);
|
||
|
|
|
||
|
|
$wiki_login = Git::config("remote.${remote_name}.mwLogin");
|
||
|
|
$wiki_password = Git::config("remote.${remote_name}.mwPassword");
|
||
|
|
$wiki_domain = Git::config("remote.${remote_name}.mwDomain");
|
||
|
|
|
||
|
|
$wiki = MediaWiki::API->new;
|
||
|
|
$wiki->{config}->{api_url} = "${remote_url}/api.php";
|
||
|
|
if ($wiki_login) {
|
||
|
|
my %credential = (
|
||
|
|
'url' => $remote_url,
|
||
|
|
'username' => $wiki_login,
|
||
|
|
'password' => $wiki_password
|
||
|
|
);
|
||
|
|
Git::credential(\%credential);
|
||
|
|
my $request = {lgname => $credential{username},
|
||
|
|
lgpassword => $credential{password},
|
||
|
|
lgdomain => $wiki_domain};
|
||
|
|
if ($wiki->login($request)) {
|
||
|
|
Git::credential(\%credential, 'approve');
|
||
|
|
print {*STDERR} qq(Logged in mediawiki user "$credential{username}".\n);
|
||
|
|
} else {
|
||
|
|
print {*STDERR} qq(Failed to log in mediawiki user "$credential{username}" on ${remote_url}\n);
|
||
|
|
print {*STDERR} ' (error ' .
|
||
|
|
$wiki->{error}->{code} . ': ' .
|
||
|
|
$wiki->{error}->{details} . ")\n";
|
||
|
|
Git::credential(\%credential, 'reject');
|
||
|
|
exit 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return $wiki;
|
||
|
|
}
|
||
|
|
|
||
|
|
1; # Famous last words
|