File Coverage

lib/Comics/Fetcher/Base.pm

Criterion	Covered	Total	%
statement	27	61	44.2
branch	0	14	0.0
condition	0	6	0.0
subroutine	9	15	60.0
pod	5	6	83.3
total	41	102	40.2

#! perl

use strict;
use warnings;
use utf8;
use Carp;

package Comics::Fetcher::Base;

=head1 NAME

Comics::Fetcher::Base -- Base class for Fetchers.

=head1 SYNOPSIS

  package Comics::Fetcher::Direct;
  use parent qw(Comics::Fetcher::Base);

=head1 DESCRIPTION

The Fetcher Base class provides tools for fetching URLs and saving
data to disk.

The primary entry point for a Fetcher is method C, which must
be implemented by the derived classes.

=cut

use parent qw(Comics::Plugin::Base);

our $VERSION = "1.00";

sub fetch {
    my ( $self ) = @_;
    die( ref($self), ": Method 'fetch' not defined\n" );
}

################ Subroutines ################

use File::Spec;
use File::LoadLines;

=head1 METHODS

=head2 spoolfile($file)

Returns the full name for the given i in the configured spool
directory.

=cut

sub spoolfile {
    my ( $self, $file ) = @_;
    ::spoolfile($file);
}

use Digest::MD5 qw(md5_base64);

use Image::Info qw(image_info);

=head2 urlabs($url, $path)

Returns the full URL for the given i, possibly relative to I.

=cut

sub urlabs {
    my ( $self, $url, $path ) = @_;
    if ( $path =~ m;^/; ) {
	if ( $path =~ m;^//; ) {
	    $path = "http:" . $path;
	}
	elsif ( $path =~ m;^/static\.nrc\.nl/; ) { # TODO
	    $path = "https:/" . $path;
	}
	else {
	    $url =~ s;(^\w+://.*?)/.*;$1;;
	    $path = $url . $path;
	}
    }
    elsif ( $path !~ m;^\w+://; ) {
	$path = $url . "/" . $path;
    }

    return $path;
}

=head2 save_image($image, $dataref)

Saves the contents of I to the spooldir, using I as
the name for the file.

See also: B.

=cut

sub save_image {
    my ( $self, $image, $data ) = @_;
    my $f = $self->spoolfile($image);
    open( my $fd, ">:raw", $f );
    print $fd $$data;
    close($fd) or warn("$f: $!\n");
    ::debug("Wrote: $f");
}

=head2 save_html($html)

Generates and saves the HTML fragment for this comic to the spooldir,
using I as the name for the file.

See also: B.

=cut

sub save_html {
    my ( $self, $html, $data ) = @_;
    my $f = $self->spoolfile($html);
    open( my $fd, ">:utf8", $f );
    print $fd ( $data // $self->html );
    close($fd) or warn("$f: $!\n");
    ::debug("Wrote: $f");
}

=head2 load_html($html)

Loads the HTML fragment for this comic from the spooldir,

See also: B.

=cut

sub load_html {
    my ( $self, $html ) = @_;
    my $f = $self->spoolfile($html);
    my $opts = { split => 0, fail => "soft" };
    my $data = loadlines( $f, $opts );
    if ( $opts->{error} || !$data ) {
	::debug("Cannot reuse $html: ", $opts->{error}, "\n");
	return;
    }
    ::debug("Read: $f");
    return $data;
}

1;