root/lang/perl/plagger/assets/plugins/CustomFeed-Script/comiclist_jp.pl @ 38817

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;

use DateTime;
use DateTime::Duration;
use Encode qw( decode );
use URI;
use Web::Scraper 0.22;
use YAML;

my $url = 'http://comiclist.jp/index.php?p=n';
my $s = scraper {
    process '//table[@class="list_font"]/tr[position()>1]', 'entry[]' => scraper {
        process '/tr/td[1]',
            date => [
                'text',
                sub {
                    m!^(.*?)/(.*?)$! or return;
                    return +{ month => $1, day => $2 };
                },
                \&mk_date,
            ],
            part => ['text', sub { s!^.*?/!!; $_ } ];
        process '/tr/td[2]', publisher => 'text';
        process '/tr/td[3]', title => 'text';
        process '/tr/td[4]', author => 'text';
        process '/tr/td[5]', price => 'text';
        process '/tr/td[6]', note => ['text', sub { s/^\s+|\s+$//g; $_ } ];
        result qw( date part publisher title author price note );
    };
    result qw( entry );
};
$s->user_agent->env_proxy;

### get the number of pages
my $res = $s->user_agent->get($url);
$res->is_success or die "GET $url failed: " . $res->status_line;
my $content = decode('cp932', $res->content);
my $num_pages = 0;
while($content =~ /<input[^>]+name="pg_num"[^>]+value="(\d+)"/sg) {
    $num_pages = $1 if $num_pages < $1;
}

### get pages by POST method
my @entry;
for(my $i = 1; $i <= $num_pages; ++$i) {
    my $res = $s->user_agent->post($url, [pg_num => $i]);
    $res->is_success or die "POST $url failed: " . $res->status_line;
    my $content = decode('cp932', $res->content);
    push @entry, @{ $s->scrape($content) };
}

### make body
for my $e (@entry) {
    # 1. base: author, publisher, and price
    $e->{body} = join ', ', map { $e->{$_} } qw( author publisher price );
    # 2. add part if exists
    $e->{body} = join ', ', map { $e->{$_} } qw( part body ) unless $e->{part} =~ /^\d+$/;
    # 3. add note if exists
    $e->{body} = join ', ', map { $e->{$_} } qw( body note ) if $e->{note};
    # 4. delete unnecessary elements
    delete $e->{$_} for qw( part publisher price note );
}

binmode STDOUT, ':utf8';
print Dump +{
    title => 'comiclist.jp コミック発売予定一覧',
    link  => $url,
    entry => \@entry,
};

sub mk_date {
    return unless defined $_;
    $_->{day} = &part_to_day($_->{day});
    my $date = &guess_year($_);
    return $date->ymd;
}

sub part_to_day {
    my $part = shift;
    return unless defined $part;
    return $part if $part =~ /^\d+$/;
    return 21 if $part =~ /下/;
    return 11 if $part =~ /中/;
    return 1;
}

sub guess_year {
    my $value = shift;
    return unless defined $value;
    my $now  = DateTime->now(time_zone => 'Asia/Tokyo');
    my $this = $now->clone->truncate(to => 'year')->set(%$value);
    my $last = $this->clone->subtract(years => 1);
    my $next = $this->clone->add(years => 1);
    my @date = sort { DateTime::Duration->compare($a->[1], $b->[1], $now) }
               map { [$_->[0], $_->[1]->is_positive ? $_->[1] : $_->[1]->inverse ] }
               map { [$_, $now - $_] } ($this, $last, $next);
    $date[0]->[0];
}

__END__