view release on metacpan or  search on metacpan

lib/Catmandu/Importer/MWTemplates.pm  view on Meta::CPAN

use Catmandu::Sane;
use Furl;
use Moo;

our $VERSION = '0.01';

with 'Catmandu::Importer';

has site => (
    is => 'ro',
    coerce => sub {
        my ($site) = @_;
        if ($site =~ /^[a-z]+([_-][a-z])*$/) {
            $site =~ s/-/_/g;
            $site = "http://$site.wikipedia.org/";
        }
        return $site;
    }
);

has page => (
    is => 'ro'
);

has template => (
    is => 'ro'
);

has wikilinks => (
    is => 'ro',
    default => sub { 1 }
);

has tempname => (
    is => 'ro',
    default => sub { 'TEMPLATE' }
);


sub generator {
    my ($self) = @_;
    
    sub {
        state $templates = $self->_extract;
        return unless $templates and @$templates;
        return shift @$templates;
    }
}

sub _extract {
    my ($self) = @_;
    my $text = "";

    if ($self->site) {
        my $client = Furl->new;
        if (defined $self->page) {
            my $page = $self->page;
            my $url = $self->site . "wiki/$page?action=raw";
            my $res = $client->get($url);
            if ($res->is_success) {
                $text = $res->decoded_content;
            } else {
                die "failed to get $url";
            }
        } else {
            # TODO: read pages from input unless page is set
        }
    } else {
        my $fh = $self->fh;
        $text = do { local $/; <$fh> };
    }

    # TODO: add PAGE if page input mode set

    $self->_extract_template($text);
}

# Parse arguments of one template call
sub _template () {
    my ($self, $result, $name, $parameters) = @_;

    # {{foo bar}} calls Template:Foo_bar with upper case F.
    # Might not work for non-ASCII characters.
    $name = ucfirst($name);
    $name =~ s/ /_/g;

    my $template = { };

    if  (defined ($parameters)) {
        my ($field, $value);
        my $argc = 0;
        $parameters =~ s/^\|\s*(.*?)\s*$/$1/;
        foreach my $arg (split(/\s*\|\s*/, $parameters)) {
            $argc++;
            if ($arg =~ /^([^=]*?)\s*=\s*(.*)$/) {
                $field = $1;
                $value = $2;
            } else {
                $field = $argc;
                $value = $arg;
            }

            if (!$self->wikilinks) {
                $value =~ s/\[\[([^\]]*?)(\$!([^\]]*))?\]\]/$2 ? $3 : $1/eg;
            } elsif ($self->wikilinks == 2) {
                $value =~ s/\[\[([^\]]*?)(\$!([^\]]*))?\]\]/$1/eg;
            } else {
                $value =~ s/\[\[([^\]]*?)(\$!([^\]]*))?\]\]/$2 ? "[[$1|$3]]" : "[[$1]]"/eg;
            }

            $template->{$field} = $value; 
        }
    }

    if (!defined $self->template) {
        $template->{$self->tempname} = $name;
        push @$result, $template;
    } elsif ($self->template eq $name) {
        push @$result, $template;
    }