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

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