package tasks::SourceUploader::WikiPod;
use utf8;
use strict;
use Pod::Simple::Wiki;
use Pod::Simple::Wiki::Mediawiki;
use URI;
use Data::Dumper;
use vars qw(@ISA);
@ISA=qw/Pod::Simple::Wiki::Mediawiki/;
sub new {
my $class = shift;
my $self = Pod::Simple::Wiki->new('mediawiki', @_);
# Set encoding
$self->encoding( 'utf8' ) if $self->can('encoding');
# New "A<>" code handling
$self->{_A_base} = shift;
$self->accept_codes('A');
# Override stupid choice of tags
$self->{_tags} = {
%{$self->{_tags}},
'<tt>' => '<code>',
'</tt>' => '</code>',
'<pre>' => "<pre>\n",
'</pre>' => "\n</pre>\n",
};
# For indentation.
$self->{_indent_chars} = '';
$self->{_last_indent_chars} = '';
bless $self, $class;
return $self;
}
# New "A<>" code handling
sub _start_A {
my $self=shift;
$self->_append('');
$self->_output; # Flush text buffer
}
sub _end_A {
my $self=shift;
my $link="$self->{_A_base}/$self->{_wiki_text}";
if($link=~/::/){
$link=~s!::!/!g;
$link.='.pm';
}
$self->{_wiki_text} = "[[$link|$self->{_wiki_text}]]";
}
# Fix indentation and multiple =items with no intervening paragraph.
sub _start_over_bullet { $_[0]->{_item_indent}++; $_[0]->{_indent_chars} .= '*'; }
sub _start_over_number { $_[0]->{_item_indent}++; $_[0]->{_indent_chars} .= '#'; }
sub _start_over_text { $_[0]->{_item_indent}++; $_[0]->{_indent_chars} .= ':'; }
sub _start_over_block { $_[0]->{_item_indent}++; $_[0]->{_indent_chars} .= ':'; }
sub _end_over_bullet {
$_[0]->{_item_indent}--;
$_[0]->{_indent_chars} = substr( $_[0]->{_indent_chars}, 0, $_[0]->{_item_indent} );
$_[0]->_output( "\n" ) unless $_[0]->{_item_indent};
}
sub _end_over_number {
$_[0]->{_item_indent}--;
$_[0]->{_indent_chars} = substr( $_[0]->{_indent_chars}, 0, $_[0]->{_item_indent} );
$_[0]->_output( "\n" ) unless $_[0]->{_item_indent};
}
sub _end_over_text {
$_[0]->{_item_indent}--;
$_[0]->{_indent_chars} = substr( $_[0]->{_indent_chars}, 0, $_[0]->{_item_indent} );
$_[0]->_output( "\n" ) unless $_[0]->{_item_indent};
}
sub _end_over_block {
$_[0]->{_item_indent}--;
$_[0]->{_indent_chars} = substr( $_[0]->{_indent_chars}, 0, $_[0]->{_item_indent} );
}
sub _indent_item {
my $self=shift;
my $item_type = $_[0];
my $item_param = $_[1];
my $indent_chars = $self->{_indent_chars};
if ( $item_type eq 'text' ) {
# Avoid a MediaWiki listgap bug.
$self->_append( $indent_chars . "\n" ) if length( $self->{_last_indent_chars} ) > length( $indent_chars );
$self->_append( substr( $indent_chars, 0, $self->{_item_indent} - 1 ) . '; ');
} else {
$self->_append($indent_chars . ' ');
}
$self->{_last_indent_chars} = $indent_chars;
}
sub _end_item_text { $_[0]->_output("\n"); }
sub _start_Para {
my $self = shift;
my $indent_chars = $self->{_indent_chars};
if ( $indent_chars ne '' ) {
$self->{_indent_text} = $indent_chars . ' ';
$self->{_last_indent_chars} = $indent_chars;
}
}
# Fix link formatting
sub _format_link {
my ($self, $text, $attr) = @_;
if ($attr->{type} eq 'url') {
my $link = $attr->{to};
if($link=~m(^(?:https?|ftp|irc|mailto|svn|git)://)){
return $link if $attr->{'content-implicit'};
return "[$link $text]";
} else {
$link=~s/_/ /g;
($text=$link)=~s/^[^:]*:// if $attr->{'content-implicit'};
return "[[:$link|$text]]";
}
}
if ($attr->{type} eq 'man') {
if($attr->{to}=~/^(.+)\(([^)]+)\)$/){
my ($page,$section)=($1,$2);
my $src='';
$src='perldoc' if $page=~/^perl/i || $section eq '3perl';
$src='Linux' if $section eq '3pm'; # "default" doesn't have perl module manpages.
return "{{man|$section|$page|$src||inline}}" if(!defined($attr->{section}) && $attr->{'content-implicit'});
$src='default' if $src eq '';
my $link="{{man/$src|$section|$page|url}}";
$link.="#".$attr->{section} if defined $attr->{section};
return "{{man/format|$section|$page|$link}}" if $attr->{'content-implicit'};
return "[$link $text]";
}
}
die "Unknown link type $attr->{type}" unless $attr->{type} eq 'pod';
# Handle a link within this page:
return "[[#$attr->{section}|$text]]" unless defined $attr->{to};
# Handle a link to a specific section in another page:
return "[[$attr->{to}#$attr->{section}|$text]]" if defined $attr->{section};
return "[[$attr->{to}]]" if $attr->{'content-implicit'};
return "[[$attr->{to}|$text]]";
}
1;