User:AnomieBOT/source/tasks/SourceUploader/Pod.pm

package tasks::SourceUploader::Pod;

use utf8;
use strict;
use Pod::Simple;
use Data::Dumper;

use vars qw(@ISA);
@ISA=qw/Pod::Simple/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->encoding( 'utf8' ) if $self->can('encoding');
    $self->accept_targets('*');
    $self->{'stack'}=[];
    $self->{'metadata'}={};
    bless  $self, $class;
    return $self;
}

sub metadata {
    my $self=shift;
    return %{$self->{'metadata'}};
}

# The methods _handle_element_start() _handle_element_end() and _handle_text()
# are called by Pod::Simple in response to Pod constructs.
sub _handle_element_start {
    my $self = shift;
    if($_[0] eq 'for'){
        push @{$self->{'stack'}}, {
            target=>$_[1]{'target'},
            para=>[],
            line=>$_[1]{'line_number'} // $self->line_count
        };
    } elsif($_[0] eq 'Data'){
        my $s=$self->{'stack'};
        push @{$s->[$#$s]{'para'}}, '';
    }
}

sub _handle_text {
    my $self = shift;
    my $s=$self->{'stack'};
    return unless @$s;
    $s=$s->[$#$s]{'para'};
    return unless @$s;
    my $txt = $_[0];
    $txt=~s/\r\n/\n/g;
    $txt=~s/\r/\n/g;
    $s->[$#$s].=$txt;
}

sub _handle_element_end {
    my $self = shift;
    return unless $_[0] eq 'for';

    my $fh=$self->output_fh;
    my $x = pop @{$self->{'stack'}};
    return if !defined($x);
    my $func=$self->can('_handle_target_'.$x->{'target'});
    $func->($self, $x->{'para'}, $x->{'line'}) if $func;
}

sub _handle_target_metadata {
    my $self=shift;
    my @para=@{shift()};
    my $line=shift;

    $para[0]=~s/\n\s+/ /g;
    my @head=split(/\n/, shift @para);
    my %metadata=();
    foreach (@head){
        s/^\s*|\s*$//g;
        if(!/^(\S+?):\s*(.*)$/){
            die("Bad header line in metadata block at $line");
            next;
        }
        if(substr($1,0,1) eq '+'){
            $metadata{lc($1)}=[] unless exists($metadata{lc($1)});
            push @{$metadata{lc($1)}}, $2;
        } else {
            $metadata{lc($1)}=$2;
        }
    }
    my $text=join("\n\n", @para);
    $text=~s/([^\n])\n(?=[a-zA-Z0-9< ])/$1 /g; # unwrap lines
    $metadata{'*'}=$text;
    $self->{'metadata'}=\%metadata;
}

sub _handle_target_info {
    my $self=shift;
    my $text=join("\n\n", @{$_[0]});
    $text=~s/\n(?=[a-zA-Z0-9])/ /g; # unwrap lines
    print {$self->output_fh} "\x7b\x7bombox|type=notice|text=$text\x7d\x7d\n";
}

sub _handle_target_notice {
    my $self=shift;
    my $text=join("\n\n", @{$_[0]});
    $text=~s/\n(?=[a-zA-Z0-9])/ /g; # unwrap lines
    print {$self->output_fh} "\x7b\x7bombox|type=content|text=$text\x7d\x7d\n";
}

sub _handle_target_warning {
    my $self=shift;
    my $text=join("\n\n", @{$_[0]});
    $text=~s/\n(?=[a-zA-Z0-9])/ /g; # unwrap lines
    print {$self->output_fh} "\x7b\x7bombox|type=content|style=border:1px solid #b22222|image=\x5b\x5bImage:Ambox warning pn.svg|40px\x5d\x5d|text=$text\x7d\x7d\n";
}

1;