contrib/mw-to-git/Git/Mediawiki.pm

   1 package Git::Mediawiki;
   2
   3 use 5.008;
   4 use strict;
   5 use Git;
   6
   7 BEGIN {
   8
   9 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
  10
  11 # Totally unstable API.
  12 $VERSION = '0.01';
  13
  14 require 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
  26 use constant SLASH_REPLACEMENT => '%2F';
  27
  28 # Used to test for empty strings
  29 use constant EMPTY => q{};
  30
  31 # HTTP codes
  32 use constant HTTP_CODE_OK => 200;
  33 use constant HTTP_CODE_PAGE_NOT_FOUND => 404;
  34
  35 sub 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
  49 sub 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
  58 sub 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
 100 1; # Famous last words