|
| 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 |
0 commit comments