package WWW::FetchStory::Fetcher::AO3;
$WWW::FetchStory::Fetcher::AO3::VERSION = '0.2602';
use strict;
use warnings;
=head1 NAME

WWW::FetchStory::Fetcher::AO3 - fetching module for WWW::FetchStory

=head1 VERSION

version 0.2602

=head1 DESCRIPTION

This is the AO3 story-fetching plugin for WWW::FetchStory.

=cut

use parent qw(WWW::FetchStory::Fetcher);
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use YAML::Any;
use Path::Tiny;

=head1 METHODS

=head2 info

Information about the fetcher.

$info = $self->info();

=cut

sub info {
    my $self = shift;
    
    my $info = "http://www.archiveofourown.org AO3 General fanfic archive";

    return $info;
} # info

=head2 priority

The priority of this fetcher.  Fetchers with higher priority
get tried first.  This is useful where there may be a generic
fetcher for a particular site, and then a more specialized fetcher
for particular sections of a site.  For example, there may be a
generic Livejournal fetcher, and then refinements for particular
Livejournal community, such as the sshg_exchange community.
This works as either a class function or a method.

$priority = $self->priority();

$priority = WWW::FetchStory::Fetcher::priority($class);

=cut

sub priority {
    my $class = shift;

    return 1;
} # priority

=head2 allow

If this fetcher can be used for the given URL, then this returns
true.
This must be overridden by the specific fetcher class.

    if ($obj->allow($url))
    {
	....
    }

=cut

sub allow {
    my $self = shift;
    my $url = shift;

    if (-f $url and $url =~ /\.html$/) # is a HTML file, not a URL
    {
        # We can figure out if this is from AO3 by looking inside it
        my $path = path($url);
        my $contents = $path->slurp;
        return ($contents =~ m!<meta name="author" content="Organization for Transformative Works" />!);
    }
    else
    {
        return ($url =~ /archiveofourown\.org/ || $url =~ /ao3\.org/);
    }
} # allow

=head1 Private Methods

=head2 get_toc

Get a table-of-contents page.
If we already have a downloaded EPUB file
then we extract the needed pages from that instead.

=cut
sub get_toc {
    my $self = shift;
    my %args = @_;

    if ($args{use_file} and $args{use_file} =~ /epub$/)
    {
        my $file = $args{use_file};
        my $zip = Archive::Zip->new();
        my $status = $zip->read( $file );
        if ($status != AZ_OK)
        {
            die "Failed to read $file";
        }
        # The AO3 EPUB files are generated by Calibre
        # and have predictable names.
        # The meta-data for the story is contained in
        # (name)_split_000.xhtml and
        # (name)_split_001.xhtml
        my @html_members = $zip->membersMatching('.*_split_00[0-1]\.xhtml');
        my $toc_content = '';
        my $first_title = '';
        for (my $i = 0; $i < @html_members; $i++)
        {
            my $html = $zip->contents($html_members[$i]);
            my ($body,$title) = $self->extract_story(content=>$html);
            $first_title = $title if !$first_title;
            $toc_content .= $body;
        }
        my $toc_page = "<html>
<head><title>$first_title</title></head>
<body>
$toc_content
</body></html>
";
        return $toc_page;
    }
    else
    {
	return $self->SUPER::get_toc(%args);
    }
} # get_toc

=head2 parse_toc

Parse the table-of-contents file.

    %info = $self->parse_toc(content=>$content,
			 url=>$url,
			 urls=>\@urls);

This should return a hash containing:

=over

=item chapters

An array of URLs for the chapters of the story.  In the case where the
story only takes one page, that will be the chapter.
In the case where multiple URLs have been passed in, it will be those URLs.

=item title

The title of the story.

=back

It may also return additional information, such as Summary.

=cut

