101 lines
		
	
	
	
		
			2.6 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			101 lines
		
	
	
	
		
			2.6 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| package Git::Mediawiki;
 | |
| 
 | |
| use 5.008;
 | |
| use strict;
 | |
| use POSIX;
 | |
| use Git;
 | |
| 
 | |
| BEGIN {
 | |
| 
 | |
| our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
 | |
| 
 | |
| # Totally unstable API.
 | |
| $VERSION = '0.01';
 | |
| 
 | |
| require Exporter;
 | |
| 
 | |
| @ISA = qw(Exporter);
 | |
| 
 | |
| @EXPORT = ();
 | |
| 
 | |
| # Methods which can be called as standalone functions as well:
 | |
| @EXPORT_OK = qw(clean_filename smudge_filename connect_maybe
 | |
| 				EMPTY HTTP_CODE_OK HTTP_CODE_PAGE_NOT_FOUND);
 | |
| }
 | |
| 
 | |
| # Mediawiki filenames can contain forward slashes. This variable decides by which pattern they should be replaced
 | |
| use constant SLASH_REPLACEMENT => '%2F';
 | |
| 
 | |
| # Used to test for empty strings
 | |
| use constant EMPTY => q{};
 | |
| 
 | |
| # HTTP codes
 | |
| use constant HTTP_CODE_OK => 200;
 | |
| use constant HTTP_CODE_PAGE_NOT_FOUND => 404;
 | |
| 
 | |
| sub clean_filename {
 | |
| 	my $filename = shift;
 | |
| 	$filename =~ s{@{[SLASH_REPLACEMENT]}}{/}g;
 | |
| 	# [, ], |, {, and } are forbidden by MediaWiki, even URL-encoded.
 | |
| 	# Do a variant of URL-encoding, i.e. looks like URL-encoding,
 | |
| 	# but with _ added to prevent MediaWiki from thinking this is
 | |
| 	# an actual special character.
 | |
| 	$filename =~ s/[\[\]\{\}\|]/sprintf("_%%_%x", ord($&))/ge;
 | |
| 	# If we use the uri escape before
 | |
| 	# we should unescape here, before anything
 | |
| 
 | |
| 	return $filename;
 | |
| }
 | |
| 
 | |
| sub smudge_filename {
 | |
| 	my $filename = shift;
 | |
| 	$filename =~ s{/}{@{[SLASH_REPLACEMENT]}}g;
 | |
| 	$filename =~ s/ /_/g;
 | |
| 	# Decode forbidden characters encoded in clean_filename
 | |
| 	$filename =~ s/_%_([0-9a-fA-F][0-9a-fA-F])/sprintf('%c', hex($1))/ge;
 | |
| 	return substr($filename, 0, NAME_MAX-length('.mw'));
 | |
| }
 | |
| 
 | |
| sub connect_maybe {
 | |
| 	my $wiki = shift;
 | |
| 	if ($wiki) {
 | |
| 		return $wiki;
 | |
| 	}
 | |
| 
 | |
| 	my $remote_name = shift;
 | |
| 	my $remote_url = shift;
 | |
| 	my ($wiki_login, $wiki_password, $wiki_domain);
 | |
| 
 | |
| 	$wiki_login = Git::config("remote.${remote_name}.mwLogin");
 | |
| 	$wiki_password = Git::config("remote.${remote_name}.mwPassword");
 | |
| 	$wiki_domain = Git::config("remote.${remote_name}.mwDomain");
 | |
| 
 | |
| 	$wiki = MediaWiki::API->new;
 | |
| 	$wiki->{config}->{api_url} = "${remote_url}/api.php";
 | |
| 	if ($wiki_login) {
 | |
| 		my %credential = (
 | |
| 			'url' => $remote_url,
 | |
| 			'username' => $wiki_login,
 | |
| 			'password' => $wiki_password
 | |
| 		);
 | |
| 		Git::credential(\%credential);
 | |
| 		my $request = {lgname => $credential{username},
 | |
| 			       lgpassword => $credential{password},
 | |
| 			       lgdomain => $wiki_domain};
 | |
| 		if ($wiki->login($request)) {
 | |
| 			Git::credential(\%credential, 'approve');
 | |
| 			print {*STDERR} qq(Logged in mediawiki user "$credential{username}".\n);
 | |
| 		} else {
 | |
| 			print {*STDERR} qq(Failed to log in mediawiki user "$credential{username}" on ${remote_url}\n);
 | |
| 			print {*STDERR} '  (error ' .
 | |
| 				$wiki->{error}->{code} . ': ' .
 | |
| 				$wiki->{error}->{details} . ")\n";
 | |
| 			Git::credential(\%credential, 'reject');
 | |
| 			exit 1;
 | |
| 		}
 | |
| 	}
 | |
| 
 | |
| 	return $wiki;
 | |
| }
 | |
| 
 | |
| 1; # Famous last words
 |