package WWW::2ch::Plugin::G2;

use strict;
use POSIX; # for mktime
use base qw(WWW::2ch::Plugin::Base);

WWW::2ch::Res->mk_accessors(qw(img imgurl)); # should not?

sub gen_conf {
    my ($self, $conf) = @_;
    my $url = $conf->{url};
    
    my ($host, $bbs, $key);
    if ($url =~ m|^http://([\w\d]+)\.immex\.jp/test/read.cgi/([^/]+)/(\d+)/|i) {
        ($host, $bbs, $key) = ($1, $2, $3);
    }
    elsif ($url =~ m|^http://([\w\d]+)\.immex\.jp/([^/]+)/|i) {
        ($host, $bbs) = ($1, $2);
    }
    else {
        die 'url format error.';
    }
    
    $self->config(+{
        host => $host, 
        domain => "$host.immex.jp", 
        bbs => $bbs, 
        key => $key, 
        setting => "http://$host.immex.jp/$bbs/", 
        subject => "http://$host.immex.jp/$bbs/subject.txt", 
        dat => "http://$host.immex.jp/$bbs/dat/$key.dat", 
        local_path => "$host.immex.jp/$bbs/", 
    });
    $self->config;
}

# SETTING.TXT does not exist
sub parse_setting {
    my ($self, $data) = @_;
    my $config = {};
    
    $data =~ m|<title>(.*?)</title>|;
    $config->{title} = $1 || '';
    $data =~ m|<body.+?background="?([^"\s]+)"?.*?>|;
    $config->{image} = $1;
    $config->{noname} = '';
    $config;
}

sub parse_date {
    my ($self, $data) = @_;
    my $ret = {
        'time' => time, 
        'id' => '', 
        'be' => '', 
        'img' => '', 
    };
    if ($data =~ m|(\d+)/(\d+)/(\d+)\(.+?\) (\d+):(\d+):(\d+)\.?(\d*)|) {
        $ret->{'time'} = mktime($6, $5, $4, $3, $2 - 1, $1 - 1900);
    }
    if ($data =~ / ID:([^ ]+) ?/) {
        $ret->{'id'} = $1;
    }
    if ($data =~ / IMG:(\S+)/) {
        my $img = $1;
	    $ret->{'img'} = $img;
	    $img =~ /^(\d{4})(\d{4})(\d{2})/;
	    my $url = 'http://' . $self->config->{domain} . '/_img/' . $1;
	    $url .= '/' . $1 . $2 . '/' . $3 . '/' . $img;
	    $ret->{'imgurl'} = $url;
    }
    $ret;
}

1;
__END__

=head1 NAME

WWW::2ch::Plugin::G2 - Peculiar processing to g2

=head1 DESCRIPTION

It takes charge of peculiar processing to g2. 

=head1 Method

=over 4

=item * img

uploaded filename

=item * imgurl

url to uploaded filename

=back

=head1 SEE ALSO

L<WWW::2ch>, L<http://g2.immex.jp/>

=head1 AUTHOR

Original by hkrn E<lt>hikarincl2@yahoo.co.jpE<gt>

Kazuhiro Osawa E<lt>ko@yappo.ne.jpE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Kazuhiro Osawa

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

=cut