sub parse_toc {
    my $self = shift;
    my %args = (
	url=>'',
	content=>'',
	@_
    );

    say STDERR whoami() if $args{verbose} > 1;
    say STDERR Dump(\%args) if $args{verbose} > 2;

    my $content = $args{content};
    my %info = ();
    $info{url} = $args{url};
    if ($args{url} =~ /epub$/)
    {
        # We're using an already-downloaded EPUB file
        # And the URL should be in the contents of the TOC
        if ($content =~ m!Posted originally on the <a href="https?://archiveofourown.org/">Archive of Our Own</a> at <a href="(https?://archiveofourown.org/works/\d+)"!)
        {
            $info{url} = $1;
        }
    }

    # sid: story-id, work-id
    my $sid='';
    if ($info{url} =~ m#archiveofourown.org/works/(\d+)#)
    {
	$sid = $1;
    }
    elsif ($args{rurl} and $args{rurl} =~ m#archiveofourown.org/works/(\d+)#)
    {
	$sid = $1;
    }
    elsif (!$args{rurl}) # derive the sid from the contents of the toc
    {
        if ($content =~ m!work_id=(\d+)!)
        {
            $sid = $1;
            $info{url} = "https://archiveofourown.org/works/${sid}";
        }
        elsif ($content =~ m!/works/(\d+)/!)
        {
            $sid = $1;
            $info{url} = "https://archiveofourown.org/works/${sid}";
        }
    }
    if (!$sid)
    {
	print STDERR "did not find SID for $args{url} $info{url}";
	return $self->SUPER::parse_toc(%args);
    }

    $info{title} = $self->parse_title(%args);
    $info{author} = $self->parse_author(%args);
    $info{summary} = $self->parse_summary(%args);
    $info{characters} = $self->parse_characters(%args);
    $info{universe} = $self->parse_universe(%args);
    $info{category} = $self->parse_category(%args);
    $info{rating} = $self->parse_rating(%args);
    $info{chapters} = $self->parse_chapter_urls(%args, sid=>$sid);
    my $epub_url = $self->parse_epub_url(%args, sid=>$sid);
    if ($epub_url)
    {
        $info{epub_url} = $epub_url;
    }
    if ($args{epub} or $args{url} =~ /epub$/) # need to parse the wordcount
    {
        $info{wordcount} = $self->parse_wordcount(%args);
    }

    return %info;
} # parse_toc

=head2 parse_chapter_urls

Figure out the URLs for the chapters of this story.

=cut
sub parse_chapter_urls {
    my $self = shift;
    my %args = (
	urls=>undef,
	content=>'',
	@_
    );
    my $content = $args{content};
    my $sid = $args{sid};
    my @chapters = ();
    if (defined $args{urls})
    {
	@chapters = @{$args{urls}};
    }
    if (@chapters == 1
	    and $content =~ m!href="(/downloads/$sid/[^.]+\.html)!)
    {
	@chapters = ("http://archiveofourown.org$1");
    }

    return \@chapters;
} # parse_chapter_urls

=head2 parse_epub_url

Figure out the URL for the EPUB version of this story.

=cut
sub parse_epub_url {
    my $self = shift;
    my %args = (
	url=>'',
	content=>'',
	@_
    );
    my $content = $args{content};
    my $sid = $args{sid};
    my $epub_url = '';
    if ($content =~ m!href="(/downloads/$sid/[^.]+\.epub\?updated_at=\d+)!)
    {
	$epub_url = "https://archiveofourown.org$1";
    }
    elsif ($content =~ m!href="(/downloads/$sid/[^.]+\.epub)!)
    {
	$epub_url = ("http://archiveofourown.org$1");
    }

    return $epub_url;
} # parse_epub_url

=head2 parse_title

Get the title.

=cut
sub parse_title {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $title = '';
    if ($content =~ m!<h2 class="title heading">\s*([^<]*)</h2>!s)
    {
	$title = $1;
        $title =~ s/\s*$//s; # remove any trailing whitespace
    }
    elsif ($content =~ m!<h1[^>]*>([^<]*)</h1>!)
    {
	$title = $1;
    }
    else
    {
	$title = $self->SUPER::parse_title(%args);
    }
    return $title;
} # parse_title

=head2 parse_author

Get the author.

=cut
sub parse_author {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $author = '';
    if ($content =~ m! href="/users/\w+/pseuds/\w+">([^<]+)</a>!)
    {
	$author = $1;
    }
    elsif ($content =~ m! href="/users/\w+/pseuds/[^"]+">([^<]+)</a>!)
    { # There might be odd characters in there
	$author = $1;
    }
    # <div class="byline">by <a href="http://archiveofourown.org/users/SailorChibi/pseuds/SailorChibi" rel="author">SailorChibi</a></div>
    elsif ($content =~ m! href="https?://archiveofourown\.org/users/\w+/pseuds/[^"]+" rel="author">([^<]+)</a>!)
    {
	$author = $1;
    }
    else
    {
	$author = $self->SUPER::parse_author(%args);
    }
    $author =~ s/_/ /g;
    return $author;
} # parse_author

=head2 parse_summary

Get the summary.

=cut
sub parse_summary {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $summary = '';
    if ($content =~ m!<h3[^>]*>Summary:</h3>\s*<blockquote class="userstuff"><p>([^<]+)</p></blockquote>!s)
    {
        # This is a single-paragraph summary.
	$summary = $1;
    }
    elsif ($content =~ m!<h3[^>]*>Summary:</h3>\s*<blockquote class="userstuff">(.*?)</blockquote>!s)
    {
        # This is a multi-paragraph summary, it needs to be tidied up.
	$summary = $1;
        $summary =~ s!<p>!!g;
        $summary =~ s!</p>!!g;
        $summary =~ s/^\s*//;
        $summary =~ s/\s*$//;
    }
    elsif ($content =~ m!<p[^>]*>Summary</p>\s*<blockquote class="userstuff">(.*?)</blockquote>!s)
    {
        # This is a multi-paragraph summary, it needs to be tidied up.
	$summary = $1;
        $summary =~ s!<p[^>]*>! !g;
        $summary =~ s!</p>!!g;
        $summary =~ s/^\s*//;
        $summary =~ s/\s*$//;
    }
    else
    {
	$summary = $self->SUPER::parse_summary(%args);
    }
    # AO3 tends to have messy HTML stuff stuck in the summary
    $summary =~ s!&lt;[a-zA-Z]&gt;!!g;
    $summary =~ s!&lt;/[a-zA-Z]&gt;!!g;
    $summary =~ s!&amp;!and!g;
    $summary =~ s!<[^>]+>!!g;
    $summary =~ s!</[^>]+>!!g;
    $summary =~ s!&#x27;!'!g;
    $summary =~ s!&#39;!'!g;
    return $summary;
} # parse_summary

=head2 parse_wordcount

Get the wordcount.

=cut
sub parse_wordcount {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $words = '';
    if ($content =~ m!\((\d+) words\)!m)
    {
	$words = $1;
    }
    elsif ($content =~ m!<dt class="words">Words:</dt>\s*<dd class="words">([0-9][0-9,]+)</dd>!)
    {
	$words = $1;
        $words =~ s/,//;
    }
    elsif ($content =~ m!Words:\s*([0-9][0-9,]+)!)
    {
	$words = $1;
        $words =~ s/,//;
    }
    return $words;
} # parse_wordcount

=head2 parse_characters

Get the characters.

=cut
sub parse_characters {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $characters = '';
    if ($content =~ m!<dd class="character tags">(.*?)</dd>!s)
    {
        # multiple characters inside links
        my $str = $1;
        my @chars = ();
        while ($str =~ m!([^><]+)</a>!g)
        {
            push @chars, $1;
        }
        $characters = join(', ', @chars);
    }
    elsif ($content =~ m!<dt[^>]*>Characters:</dt>\s*<dd[^>]*>(.*?)</dd>!s)
    {
        # multiple characters inside links
        my $str = $1;
        my @chars = ();
        while ($str =~ m!([^><]+)</a>!g)
        {
            push @chars, $1;
        }
        $characters = join(', ', @chars);
    }
    elsif ($content =~ m!^Characters: (.*?)$!m)
    {
	$characters = $1;
    }
    else
    {
	$characters = $self->SUPER::parse_characters(%args);
    }
    # Remove the (Universe) part of the characters
    $characters =~ s!\s*\([^)]+\)!!g;

    # Specific character things to change
    $characters =~ s!James "Bucky" Barnes!James Barnes!g;
    $characters =~ s!James Bucky Barnes!James Barnes!g;
    $characters =~ s!James "Rhodey" Rhodes!James Rhodes!g;
    $characters =~ s!James Rhodey Rhodes!James Rhodes!g;
    $characters =~ s!You!U!g;
    $characters =~ s!Dummy!Dum-E!g;
    
    return $characters;
} # parse_characters

=head2 parse_universe

Get the universe.

=cut
sub parse_universe {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $universe = '';
    if ($content =~ m!<dd class="fandom tags">(.*?)</dd>!s)
    {
        # multiple fandoms inside links
        my $str = $1;
        my @univ = ();
        while ($str =~ m!([^><]+)</a>!g)
        {
            push @univ, $1;
        }
        $universe = join(', ', @univ);
    }
    elsif ($content =~ m!<dt[^>]*>Fandoms:</dt>\s*<dd[^>]*>(.*?)</dd>!s)
    {
        # multiple fandoms inside links
        my $str = $1;
        my @univ = ();
        while ($str =~ m!([^><]+)</a>!g)
        {
            push @univ, $1;
        }
        $universe = join(', ', @univ);
    }
    else
    {
	$universe = $self->SUPER::parse_universe(%args);
    }

    # Minor adjustments to AO3 tags
    if ($universe =~ m!Harry Potter - J\. K\. Rowling!)
    {
        $universe =~ s/\s*-\s*J\. K\. Rowling//;
    }
    elsif ($universe =~ m!(Doctor Who)!)
    {
        $universe = $1;
    }
    elsif ($universe =~ m!Blake&amp;#39;s 7!)
    {
        $universe = 'Blakes 7';
    }
    elsif ($universe =~ m!(Marvel Cinematic Universe|Avengers|Iron Man|Captain America)!)
    {
        $universe = 'MCU';
    }
    return $universe;
} # parse_universe

=head2 parse_category

Get the category.

=cut
sub parse_category {
    my $self = shift;
    my %args = @_;

    my $content = $args{content};

    my $category = '';
    if ($content =~ m!<dd class="freeform tags">(.*?)</dd>!s)
    {
        # multiple categories inside links
        my $str = $1;
        my @cats = ();
        while ($str =~ m!([^><]+)</a>!g)
        {
            push @cats, $1;
        }
        $category = join(', ', @cats);
    }
    elsif ($content =~ m!<dt[^>]*>Additional Tags:</dt>\s*<dd[^>]*>(.*?)</dd>!s)
    {
        # multiple categories inside links
        my $str = $1;
        my @cats = ();
        while ($str =~ m!([^><]+)</a>!g)
        {
            push @cats, $1;
        }
        $category = join(', ', @cats);
    }
    elsif ($content =~ m!Additional Tags:\s*</dt>\s*<dd class="freeform tags">\s*<ul[^>]*>\s*(.*?)\s*</ul>!s)
    {
	my $categories = $1;
	my @cats = split(/<li>/, $categories);
	my @categories = ();
	foreach my $cat (@cats)
	{
	    if ($cat =~ m!class="tag">([^<]+)</a>!)
	    {
		push @categories, $1;
	    }
	}
	$category = join(', ', @categories);
    }
    else
    {
	$category = $self->SUPER::parse_category(%args);
    }

    # Also add the "relationship tags", if any, to the categories
    if ($content =~ m!<dd class="relationship tags">(.*?)</dd>!s
            or $content =~ m!<dt[^>]*>Relationships?:</dt>\s*<dd[^>]*>(.*?)</dd>!s)
    {
        my $str = $1;
        my @cats = ($category);
        while ($str =~ m!([^><]+)</a>!g)
        {
            my $rawrel = $1;
            my $rel = $rawrel;
            if ($rawrel =~ m!/!)
            {
                $rawrel =~ s!/!-!g;
                $rel = "${rawrel} Romance";
            }
            elsif ($rawrel =~ m!\&amp;!)
            {
                $rawrel =~ s!\s*\&amp;\s*!-!g;
                $rel = "${rawrel} Friendship";
            }
            $rel =~ s!\s*\([^)]+\)!!g; # remove universe if there is one there
            $rel =~ s!James "Bucky" Barnes!James Barnes!g;
            $rel =~ s!James "Rhodey" Rhodes!James Rhodes!g;
            $rel =~ s!You!U!g;
            $rel =~ s!Dummy!Dum-E!g;
            push @cats, $rel;
        }
        $category = join(', ', @cats);
    }

    return $category;
} # parse_category

=head2 parse_rating

Get the rating from the content

=cut
sub parse_rating {
    my $self = shift;
    my %args = (
	content=>'',
	@_
    );

    my $content = $args{content};
    my $rating = '';
    if ($content =~ m!<dd class="rating tags">(.*?)</dd>!s)
    {
        # rating inside links
        my $str = $1;
        while ($str =~ m!([^><]+)</a>!g)
        {
            $rating = $1;
        }
    }
    elsif ($content =~ m!<dt[^>]*>Rating:</dt>\s*<dd[^>]*>(.*?)</dd>!s)
    {
        # rating inside links
        my $str = $1;
        while ($str =~ m!([^><]+)</a>!g)
        {
            $rating = $1;
        }
    }
    else
    {
	$rating = $self->SUPER::parse_rating(%args);
    }
    return $rating;
} # parse_rating

=head2 whoami

For debugging purposes

=cut
sub whoami  { ( caller(1) )[3] }

1; # End of WWW::FetchStory::Fetcher::AO3
__END__
