view release on metacpan or  search on metacpan

lib/Comics.pm  view on Meta::CPAN

	fail => [],
	loaded => 0,
	uptodate => 0,
	excluded => 0,
	disabled => 0,
      };

    # Process command line options.
    app_options();

    # Post-processing.
    $trace |= ($debug || $test);
    $verbose = 255 if $debug;
    $spooldir .= "/";
    $spooldir =~ s;/+$;/;;

    File::Path::make_path( $spooldir, { verbose => 1 } )
	unless -d $spooldir;

    $statefile = spoolfile(".state.json");

    $pluginfilter = ".";
    if ( @ARGV ) {
	$pluginfilter = "^(?:" . join("|", @ARGV) . ")\\.pm\$";
    }
    $pluginfilter = qr($pluginfilter)i;

}

sub main {

    # Initialize.
    init();

    # Restore state of previous run.
    get_state();

    # Load the plugins.
    load_plugins();

    # Non-aggregating command: list.
    if ( $list ) {
	list_plugins();
	return;
    }

    # Non-aggregating command: enable/disable.
    if ( $activate ) {
	save_state();
	return unless $rebuild;
    }

    unless ( $rebuild ) {
	# Run the plugins to fetch new images.
	run_plugins();

	# Save the state.
	save_state();
    }

    # Gather the HTML fragments into a single index.html.
    build();

    # Show processing statistics.
    statistics();
}

################ State subroutines ################

use JSON;

my $state;

sub get_state {
    my $opts = { split => 0, fail => "soft" };
    my $data = loadlines( $statefile, $opts );
    if ( $opts->{error} ) {
	$state = { comics => { } };
    }
    else {
	$state = JSON->new->decode($data);
	if ( $refresh ) {
	    delete( $_->{md5} )
	      foreach values( %{ $state->{comics} } );
	}
    }
}

sub save_state {
    unlink($statefile."~");
    rename( $statefile, $statefile."~" );
    open( my $fd, '>:utf8', $statefile );
    print $fd JSON->new->canonical->pretty(1)->encode($state);
    close($fd);
}

################ Plugin subroutines ################

my @plugins;

sub load_plugins {

    opendir( my $dh, $INC[0] . "/Comics/Plugin" )
      or die( $INC[0] . "/Comics/Plugin: $!\n");

    while ( my $m = readdir($dh) ) {
	next unless $m =~ /^[0-9A-Z].*\.pm$/;
	next if $m eq 'Base.pm';
	$stats->{loaded}++;
	$stats->{excluded}++, next unless $m =~ $pluginfilter;

	debug("Loading $m...");
	$m =~ s/\.pm$//;
	# If the module is already loaded, remove it first.
	# Otherwise the require won't produce the __PACKAGE__ result.
	delete $INC{"Comics/Plugin/$m.pm"};
	my $pkg = eval { require "Comics/Plugin/$m.pm" };
	die("Comics/Plugin/$m.pm: $@\n") unless $pkg;
	unless ( $pkg eq "Comics::Plugin::$m" ) {
	    warn("Skipped $m.pm (defines $pkg, should be Comics::Plugin::$m)\n");
	    next;

lib/Comics.pm  view on Meta::CPAN

    $l_plugin -= $lpl;
    $l_fetcher -= $lft;
    my $fmt = "%-${l_name}s   %-${l_plugin}s   %-${l_fetcher}s   %-8s   %s\n";
    foreach my $comic ( @plugins ) {

	my $st = $state->{comics}->{ $comic->{tag} };
	no strict 'refs';
	printf( $fmt,
		$comic->{name},
		substr( ref($comic), $lpl ),
		substr( ${ref($comic)."::"}{ISA}[0], $lft ),
		$st->{disabled} ? "disabled" : "enabled",
		$comic->{update} ? $comic->{updated} : "",
	      );
    }

}

use LWP::UserAgent;

our $ua;
our $uuid;

sub run_plugins {

    unless ( $ua ) {
	$ua = LWP::UserAgent::Custom->new;
	$uuid = uuid();
    }

    foreach my $comic ( @plugins ) {
	warn("Plugin: ", $comic->{name}, "\n") if $verbose > 1;

	# Force existence of this comic's state otherwise
	# it will be autovivified within the fetch method
	# and never get outside.
	$state->{comics}->{$comic->{tag}} ||= {};

	# Make the state accessible.
	$comic->{state} = $state->{comics}->{$comic->{tag}};

	# Skip is disabled.
	next if $comic->{state}->{disabled} && !$force;

	# Run it, trapping errors.
	$stats->{tally}++;
	unless ( eval { $comic->fetch($reuse); 1 } ) {
	    $comic->{state}->{fail} = $@;
	    debug($comic->{state}->{fail});
	    push( @{ $stats->{fail} },
		  [ $comic->{name}, $comic->{state}->{fail} ] );
	}
    }
}

################ Index subroutines ################

sub build {

    # Change to the spooldir and collect all HTML fragments.
    chdir($spooldir) or die("$spooldir: $!\n");
    opendir( my $dir, "." );
    my @files = grep { /^[^._].+(?<!index)\.(?:html)$/ } readdir($dir);
    close($dir);
    warn("Number of images = ", scalar(@files), "\n") if $debug;
    $stats->{tally} = $stats->{uptodate} = @files if $rebuild;

    # Sort the fragments on last modification date.
    @files =
      map { $_->[0] }
	sort { $b->[1] <=> $a->[1] }
	  grep { $force || ! $state->{comics}->{$_->[2]}->{disabled} }
	    map { ( my $t = $_ ) =~ s/\.\w+$//;
		  [ $_, (stat($_))[9], $t  ] }
	      @files;

    if ( $debug > 1 ) {
	warn("Images (sorted):\n");
	warn("   $_\n") for @files;
    }

    # Creat icon.
    unless ( -s "comics.png" ) {
	require Comics::Utils::Icon;
	open( my $fd, '>:raw', "comics.png" );
	print $fd Comics::Utils::Icon::icon();
	close($fd);
    }

    # Create a new index.html.
    open( my $fd, '>:utf8', "index.html" );
    preamble($fd);
    htmlstats($fd);
    for ( @files ) {
	open( my $hh, '<:utf8', $_ )
	  or die("$_: $!");
	print { $fd } <$hh>;
	close($hh);
    }
    postamble($fd);
    close($fd);
}

sub preamble {
    my ( $fd ) = @_;
    print $fd <<EOD;
<html>
<head>
<title>Comics!</title>
<meta http-equiv="Content-Type" content="text/html;charset=utf-8">
<style type="text/css">
body {
    font-family : Verdana, Arial, Helvetica, sans-serif;
    text-align: center;
    margin-top: 0px;
    margin-right: 0px;
    margin-bottom: 10px;
    margin-left: 0px;
    font-size:12pt;
}
.toontable {
    background-color: #eee;
    padding: 9px;
    margin: 18px;
    border: 1px solid #ddd;
}
.toonimage {
    background-color: white;