Merge branch 'cl/t9001-cleanup'
[git] / contrib / mw-to-git / Git / Mediawiki.pm
1 package Git::Mediawiki;
2
3 use 5.008;
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