contrib / mw-to-git / Git / Mediawiki.pmon commit Merge branch 'st/lib-gpg-kill-stray-agent' (a6f1456)
   1package Git::Mediawiki;
   2
   3use 5.008;
   4use strict;
   5use Git;
   6
   7BEGIN {
   8
   9our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
  10
  11# Totally unstable API.
  12$VERSION = '0.01';
  13
  14require Exporter;
  15
  16@ISA = qw(Exporter);
  17
  18@EXPORT = ();
  19
  20# Methods which can be called as standalone functions as well:
  21@EXPORT_OK = qw(clean_filename smudge_filename connect_maybe
  22                                EMPTY HTTP_CODE_OK HTTP_CODE_PAGE_NOT_FOUND);
  23}
  24
  25# Mediawiki filenames can contain forward slashes. This variable decides by which pattern they should be replaced
  26use constant SLASH_REPLACEMENT => '%2F';
  27
  28# Used to test for empty strings
  29use constant EMPTY => q{};
  30
  31# HTTP codes
  32use constant HTTP_CODE_OK => 200;
  33use constant HTTP_CODE_PAGE_NOT_FOUND => 404;
  34
  35sub clean_filename {
  36        my $filename = shift;
  37        $filename =~ s{@{[SLASH_REPLACEMENT]}}{/}g;
  38        # [, ], |, {, and } are forbidden by MediaWiki, even URL-encoded.
  39        # Do a variant of URL-encoding, i.e. looks like URL-encoding,
  40        # but with _ added to prevent MediaWiki from thinking this is
  41        # an actual special character.
  42        $filename =~ s/[\[\]\{\}\|]/sprintf("_%%_%x", ord($&))/ge;
  43        # If we use the uri escape before
  44        # we should unescape here, before anything
  45
  46        return $filename;
  47}
  48
  49sub smudge_filename {
  50        my $filename = shift;
  51        $filename =~ s{/}{@{[SLASH_REPLACEMENT]}}g;
  52        $filename =~ s/ /_/g;
  53        # Decode forbidden characters encoded in clean_filename
  54        $filename =~ s/_%_([0-9a-fA-F][0-9a-fA-F])/sprintf('%c', hex($1))/ge;
  55        return $filename;
  56}
  57
  58sub connect_maybe {
  59        my $wiki = shift;
  60        if ($wiki) {
  61                return $wiki;
  62        }
  63
  64        my $remote_name = shift;
  65        my $remote_url = shift;
  66        my ($wiki_login, $wiki_password, $wiki_domain);
  67
  68        $wiki_login = Git::config("remote.${remote_name}.mwLogin");
  69        $wiki_password = Git::config("remote.${remote_name}.mwPassword");
  70        $wiki_domain = Git::config("remote.${remote_name}.mwDomain");
  71
  72        $wiki = MediaWiki::API->new;
  73        $wiki->{config}->{api_url} = "${remote_url}/api.php";
  74        if ($wiki_login) {
  75                my %credential = (
  76                        'url' => $remote_url,
  77                        'username' => $wiki_login,
  78                        'password' => $wiki_password
  79                );
  80                Git::credential(\%credential);
  81                my $request = {lgname => $credential{username},
  82                               lgpassword => $credential{password},
  83                               lgdomain => $wiki_domain};
  84                if ($wiki->login($request)) {
  85                        Git::credential(\%credential, 'approve');
  86                        print {*STDERR} qq(Logged in mediawiki user "$credential{username}".\n);
  87                } else {
  88                        print {*STDERR} qq(Failed to log in mediawiki user "$credential{username}" on ${remote_url}\n);
  89                        print {*STDERR} '  (error ' .
  90                                $wiki->{error}->{code} . ': ' .
  91                                $wiki->{error}->{details} . ")\n";
  92                        Git::credential(\%credential, 'reject');
  93                        exit 1;
  94                }
  95        }
  96
  97        return $wiki;
  98}
  99
 1001; # Famous last words