1
0
Fork 0
mirror of https://github.com/git/git.git synced 2024-05-13 04:06:10 +02:00
git/contrib/mw-to-git/Git/Mediawiki.pm
Todd Zullinger d13a73e383 perl: bump the required Perl version to 5.8.1 from 5.8.0
The following commit will make use of a Getopt::Long feature which is
only present in Perl >= 5.8.1.  Document that as the minimum version we
support.

Many of our Perl scripts will continue to run with 5.8.0 but this change
allows us to adjust them as needed without breaking any promises to our
users.

The Perl requirement was last changed in d48b284183 (perl: bump the
required Perl version to 5.8 from 5.6.[21], 2010-09-24).  At that time,
5.8.0 was 8 years old.  It is now over 21 years old.

Signed-off-by: Todd Zullinger <tmz@pobox.com>
Signed-off-by: Junio C Hamano <gitster@pobox.com>
2023-11-17 07:26:32 +09:00

102 lines
2.6 KiB
Perl

package Git::Mediawiki;
use 5.008001;
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