git.oblomov.eu Git - git/blob - 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);
  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
  34 sub clean_filename {
  35         my $filename = shift;
  36         $filename =~ s{@{[SLASH_REPLACEMENT]}}{/}g;
  37         # [, ], |, {, and } are forbidden by MediaWiki, even URL-encoded.
  38         # Do a variant of URL-encoding, i.e. looks like URL-encoding,
  39         # but with _ added to prevent MediaWiki from thinking this is
  40         # an actual special character.
  41         $filename =~ s/[\[\]\{\}\|]/sprintf("_%%_%x", ord($&))/ge;
  42         # If we use the uri escape before
  43         # we should unescape here, before anything
  44
  45         return $filename;
  46 }
  47
  48 sub smudge_filename {
  49         my $filename = shift;
  50         $filename =~ s{/}{@{[SLASH_REPLACEMENT]}}g;
  51         $filename =~ s/ /_/g;
  52         # Decode forbidden characters encoded in clean_filename
  53         $filename =~ s/_%_([0-9a-fA-F][0-9a-fA-F])/sprintf('%c', hex($1))/ge;
  54         return $filename;
  55 }
  56
  57 sub connect_maybe {
  58         my $wiki = shift;
  59         if ($wiki) {
  60                 return $wiki;
  61         }
  62
  63         my $remote_name = shift;
  64         my $remote_url = shift;
  65         my ($wiki_login, $wiki_password, $wiki_domain);
  66
  67         $wiki_login = Git::config("remote.${remote_name}.mwLogin");
  68         $wiki_password = Git::config("remote.${remote_name}.mwPassword");
  69         $wiki_domain = Git::config("remote.${remote_name}.mwDomain");
  70
  71         $wiki = MediaWiki::API->new;
  72         $wiki->{config}->{api_url} = "${remote_url}/api.php";
  73         if ($wiki_login) {
  74                 my %credential = (
  75                         'url' => $remote_url,
  76                         'username' => $wiki_login,
  77                         'password' => $wiki_password
  78                 );
  79                 Git::credential(\%credential);
  80                 my $request = {lgname => $credential{username},
  81                                lgpassword => $credential{password},
  82                                lgdomain => $wiki_domain};
  83                 if ($wiki->login($request)) {
  84                         Git::credential(\%credential, 'approve');
  85                         print {*STDERR} qq(Logged in mediawiki user "$credential{username}".\n);
  86                 } else {
  87                         print {*STDERR} qq(Failed to log in mediawiki user "$credential{username}" on ${remote_url}\n);
  88                         print {*STDERR} '  (error ' .
  89                                 $wiki->{error}->{code} . ': ' .
  90                                 $wiki->{error}->{details} . ")\n";
  91                         Git::credential(\%credential, 'reject');
  92                         exit 1;
  93                 }
  94         }
  95
  96         return $wiki;
  97 }
  98
  99 1; # Famous last words