HPR/hpr-tools
5
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases Wiki Activity
38abbcdd39
hpr-tools/InternetArchive/upload_manager

2804 lines
92 KiB
Plaintext
Raw Normal View History

Moved project directories and files to an empty local repo
2024-06-04 15:35:44 +00:00
#!/usr/bin/env perl
#===============================================================================
#
# FILE: upload_manager
#
# USAGE: ./upload_manager [-help] [-[no]dry-run] [-[no]verbose]
# [-debug=N] -mode=MODE [-episode=N1 [-episode=N2 ...]]
# [-range=START [-range=END]] [-json=FILE] [-scandir=FILE]
# [-dbconfig=FILE]
#
# DESCRIPTION: Collect details about HPR shows and the copies on Archive.org
# and keep them in a separate SQLite database (for
# the moment). This database is used to populate the
# developing PostgreSQL Database (which is not currently
# progressing very much).
#
# OPTIONS: ---
# REQUIREMENTS: ---
# BUGS: ---
# NOTES: 2022-02-15 Had to revert to DBD::MySQL temporarily.
# 2023-06-12 This code is no longer valid. It expects the main
# HTML to point to files on the server (if there are "assets")
# and recurses through extra HTML it finds there. It currently
# looks for file details in any sub-directory "/eps/hpr1234/".
# Now there are no files, so the details of all assets
# (including the audio) needs to be in the 'assets' table. Not
# sure we are there yet.
# 2024-03-08 Smartmatch is deprecated; moved to 'match::smart'.
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.2.19
# CREATED: 2017-06-14 10:50:28
# REVISION: 2024-03-08 20:49:51
#
#===============================================================================
use 5.010;
use strict;
use warnings;
use utf8;
#use experimental 'smartmatch';
use match::smart;
use Carp;
use Getopt::Long;
use Pod::Usage;
use Config::General;
use File::Slurper qw{ read_text read_lines };
use JSON;
use Net::OpenSSH;
#use TryCatch; # Broke in late May 2020 due to a problem with Devel::Declare
use Try::Tiny;
use Log::Handler;
use HTML::TreeBuilder 5 -weak;
use HTML::Entities;
use List::Util qw{ min max };
use List::MoreUtils qw{ any };
use LWP::Simple;
use DBI;
use SQL::Abstract;
use SQL::Abstract::Plugin::InsertMulti;
use Data::Dumper;
#
# Version number (manually incremented)
#
our $VERSION = '0.2.19';
#
# Script and directory names
#
( my $PROG = $0 ) =~ s|.*/||mx;
#( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
#$DIR = '.' unless $DIR;
#-------------------------------------------------------------------------------
# Declarations
#-------------------------------------------------------------------------------
#
# Constants and other declarations
#
my $basedir = "$ENV{HOME}/HPR/IA";
my $logdir = "$basedir/logs";
my $logfile = "$logdir/${PROG}.log";
my $configfile = "$basedir/.$PROG.cfg";
my $db1configfile = "$basedir/.hpr_db.cfg";
my $database2 = "$basedir/ia.db";
my ( $dbh1, $dbh2, $sth1, $h1 );
#
# NOTE: Program config not currently used
#
die "Configuration file $configfile not found\n" unless ( -e $configfile );
my $conf = Config::General->new(
-ConfigFile => $configfile,
-InterPolateVars => 1,
-ExtendedAccess => 1,
);
my %config = $conf->getall();
#
# Enable Unicode mode
#
binmode STDOUT, ":encoding(UTF-8)";
binmode STDERR, ":encoding(UTF-8)";
#-------------------------------------------------------------------------------
# Options
#-------------------------------------------------------------------------------
#
# Option defaults
#
my $DEFDEBUG = 0;
#
# Options and arguments
#
my %options;
Options( \%options );
#
# Default help shows minimal information
#
pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, -verbose => 0 )
if ( $options{'help'} );
#
# The -documentation or -man option shows the full POD documentation through
# a pager for convenience
#
pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, -verbose => 2 )
if ( $options{'documentation'} );
my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEFDEBUG );
my $db1cfgfile
= ( defined( $options{dbconfig} ) ? $options{dbconfig} : $db1configfile );
my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 0 );
my $verbose = ( defined( $options{verbose} ) ? $options{verbose} : 0 );
my $mode = $options{mode};
die "Mode is required\n" unless defined($mode);
$mode = lc($mode);
my @episodes;
@episodes = @{ $options{episode} } if ( defined( $options{episode} ) );
if ($mode ne 'update' and @episodes) {
die "The -episode=N options are only for use in update mode\n";
}
my @range;
@range = @{ $options{range} } if ( defined( $options{range} ) );
if ($mode ne 'update' and @range) {
die "The -range=N options are only for use in update mode\n";
}
_debug( $DEBUG >= 3, '@episodes: ' . Dumper( \@episodes ) );
_debug( $DEBUG >= 3, '@range: ' . Dumper( \@range ) );
#
# Check -episode=N versus -range=N. We can't have both
#
die "Choose only -episode=N or -range=N, not both\n"
if ( defined( $options{episode} ) && defined( $options{range} ) );
#
# Only two range values
#
die "-range=N should not be used more than twice\n" if ($#range gt 2);
#
# Turn the range into a list of episodes
#
if (defined($options{range})) {
@episodes = ( min(@range) .. max(@range) );
}
@episodes = map { sprintf('%04d',$_)} @episodes;
_debug( $DEBUG >= 3, '@episodes: ' . Dumper(\@episodes) );
die "Too many episodes requested\n" if (scalar(@episodes) > 20);
my $json = $options{json};
if ( $mode eq 'json' ) {
die "JSON file is required\n" unless defined($json);
die "Unable to find file '$json'\n" unless -e $json;
}
my $dirfile = $options{scandir};
if ( $mode eq 'scandir' ) {
die "Directory listing file is required\n" unless defined($dirfile);
die "Unable to find file '$dirfile'\n" unless -e $dirfile;
}
die "Configuration file $db1cfgfile not found\n" unless ( -e $db1cfgfile );
#-------------------------------------------------------------------------------
# Set up logging keeping the default log layout except for the date. The format
# is "%T [%L] %m" where '%T' is the timestamp, '%L' is the log level and '%m is
# the message.
#-------------------------------------------------------------------------------
my $log = Log::Handler->new();
$log->add(
file => {
timeformat => "%Y-%m-%d %H:%M:%S",
filename => $logfile,
minlevel => 0,
maxlevel => 7,
}
);
#-------------------------------------------------------------------------------
# Load MySQL configuration data
#-------------------------------------------------------------------------------
my $db1conf = Config::General->new(
-ConfigFile => $db1cfgfile,
-InterPolateVars => 1,
-ExtendedAccess => 1,
);
my %db1cfg = $db1conf->getall();
if ($verbose) {
print "MySQL database configuration chosen: $db1cfgfile\n";
print "Dry run\n" if $dry_run;
}
#-------------------------------------------------------------------------------
# Connect to the MariaDB database [reverted to mysql temporarily]
#-------------------------------------------------------------------------------
my $dbhost = $db1cfg{database}->{host} // '127.0.0.1';
my $dbport = $db1cfg{database}->{port} // 3306;
my $dbname = $db1cfg{database}->{name};
my $dbuser = $db1cfg{database}->{user};
my $dbpwd = $db1cfg{database}->{password};
#$dbh1 = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
# $dbuser, $dbpwd, { AutoCommit => 1 } )
# or croak $DBI::errstr;
$dbh1 = DBI->connect( "DBI:mysql:database=$dbname;host=$dbhost;port=$dbport",
$dbuser, $dbpwd, { AutoCommit => 1 } )
or croak $DBI::errstr;
#
# Enable client-side UTF8 [temporary]
#
$dbh1->{mysql_enable_utf8} = 1;
#-------------------------------------------------------------------------------
# Connect to the SQLite database
#-------------------------------------------------------------------------------
$dbh2 = DBI->connect( "dbi:SQLite:dbname=$database2", "", "" );
#
# Log the starting conditions
#
$log->info("Starting $PROG version $VERSION");
if (@episodes) {
$log->info('Episodes:', join( ", ", @episodes ) );
}
else {
$log->info('Looking for new episodes');
}
$log->info("Mode: $mode");
if ($dry_run) {
$log->info('Dry run: Yes');
}
#-------------------------------------------------------------------------------
# Set up for connecting to the server with SSH
#-------------------------------------------------------------------------------
my $remhost = 'hackerpublicradio.org';
#my $remport = 22074;
my $remport = 22;
my $remuser = 'hpr';
my $rempath = '/home/hpr/www/eps/';
my $ssh = Net::OpenSSH->new( $remhost, user => $remuser, port => $remport );
$ssh->error and die "Can't ssh to $remhost: " . $ssh->error;
$log->info("Connected to ${remuser}\@${remhost}, port $remport");
#-------------------------------------------------------------------------------
# Perform the action requested by -mode=X
#-------------------------------------------------------------------------------
if ( $mode eq 'initialise' ) {
print "Initialise mode\n";
initialise( $dbh1, $dbh2 );
}
elsif ( $mode eq 'update' ) {
print "Update mode\n";
#
# Range updating is achieved by running the single-shot mode repeatedly
#
if ( @episodes ) {
foreach my $episode (@episodes) {
update_episode( $dbh1, $dbh2, $episode, $dry_run, $verbose );
}
}
else {
update_db( $dbh1, $dbh2, $dry_run, $verbose );
}
}
elsif ( $mode eq 'json' ) {
print "JSON mode\n";
load_metadata( $dbh2, $json, $dry_run, $verbose );
#load_upload_dates( $dbh2, $json );
}
elsif ( $mode eq 'scandir' ) {
print "Scan directory mode\n";
scan_dir( $dbh2, $dirfile );
}
else {
die "Invalid mode: $mode\n";
}
exit;
#=== FUNCTION ================================================================
# NAME: initialise
# PURPOSE: Initialise an empty database
# PARAMETERS: $dbh1 Handle for the MySQL database
# $dbh2 Handle for the SQLite database
# RETURNS: Nothing
# DESCRIPTION: Runs the various initialisation functions, but only if the
# database tables 'episodes' and/or 'assets' are empty
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub initialise {
my ( $dbh1, $dbh2 ) = @_;
my ($count);
#
# Initialise the 'episodes' table if it's empty
#
$count = count_rows( $dbh2, 'episodes' );
if ( $count == 0 ) {
print "Initialising the 'episodes' table\n";
initialise_episodes( $dbh1, $dbh2 );
}
else {
print "Did not initialise the 'episodes' table ($count rows)\n";
$log->info("Did not initialise the 'episodes' table ($count rows)");
}
#
# Initialise the 'assets' table if it's empty
#
$count = count_rows( $dbh2, 'assets' );
if ( $count == 0 ) {
print "Initialising the 'assets' table\n";
initialise_assets( $dbh1, $dbh2 );
}
else {
print "Did not initialise the 'assets' table ($count rows)\n";
$log->info("Did not initialise the 'assets' table ($count rows)");
}
}
#=== FUNCTION ================================================================
# NAME: initialise_episodes
# PURPOSE: Initialise an empty 'episodes' table
# PARAMETERS: $dbh1 Handle for the MySQL database
# $dbh2 Handle for the SQLite database
# RETURNS: Nothing
# DESCRIPTION: Assuming the episodes table is empty loads all episodes from
# the MariaDB database
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub initialise_episodes {
my ( $dbh1, $dbh2 ) = @_;
my ( $sql1, $sth1, $h1, $count );
$sql1 = q{
SELECT
id,
date,
title,
summary
FROM eps
};
$sth1 = $dbh1->prepare($sql1);
$sth1->execute();
if ( $dbh1->err ) {
croak $dbh1->errstr;
}
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
#
# Fields are:
# id integer,
# rdate date NOT NULL,
# title varchar ( 100 ) NOT NULL,
# summary varchar ( 100 ) NOT NULL,
# uploaded integer DEFAULT 0,
# has_files INTEGER DEFAULT 0,
# with_files INTEGER DEFAULT 0,
# with_derived INTEGER DEFAULT 0,
# with_source INTEGER DEFAULT 0,
# archive_date date,
# item_last_updated integer
# IA_URL text,
# notes text,
#
#>>>
$dbh2->do(
q{INSERT INTO episodes (id, rdate, title, summary) VALUES(?,?,?,?)},
undef,
$h1->{id},
$h1->{date},
$h1->{title},
$h1->{summary},
) or die $dbh2->errstr;
#<<<
$count++;
}
print "Records added: $count\n";
$log->info("Records added to 'episodes' table: $count");
}
#=== FUNCTION ================================================================
# NAME: initialise_assets
# PURPOSE: Initialise an empty 'assets' table (during database
# initialisation)
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the SQLite database
# RETURNS: Nothing
# DESCRIPTION: Assuming the assets table is empty loads all assets (links to
# files on the HPR server) into the table
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub initialise_assets {
my ( $dbh1, $dbh2 ) = @_;
my ( $sql1, $sth1, $h1, $count, $links, $id, $episode, $notes );
my %assets;
#
# Collect the notes for shows that have links to other HPR files
#
$sql1 = q{
SELECT
id,
notes
FROM eps
WHERE notes REGEXP 'https?://(www.)?(hacker|hobby)publicradio.org/eps/'
};
# LIMIT 20 OFFSET 30
$sth1 = $dbh1->prepare($sql1);
$sth1->execute();
if ( $dbh1->err ) {
croak $dbh1->errstr;
}
#
# Process notes one show at a time, recursing into HTML where necessary
# and building the %assets hash
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$links = 0;
$id = $h1->{id};
$episode = sprintf("%04d", $id);
$notes = $h1->{notes};
print "Episode: $id\n";
#$links = find_links($id,$notes,\%assets);
$links = find_assets($ssh,$episode,$rempath,\%assets);
print "Links found: $links\n";
}
#print Dumper(\%assets),"\n";
#
# Use the %assets hash to populate the 'assets' table
#
foreach my $key (sort(keys(%assets))) {
foreach my $obj (@{$assets{$key}}) {
#>>>
$dbh2->do(
q{INSERT INTO assets (episode_id, URL, filename) VALUES(?,?,?)},
undef,
$key,
$obj->{URL},
$obj->{filename},
) or die $dbh2->errstr;
#<<<
$count++;
}
}
print "Records added: $count\n";
$log->info("Records added to 'assets' table: $count");
}
#=== FUNCTION ================================================================
# NAME: update_db
# PURPOSE: Loads any additional rows from the MySQL database to the
# SQLite one.
# PARAMETERS: $dbh1 Handle for the MySQL database
# $dbh2 Handle for the SQLite database
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Nothing
# DESCRIPTION: Finds the first gap in the 'id' field of the 'episodes' table
# in the SQLite database. This is the starting show number it
# uses when querying the MySQL database. The function loops over
# the 'eps' table in the MySQL database returning details for
# storage in the SQLite database. Before storing it double
# checks that the row in question does not exist.
# TODO
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub update_db {
my ( $dbh1, $dbh2, $dry_run, $verbose ) = @_;
my ( $sql1, $sql2, $sth1, $h1, $sth2, $h2 );
my ( $ep_count, $ffree);
my ( %assets, $asset_count, $assets_added, $assets_deleted, $assets_updated );
my ( $id, $episode, $notes, $links );
print "Updating SQLite database from MySQL\n" if $verbose;
#
# Find the first episode id gap in the SQLite database
#
$sql1 = q{
SELECT MIN (id) + 1 AS first_free
FROM episodes t1
WHERE NOT EXISTS (
SELECT *
FROM episodes t2
WHERE t1.id + 1 = t2.id)
};
$sth1 = $dbh2->prepare($sql1);
$sth1->execute();
if ( $dbh1->err ) {
croak $dbh1->errstr;
}
$h1 = $sth1->fetchrow_hashref;
$ffree = $h1->{first_free};
print "First free id: $ffree\n" if $verbose;
#
# SQL to find new rows in the MySQL database
#
$sql1 = q{
SELECT
id,
date,
title,
summary,
notes
FROM eps
WHERE id >= ?
};
#
# SQL to look for pre-existing episodes in the SQLite database
#
$sql2 = q{
SELECT * FROM episodes WHERE id = ?
};
#
# Prepare the SQL statements
#
$sth1 = $dbh1->prepare($sql1);
$sth2 = $dbh2->prepare($sql2);
#
# Query MySQL, from $ffree onwards
#
$sth1->execute($ffree);
if ( $dbh1->err ) {
croak $dbh1->errstr;
}
#
# Loop through the MySQL rows
#
$ep_count = $asset_count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
#
# Query the SQLite database for the episode number we just got
#
$sth2->execute( $h1->{id} );
if ( $dbh2->err ) {
croak $dbh2->errstr;
}
$h2 = $sth2->fetchrow_hashref;
#
# If the row isn't already there create it
#
unless ($h2) {
unless ($dry_run) {
#>>>
$dbh2->do(
q{INSERT INTO episodes (id, rdate, title, summary) VALUES(?,?,?,?)},
undef,
$h1->{id},
$h1->{date},
$h1->{title},
$h1->{summary},
) or die $dbh2->errstr;
#<<<
printf "Added episode: %d\n", $h1->{id} if $verbose;
$ep_count++;
}
else {
printf
"Would have inserted a row into the 'episodes' table (%s)\n",
$h1->{id};
}
}
#
# Check this show for "assets" (whether we have the episode already or
# not). Even in dry-run mode this gets executed
#
$links = 0;
$id = $h1->{id};
$episode = sprintf("%04d", $id);
# $notes = $h1->{notes};
# $links = find_links($id,$notes,\%assets);
$links = find_assets($ssh,$episode,$rempath,\%assets);
$asset_count += $links;
}
#
# In debug mode show what assets were collected as we iterated through the
# new shows.
#
_debug( $DEBUG >= 2, '%assets: ' . Dumper(\%assets) );
#
# Add any assets collected from the episodes just processed
#
$assets_added = 0;
if ($asset_count > 0) {
( $assets_added, $assets_deleted, $assets_updated ) =
process_assets( $dbh2, \%assets, 1, $dry_run, $verbose );
}
printf "%-16s %d\n", "Episodes added:", $ep_count;
printf "%-16s %d\n", "Assets found:", $asset_count;
printf "%-16s %d\n", "Assets added:", coalesce( $assets_added, 0 );
printf "%-16s %d\n", "Assets deleted:", coalesce( $assets_deleted, 0 );
printf "%-16s %d\n", "Assets updated:", coalesce( $assets_updated, 0 );
$log->info("Episodes added: $ep_count");
}
#=== FUNCTION ================================================================
# NAME: process_assets
# PURPOSE: Given a collection of asset details obtained by searching
# notes for a given range of episodes determine whether they
# need to be added to the SQLite database.
# PARAMETERS: $dbh SQLite database handle
# $assets hashref pointing to the collected assets which
# have been found by parsing the notes of all
# relevant shows prior to calling this routine.
# $new Boolean flag to indicate that we're dealing with a new
# show or updating an old one
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Number of assets added
# DESCRIPTION: The %assets hash has been accumulated by scanning all the
# notes belonging to new episodes found in the MySQL database.
# The hash is keyed by the episode number and it is scanned in
# sorted order of the key. The SQLite database is queried for
# assets with this key and the result held in a hash keyed by
# the filename. The value of each key in the %assets hash is an
# array of hashes holding the asset details, so we loop through
# these. If the filename of a particular asset hash is not found
# in the hash from the database then we create a new row in the
# 'assets' table (assuming that we're not in dry run mode where
# we simply report what we would have done). If any assets were
# added for an episode then we set the flag 'has_files' (unless
# in dry run mode). The total number of assets added to the
# database is returned by the function.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub process_assets {
my ( $dbh, $assets, $new, $dry_run, $verbose ) = @_;
my ( $sql, $sth, $db_assets, $key_field, $db_count );
my ( $asset_count, $assets_added, $assets_deleted, $assets_updated );
$key_field = 'id';
#
# We should only be called if there are assets, but just in case...
#
return ( 0, 0, 0 ) unless ($assets);
#
# SQL to look for pre-existing assets in the SQLite database
#
$sql = q{
SELECT * FROM assets WHERE episode_id = ?
};
$sth = $dbh->prepare($sql);
say 'Processing assets for ', ( $new ? 'new' : 'existing' ), ' show'
if $verbose;
#
# Use the %assets hash to populate the 'assets' table. The hash is keyed
# by episode numbers, and each entry consists of an array of hashes each
# containing the filename and the URL of the asset.
#
$assets_added = $assets_deleted = $assets_updated = 0;
foreach my $key ( sort( keys(%$assets) ) ) {
print "Checking episode $key\n" if $verbose;
#
# Count the assets for the current show
#
$asset_count = scalar( @{ $assets->{$key} } );
_debug( $DEBUG >= 2, "Episode: $key, Asset_count: $asset_count" );
#
# Query the SQLite database for the episode number we just got, looking
# for entries in the 'assets' table
#
$sth->execute($key);
if ( $dbh->err ) {
croak $dbh->errstr;
}
#
# Grab everything as a hash keyed on the 'filename' field so we can
# check it easily. Count what we got (i.e. count the number of assets
# in SQLite for this episode).
# NOTE: trying the idea of indexing $db_assets by the 'id' field (in
# $key_field)
#
# $db_assets = $sth->fetchall_hashref('filename');
$db_assets = $sth->fetchall_hashref($key_field);
$db_count = scalar( keys(%$db_assets) );
_debug( $DEBUG >= 2, "Assets in ia.db:\n" . Dumper($db_assets) );
_debug( $DEBUG >= 2, "DB count: $db_count" );
#
# Compare the number of "real" assets with what SQLite holds.
#
if ( $asset_count > $db_count ) {
#
# We need to add assets. If it's a newly added show which has
# assets this will always be necessary. If it's an existing show
# then we're repairing an anomaly and want to say so.
#
if ($new) {
say "Adding assets" if $verbose;
}
else {
say "** Found more real assets than in DB -> adding";
}
$assets_added += insert_assets( $dbh, $key, $assets, $db_assets,
$dry_run, $verbose );
}
elsif ( $asset_count < $db_count ) {
#
# We need to delete assets. This can't happen for an existing
# show, so it's always a noteworthy event.
#
say "** Found fewer real assets than in DB -> deleting";
$assets_deleted += delete_assets( $dbh, $key, $assets, $db_assets,
$dry_run, $verbose );
}
#
# Look for field differences in what we have after the inserts and
# deletes
#
if ( $assets_added > 0 || $assets_deleted > 0 ) {
$sth->execute($key);
if ( $dbh->err ) {
croak $dbh->errstr;
}
$db_assets = $sth->fetchall_hashref($key_field);
}
my @results
= synchronise_found_assets( $dbh, $key, $assets, $db_assets,
$dry_run, $verbose );
$assets_added += $results[0];
$assets_deleted += $results[1];
$assets_updated += $results[2];
_debug( $DEBUG >= 4, '@results ' . Dumper( \@results ) );
#
# If there are assets then we need to ensure the 'has_files' setting
# reflects it (unless in dry run mode)
#
if ( $asset_count > 0 ) {
unless ($dry_run) {
$dbh->do(
q{
UPDATE episodes
SET has_files = 1
WHERE id = ?
AND has_files = 0
},
undef,
$key,
) or die $dbh->errstr;
}
else {
say "Would have updated the 'episodes.has_files' ",
"field for $key (if needed)";
}
}
# $assets_added += $asset_count;
}
return ( $assets_added, $assets_deleted, $assets_updated );
}
#=== FUNCTION ================================================================
# NAME: synchronise_found_assets
# PURPOSE: Compares the assets found by searching the shownotes (and
# other files) with those in the SQLite database and updates
# what differs.
# PARAMETERS: $dbh SQLite database handle
# $episode Numeric episode
# $assets Hashref pointing to the collected assets which
# have been found by parsing the show's notes;
# keyed by episode number. Each keyed object is
# an arrayref of hashes containing the URL and
# filename of the asset.
# $db_assets Hash of assets from SQLite, keyed by filename.
# Each keyed object is a hash of columns from
# the database: id, episode_id, URL, filename,
# uploaded.
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Number of additions, deletions and updates
# DESCRIPTION: The assets for this episode have been found by searching the
# HTML of the show notes and any linked HTML files for files on
# the HPR server. The equivalent assets have also been
# collected from the SQLite database. A comparison is made
# between these items and if they differ the definitive details
# collected from the MySQL database are used. There are three
# actions possible: (1) if the URL or filename fields differ
# then we can work out the update and apply it, (2) if the
# incoming assets don't match any in those from the database
# then we can delete the database ones, and (3) we can add the
# incoming assets we also couldn't match because they'll be the
# replecements! For all actions changes are made to the
# versions in the SQLite database using SQL::Abstract to
# construct the queries to do it.
# THROWS: No exceptions
# COMMENTS: TODO: There may be multiple asset changes for the episode.
# Does the SQL::Abstract call perform the multiple changes?
# Needs testing.
# SEE ALSO: N/A
#===============================================================================
sub synchronise_found_assets {
my ( $dbh, $episode, $assets, $db_assets, $dry_run, $verbose ) = @_;
my ( $sth, $additions, $deletions, $updates, $update_count, $index);
my ( @fieldvals, @where, @db_rows, @asset_rows, %matches, %changes );
$additions = $deletions = $updates = 0;
$update_count = 0;
#
# Temporary?
#
if ( $DEBUG >= 4 ) {
_debug( 1, 'In subroutine synchronise_found_assets' );
_debug( 1, "\$episode: $episode" );
_debug( 1, '%$assets: ' . Dumper($assets) );
_debug( 1, '%$db_assets: ' . Dumper($db_assets) );
}
_debug( $DEBUG >= 4, 'Looking for assets that match - to exclude them' );
@db_rows = ( keys(%$db_assets) );
@asset_rows = ( 0 .. scalar( @{ $assets->{$episode} } ) - 1 );
_debug( $DEBUG >= 4, 'Initial @db_rows ' . Dumper( \@db_rows ) );
_debug( $DEBUG >= 4, 'Initial @asset_rows ' . Dumper( \@asset_rows ) );
#
# Find any asset pair matches
#
$index = 0;
foreach my $db_key ( keys(%$db_assets) ) {
foreach my $a_obj ( @{ $assets->{$episode} } ) {
if ( assets_match( $a_obj, $db_assets->{$db_key} ) == 2 ) {
$matches{$db_key} = [ $a_obj, $db_assets->{$db_key} ];
# splice( @asset_rows, $index, 1 );
@asset_rows = grep { $_ != $index } @asset_rows;
$index++;
}
}
}
_debug( $DEBUG >= 4, 'Assets to ignore: %matches ' . Dumper( \%matches ) );
_debug( $DEBUG >= 4, 'Current @asset_rows ' . Dumper( \@asset_rows ) );
#
# If everything matched then there's nothing to do, so return zero and
# leave.
#
# if (scalar(@db_rows) == scalar( keys(%matches) )) {
if ( scalar(@asset_rows) == 0 ) {
_debug( $DEBUG >= 4, 'All rows match, so nothing to do' );
return ( 0, 0, 0 );
}
_debug( $DEBUG >= 4, 'Some rows do not match' );
#
# Remove the row ids for any matches
#
@db_rows = grep { !exists( $matches{$_} ) } @db_rows;
_debug( $DEBUG >= 4, '@db_rows after matches ' . Dumper( \@db_rows ) );
_debug( $DEBUG >= 4, '@asset_rows after matches ' . Dumper( \@asset_rows ) );
_debug( $DEBUG >= 4, 'Looking for assets that match in only one attribute' );
#
# Find any cases where only one element of the asset object matches. This
# means we have a simple change.
#
$index = 0;
foreach my $db_key (@db_rows) {
foreach my $a_obj ( @{ $assets->{$episode} } ) {
if ( assets_match( $a_obj, $db_assets->{$db_key} ) == 1 ) {
$changes{$db_key} = [ $a_obj, $db_assets->{$db_key} ];
@asset_rows = grep { $_ != $index } @asset_rows;
$index++;
}
}
}
_debug( $DEBUG >= 4, 'Assets to change: %changes ' . Dumper( \%changes ) );
_debug( $DEBUG >= 4, 'Current @asset_rows ' . Dumper( \@asset_rows ) );
#
# Remove the row ids for any changes
#
@db_rows = grep { !exists( $changes{$_} ) } @db_rows;
_debug( $DEBUG >= 4, '@db_rows after changes ' . Dumper( \@db_rows ) );
_debug( $DEBUG >= 4, '@asset_rows after changes ' . Dumper( \@asset_rows ) );
#
# If there are changes, do them now
#
if (%changes) {
_debug( $DEBUG >= 4, 'Collecting changes' );
#
# We may have multiple database rows to process
#
$index = 0;
foreach my $key ( keys(%changes) ) {
$fieldvals[$index] = {};
$where[$index] = { episode_id => $episode };
#
# Compare the fields we're interested in, accumulating differences
# (expecting only one per key).
#
foreach my $fld ( 'filename', 'URL' ) {
if (!equal(
$changes{$key}->[0]->{$fld},
$changes{$key}->[1]->{$fld}
)
)
{
$update_count++;
$fieldvals[$index]->{$fld} = $changes{$key}->[0]->{$fld};
}
}
$where[$index]->{id} = $key;
$index++;
}
}
_debug( $DEBUG >= 2, '@fieldvals: ' . Dumper( \@fieldvals ) );
_debug( $DEBUG >= 2, '@where ' . Dumper( \@where ) );
if ( $update_count > 0 ) {
_debug( $DEBUG >= 4, 'Performing changes' );
#
# Prepare to use SQL::Abstract
#
my $sql = SQL::Abstract->new();
foreach my $fv (@fieldvals) {
my ( $stmt, @bindvals )
= $sql->update( 'assets', $fv, shift(@where) );
#
# Perform the updates (unless in dry-run mode)
#
unless ($dry_run) {
$sth = $dbh->prepare($stmt);
$sth->execute(@bindvals);
if ( $dbh->err ) {
warn "Processing $episode\n", $dbh->errstr;
}
else {
print "Updated ", join( ',', keys(%$fv) ), "\n"
if $verbose;
$updates++;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
}
#
# If anything is left in @db_rows then they will be replacements
#
if ( scalar(@db_rows) > 0 ) {
say "Replacements found: ", scalar(@db_rows);
#
# Prepare to use SQL::Abstract
#
my $sql = SQL::Abstract->new();
#
# Every row which came from the database is to be deleted
#
$index = 0;
foreach my $db_key (@db_rows) {
$where[$index] = { episode_id => $episode };
$where[$index]->{id} = $db_key;
$index++;
}
_debug( $DEBUG >= 2, '@where ' . Dumper( \@where ) );
#
# Do deletions
#
foreach my $db_key (@db_rows) {
my ( $stmt, @bindvals )
= $sql->delete( 'assets', shift(@where) );
#
# Perform the deletions (unless in dry-run mode)
#
unless ($dry_run) {
$sth = $dbh->prepare($stmt);
$sth->execute(@bindvals);
if ( $dbh->err ) {
warn "Processing $episode\n", $dbh->errstr;
}
else {
print "Deleted ", join( ',', @db_rows ), "\n"
if $verbose;
$deletions++;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
#
# Every object in the found assets array for this episode is to be
# added.
#
foreach my $i (@asset_rows) {
my $obj = $assets->{$episode}->[$i];
$obj->{episode_id} = $episode;
my ( $stmt, @bindvals )
= $sql->insert( 'assets', $obj );
#
# Perform the additions (unless in dry-run mode)
#
unless ($dry_run) {
$sth = $dbh->prepare($stmt);
$sth->execute(@bindvals);
if ( $dbh->err ) {
warn "Processing $episode\n", $dbh->errstr;
}
else {
print "Inserted array elements ", join( ',', @asset_rows ), "\n"
if $verbose;
$additions++;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
}
return ( $additions, $deletions, $updates );
}
################################################################################
#
# Look for database assets to be ignored. The outer loop iterates through
# the primary key values of $db_assets where the rows all match the
# $episode value. For each of these assets the next loop iterates through
# the array of assets in $assets->{$episode} comparing the fields we want
# to check in the next inner loop. If the checked fields are all equal
# then there will be nothing to do.
#
# foreach my $db_key ( keys(%$db_assets) ) {
# foreach my $a_obj ( @{ $assets->{$episode} } ) {
# $ignore = $delete = $update = 0;
# foreach my $fld ( 'filename', 'URL' ) {
# $ignore
# += equal( $db_assets->{$db_key}->{$fld}, $a_obj->{$fld} );
# $delete
# += !equal( $db_assets->{$db_key}->{$fld}, $a_obj->{$fld} );
# }
# push( @{ $row_actions{'ignore'} }, $db_assets->{$db_key}->{id} )
# if $ignore == 2;
# push( @{ $row_actions{'delete'} }, $db_assets->{$db_key}->{id} )
# if $delete == 2;
# }
# }
#
# _debug( $DEBUG >= 4, '%row_actions ' . Dumper( \%row_actions ) );
#
#
# Scan the array of hashes obtained from the shownotes for $episode and
# record things that need changing.
#
# $index = 0;
# $updates = 0;
# foreach my $obj ( @{ $assets->{$episode} } ) {
# $fieldvals[$index] = {};
#
# #
# # Compare the fields we're interested in
# #
# foreach my $fld ( 'filename', 'URL' ) {
# if ( !equal( $obj->{$fld}, $db_assets->{$obj->{filename}}->{$fld} ) ) {
# $updates++;
# $fieldvals[$index]->{$fld} = $obj->{$fld};
# }
# }
#
# # TODO
# $fieldvals[$index]->{id} = $db_assets->{$obj->{filename}}->{id};
#
# $index++;
# }
#
# _debug( $DEBUG >= 2, '@fieldvals: ' . Dumper( \@fieldvals ) );
#
# if ($updates > 0 ) {
# #
# # Prepare to use SQL::Abstract
# #
# my $sql = SQL::Abstract->new();
#
# $where{episode_id} = $episode;
#
# foreach my $fv (@fieldvals) {
# $where{id} = $fv->{id};
# delete($fv->{id});
#
# my ( $stmt, @bindvals )
# = $sql->update( 'assets', $fv, \%where );
#
# #
# # Perform the updates (unless in dry-run mode)
# #
# unless ($dry_run) {
# $sth = $dbh->prepare($stmt);
# $sth->execute(@bindvals);
# if ( $dbh->err ) {
# warn "Processing $episode\n", $dbh->errstr;
# }
# else {
# print "Updated ", join( ',', keys(%$fv) ), "\n"
# if $verbose;
# }
# }
# else {
# print "Dry run mode:\n";
# print "Statement: $stmt\n";
# print "Bindvals: ", join( ", ", @bindvals ), "\n";
# }
# }
# }
#
################################################################################
#=== FUNCTION ================================================================
# NAME: insert_assets
# PURPOSE: Find missing assets and add them to SQLite
# PARAMETERS: $dbh SQLite database handle
# $episode Numeric episode
# $assets Hashref pointing to the collected assets which
# have been found by parsing the show's notes;
# keyed by episode number.
# $db_assets Hash of assets from SQLite, keyed by filename
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Number of insertions
# DESCRIPTION: The assets for this episode have been found by searching the
# HTML of the show notes and any linked HTML files for files on
# the HPR server. The equivalent assets have also been
# collected from the SQLite database. The MySQL assets are
# reorganised by filename. For each file which does not already
# exist in the SQLite list details are prepared and passed to
# SQL::Abstract using the multi insert feature. The missing
# details are inserted into the assets table unless dry-run mode
# is on.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub insert_assets {
my ( $dbh, $episode, $assets, $db_assets, $dry_run, $verbose ) = @_;
my ($sth, %db_by_file, %assets_by_file, $insertions, @multi_insert, %where);
#
# Reorder the %$db_assets hash in filename order
#
foreach my $key ( keys( %{$db_assets} ) ) {
$db_by_file{$db_assets->{$key}->{filename}} = $db_assets->{$key};
}
#
# Reorder the %assets hash in filename order
#
foreach my $obj ( @{ $assets->{$episode} } ) {
$assets_by_file{$obj->{filename}} = $obj;
}
_debug( $DEBUG >= 2, "%db_by_file: " . Dumper( \%db_by_file ) );
_debug( $DEBUG >= 2, "%assets_by_file: " . Dumper( \%assets_by_file ) );
#
# Find stuff for insertion. We need to build @multi_insert such that it
# contains a list of hashrefs, each containing the fields we want to
# insert.
# Note: We make a new %fv each time, fill it as a slice, and push it into
# the array @multi_insert. This may be rather obscure and therefore
# error-prone.
#
$insertions = 0;
foreach my $key ( keys(%assets_by_file) ) {
# if ( !exists( $db_assets->{$key} ) ) {
if ( !exists( $db_by_file{$key} ) ) {
my %fv;
$insertions++;
@fv{ 'episode_id', 'URL', 'filename' } = (
$episode, $assets_by_file{$key}->{URL},
$assets_by_file{$key}->{filename}
);
push( @multi_insert, \%fv );
}
}
_debug( $DEBUG >= 2, '@multi_insert: ' . Dumper( \@multi_insert ) );
if ($insertions > 0) {
#
# Prepare to use SQL::Abstract
#
my $sql = SQL::Abstract->new();
my ( $stmt, @bindvals )
= $sql->insert_multi( 'assets', \@multi_insert );
#
# Perform the insertions (unless in dry-run mode)
#
unless ($dry_run) {
$sth = $dbh->prepare($stmt);
$sth->execute(@bindvals);
if ( $dbh->err ) {
warn "Processing $episode\n", $dbh->errstr;
}
else {
# print "Inserted ",join(',',keys(%where)),"\n" if $verbose;
print "Inserted $insertions assets\n" if $verbose;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
return $insertions;
}
#=== FUNCTION ================================================================
# NAME: delete_assets
# PURPOSE: Find superfluous assets for an episode in the 'assets' table
# and delete them.
# PARAMETERS: $dbh SQLite database handle
# $episode Numeric episode
# $assets Hashref pointing to the collected assets which
# have been found by parsing the show's notes;
# keyed by episode number.
# $db_assets Hash of assets from SQLite, keyed by filename
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Number of deletions
# DESCRIPTION: The assets for this episode have been found by searching the
# HTML of the show notes and any linked HTML files for files on
# the HPR server. The equivalent assets have also been
# collected from the SQLite database. The MySQL assets are
# reorganised by filename. For each file exists in the SQLite
# list details are prepared and passed to SQL::Abstract. The
# unwanted details are deleted from the assets table unless
# dry-run mode is on.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub delete_assets {
my ( $dbh, $episode, $assets, $db_assets, $dry_run, $verbose ) = @_;
my ($sth, %db_by_file, %assets_by_file, $deletions, %where);
#
# Reorder the %$db_assets hash in filename order
#
foreach my $key ( keys( %{$db_assets} ) ) {
$db_by_file{$db_assets->{$key}->{filename}} = $db_assets->{$key};
}
#
# Reorder the %assets hash in filename order
#
foreach my $obj ( @{ $assets->{$episode} } ) {
$assets_by_file{$obj->{filename}} = $obj;
}
_debug( $DEBUG >= 2, "%db_by_file: " . Dumper( \%db_by_file ) );
_debug( $DEBUG >= 2, "%assets_by_file: " . Dumper( \%assets_by_file ) );
#
# Only delete assets with this value in the 'episode_id' field
#
$where{episode_id} = $episode;
#
# Find stuff for deletion. We need to build %where such that it generates
# 'WHERE filename = <value1> OR filename = <value2> ...', so we add these
# values to an (anonymous) array.
#
$deletions = 0;
foreach my $key ( keys(%$db_assets) ) {
# if ( !exists( $assets_by_file{$key} ) ) {
if ( !exists( $db_by_file{$key} ) ) {
$deletions++;
if ( !exists( $where{filename} ) ) {
$where{filename} = [$key];
}
else {
push( @{ $where{filename} }, $key );
}
}
}
_debug( $DEBUG >= 2, "%where: " . Dumper( \%where ) );
if ($deletions > 0) {
#
# Prepare to use SQL::Abstract
#
my $sql = SQL::Abstract->new();
my ( $stmt, @bindvals )
= $sql->delete( 'assets', \%where );
#
# Perform the deletions (unless in dry-run mode)
#
unless ($dry_run) {
$sth = $dbh->prepare($stmt);
$sth->execute(@bindvals);
if ( $dbh->err ) {
warn "Processing $episode\n", $dbh->errstr;
}
else {
print "Deleted ",join(',',keys(%where)),"\n" if $verbose;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
return $deletions;
}
#=== FUNCTION ================================================================
# NAME: update_episode
# PURPOSE: Perform a database update for a specific episode
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the SQLite database
# $episode Target episode to update
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Nothing
# DESCRIPTION: Performs an update for a single episode in the SQLite
# database. The usual scenario is after the Community News show
# has been posted, or a spelling mistake has been corrected for
# an episode. The episode is selected from the MySQL database
# and the SQLite one. The 'title' and 'summary' fields are
# compared across the two copies, and if they differ the
# necessary changes are set up to be executed or reported in
# 'dry run' mode.
# NOTE: No longer done this way:
# |A search for assets is made by reading the show notes and any
# |notes that are linked from these, and if there are
# |supplementary files they are accumulated and the database
# |updated as necessary (under control of the 'dry run' option).
# |This is currently the only way that the row in the SQLite
# |database can be updated after it has been loaded from the
# |MySQL database, other than when the metadata is collected and
# |applied. The metadata update process does not fix errors in
# |the 'title' or 'summary' fields.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub update_episode {
my ( $dbh1, $dbh2, $episode, $dry_run, $verbose ) = @_;
my ( $sql1, $sql2, $sth1, $h1, $sth2, $h2, $sth3 );
my ( %assets, $asset_count, $assets_added, $assets_deleted, $assets_updated );
my ( $id, $notes, $links );
my ( $updates, %fieldvals, %where );
#
# SQL to find new rows in the MySQL database
#
$sql1 = q{
SELECT
id,
date,
title,
summary,
notes
FROM eps
WHERE id = ?
};
#
# SQL to look for pre-existing episodes in the SQLite database
#
$sql2 = q{
SELECT * FROM episodes WHERE id = ?
};
#
# Prepare the SQL statements
#
$sth1 = $dbh1->prepare($sql1);
$sth2 = $dbh2->prepare($sql2);
#
# Query MySQL, for the $episode
#
$sth1->execute($episode);
if ( $dbh1->err ) {
croak $dbh1->errstr;
}
#
# Loop through the MySQL row (should only be one)
#
$asset_count = $updates = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
#
# Query the SQLite database for the episode number we just got
#
$sth2->execute( $h1->{id} );
if ( $dbh2->err ) {
croak $dbh2->errstr;
}
$h2 = $sth2->fetchrow_hashref;
#
# If the row doesn't exist we have a problem.
# TODO: Could we just add the episode at this point?
#
unless ($h2) {
warn "Row $episode is not in the SQLite database\n";
return;
}
#
# Look for title and summary changes and build a hash holding the
# changes
#
foreach my $fld ( 'title', 'summary' ) {
if ( !equal( $h1->{$fld}, $h2->{$fld} ) ) {
$updates++;
$fieldvals{$fld} = $h1->{$fld};
}
}
if ($updates > 0 ) {
#
# Prepare to use SQL::Abstract
#
my $sql = SQL::Abstract->new();
$where{id} = $episode;
my ( $stmt, @bindvals )
= $sql->update( 'episodes', \%fieldvals, \%where );
#
# Perform the updates (unless in dry-run mode)
#
unless ($dry_run) {
$sth3 = $dbh2->prepare($stmt);
$sth3->execute(@bindvals);
if ( $dbh2->err ) {
warn "Processing $episode\n", $dbh2->errstr;
}
else {
print "Updated ",join(',',keys(%fieldvals)),"\n" if $verbose;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
#
# Check this show for "assets". Even in dry-run mode this gets
# executed
#
$links = 0;
$id = $h1->{id};
$notes = $h1->{notes};
# $links = find_links($id,$notes,\%assets);
$links = find_assets($ssh,$episode,$rempath,\%assets);
$asset_count += $links;
}
if ( $asset_count > 0 ) {
_debug( $DEBUG >= 2, "Scanned assets:\n" . Dumper( \%assets ) );
}
else {
_debug( $DEBUG >= 2, "No assets found" );
}
#
# Add any assets collected from the episode just processed
#
$assets_added = 0;
if ($asset_count > 0) {
( $assets_added, $assets_deleted, $assets_updated ) =
process_assets( $dbh2, \%assets, 0, $dry_run, $verbose );
}
printf "%-16s %d\n", "Episode checked:", $episode;
printf "%-16s %d\n", "Episode updates:", $updates;
printf "%-16s %d\n", "Assets found:", $asset_count;
printf "%-16s %d\n", "Assets added:", coalesce( $assets_added, 0 );
printf "%-16s %d\n", "Assets deleted:", coalesce( $assets_deleted, 0 );
printf "%-16s %d\n", "Assets updated:", coalesce( $assets_updated, 0 );
$log->info("Episode number: $episode");
$log->info("Episode updates: $updates");
$log->info( 'Assets added,deleted,updated:',
coalesce( $assets_added, 0 ), ',',
coalesce( $assets_deleted, 0 ), ',',
coalesce( $assets_updated, 0 )
);
}
#=== FUNCTION ================================================================
# NAME: load_metadata
# PURPOSE: Loads values from a JSON file which has been generated by the
# 'ia metadata' command and stores them in the 'episodes' table.
# Also uses the JSON data to determine if the derived files and
# the source file have been uploaded and which assets have been
# uploaded.
# PARAMETERS: $dbh Handle for the SQLite database
# $file Name of file of JSON data
# $dry_run Boolean dry run setting
# $verbose Boolean verbose setting
# RETURNS: Nothing
# DESCRIPTION: The input file is expected to consist of many JSON complex
# objects, generated by the command 'ia metadata <identifier>'
# for a list of HPR episodes (see script 'collect_show_data').
# A count is kept of successful updates, and this is reported
# once finished.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub load_metadata {
my ( $dbh, $file, $dry_run, $verbose ) = @_;
my ( $filebuffer, @jsonbuffer, %cols, %fieldvals, %where );
my ( @deletions, $index );
my ( @stash, @assets, $orig_count, $source, $epid, $count, $updates );
my ( $sth1, $sth2, $sth3, $rv, $h );
my $template = "https://archive.org/details/hpr%04d";
my @flds = (
'uploaded', 'has_files',
'with_files', 'with_derived',
'with_source', 'archive_date',
'item_last_updated', 'IA_URL',
);
my $re = qr{^hpr\d{4}\.(flac|mp3|ogg|opus|spx|wav)$};
#
# Read the entire JSON file into a buffer
#
try {
$filebuffer = read_text($file);
}
catch {
die "Failed to read JSON file $file\n";
};
#
# Parse the JSON from the buffer
#
my $json = JSON->new;
@jsonbuffer = $json->incr_parse($filebuffer);
#print Dumper(\@jsonbuffer),"\n";
#
# Check that this is the type of JSON we need
#
unless (@jsonbuffer) {
warn "Empty JSON?\n";
return;
}
#
# Look at each top-level JSON object and check for missing components.
# It's possible for there to be missing objects, but only in very rare
# cases when a range has been requested yet there's a gap in that range
# (reserved slot perhaps). We accumulate indices of invalid objects in
# @jsonbuffer and then delete the invalid objects.
#
$index = 0;
foreach my $obj (@jsonbuffer) {
unless ( exists( $obj->{metadata} )
&& exists( $obj->{metadata}->{identifier} )
&& exists( $obj->{files} ))
{
warn "Invalid JSON? Skipped object #$index\n";
push( @deletions, $index );
next;
}
$index++;
}
#
# Delete any bad objects we found in the previous pass
#
for my $ind (@deletions) {
splice( @jsonbuffer, $ind, 1 );
print STDERR "Deleted invalid item with index $ind\n" if $verbose;
}
print "\n" if $verbose;
#
# Prepare to get the database row relating to an episode
#
$sth1 = $dbh->prepare("SELECT * FROM episodes WHERE id = ?");
#
# Prepare to get the rows relating to assets for an episode
#
$sth2 = $dbh->prepare("SELECT * FROM assets WHERE episode_id = ?");
$count = 0;
foreach my $obj (@jsonbuffer) {
if ( $obj->{metadata}->{identifier} =~ /hpr(\d{4})/ ) {
$epid = $1 + 0;
#
# Skip the episodes in the range 1-620
#
#next if ( $epid <= 620 );
#
# 2021-06-27: We don't skip any more. Shows 1-620 have been
# uploaded in blocks, but we want them on the IA in the same
# format as all the others. Today we hit 620, working backwards
# from the earliest IA upload as a project to upload everything
# with show notes and assets. The existing database entries were
# changed to make the 'notes' field hold the text 'Block upload'
# followed by the block archive date and the URL. Then the rows
# between 1-620 are then to have the new date and URL and these
# columns have been made NULL in preparation. See the Journal for
# more information.
#
if ($verbose) {
print "Processing ", $obj->{metadata}->{identifier}, "\n";
print "Publicdate: ", $obj->{metadata}->{publicdate}, "\n";
}
#
# Process the files in the metadata
#
$orig_count = 0;
$source = 0;
undef(@stash);
foreach my $f ( @{ $obj->{files} } ) {
#
# Skip anything with a 'Metatda' format or which has a source
# of 'derivative' or 'metadata' or is the newly added
# '__ia_thumb.jpg'
#
next
if ( $f->{format} eq 'Metadata'
|| $f->{source} =~ /^(derivative|metadata)$/
|| $f->{name} eq '__ia_thumb.jpg'
|| $f->{name} =~ /^history\/files\// );
#
# Count audio files which have been "derived" (by us) prior to upload,
# and those that look like 'source' files (e.g.
# hpr2472_source.flac). Anything else store in @stash because
# it's probably an asset file.
#
if ( $f->{name} =~ $re ) {
$orig_count++;
}
elsif ( $f->{name} =~ /^hpr\d{4}_source\..+$/ ) {
$source++;
}
else {
push(@stash,$f->{name});
}
printf "%s %s\n", $f->{name}, $f->{source} if $verbose;
}
#
# Check the assets before updating the episode
#
@assets = collect_assets($dbh, $sth2, $epid);
_debug( $DEBUG >= 2, '@assets: ' . Dumper(\@assets));
_debug( $DEBUG >= 2, '@stash: ' . Dumper(\@stash));
if (@assets || @stash) {
@assets = sort(@assets);
@stash = sort(@stash);
#
# Smart match the @assets and @stash arrays to look for
# difference. In @assets we have what the database holds, and
# in @stash we have stored what we found in the JSON.
# NOTE: Now that Smartmatch ('~~') is deprecated we use the
# rather clever 'match::smart' with its strange |M| operator.
# It needs arrays being matched to be offered as references
# however.
#
# unless ( @assets ~~ @stash ) {
unless ( \@assets |M| \@stash ) {
print "Difference between DB assets and IA\n";
print "DB assets:\n ",join("\n ",@assets),"\n";
print "IA assets:\n ",join("\n ",@stash),"\n";
}
#
# In live mode mark all assets belonging to this episode as
# 'uploaded'.
# TODO: Is this dangerous?
#
unless ($dry_run) {
mark_assets_uploaded($dbh,$epid);
}
else {
print "Update of 'assets' table skipped; dry run\n";
}
}
#
# Prepare to use SQL::Abstract
#
my $sql = SQL::Abstract->new();
#
# Get the current row for this episode for comparison to find what
# has been changed.
#
$rv = $sth1->execute($epid);
if ( $dbh->err ) {
warn $dbh->errstr;
}
$h = $sth1->fetchrow_hashref;
#
# Store the changes
#
$cols{'uploaded'} = 1;
$cols{'has_files'} = ( scalar(@stash) > 0 ? 1 : 0 );
$cols{'with_files'} = ( scalar(@stash) > 0 ? 1 : 0 );
$cols{'with_derived'} = ( $orig_count >= 2 ? 1 : 0 );
$cols{'with_source'} = ( $source > 0 ? 1 : 0 );
$cols{'archive_date'} = $obj->{metadata}->{publicdate};
$cols{'item_last_updated'} = coalesce($obj->{item_last_updated},0);
$cols{'IA_URL'} = sprintf( $template, $epid );
#
# Look for differences, storing the updated values in %fieldvals
# and counting the changes.
#
$updates = 0;
undef(%fieldvals);
foreach my $fld (@flds) {
if ( !equal( $h->{$fld}, $cols{$fld} ) ) {
$updates++;
$fieldvals{$fld} = $cols{$fld};
}
}
if ( $updates > 0 ) {
#
# Build the update statement containing changes. It will be:
# "UPDATE episodes SET a = b, c = d, ... WHERE id = $epid"
#
$where{id} = $epid;
my ( $stmt, @bindvals )
= $sql->update( 'episodes', \%fieldvals, \%where );
#
# Perform the updates (unless in dry-run mode)
#
unless ($dry_run) {
$sth3 = $dbh->prepare($stmt);
$sth3->execute(@bindvals);
if ( $dbh->err ) {
warn "Processing $epid\n", $dbh->errstr;
}
else {
print "Updated\n" if $verbose;
$count++;
}
}
else {
print "Dry run mode:\n";
print "Statement: $stmt\n";
print "Bindvals: ", join( ", ", @bindvals ), "\n";
}
}
}
else {
printf "Unexpected identifier: %s\n", $obj->{metadata}->{identifier};
}
print '-' x 80, "\n" if $verbose;
}
print "Number of updates: $count\n";
$log->info("Number of updates from JSON: $count");
}
#=== FUNCTION ================================================================
# NAME: collect_assets
# PURPOSE: Collects asset names for a given episode
# PARAMETERS: $dbh Handle for the SQLite database
# $sth Statement handle for the prepared query
# $epid Episode id
# RETURNS: A list of the asset names
# DESCRIPTION: Just prepares a list of asset filenames by querying the SQLite
# 'assets' table and returns it to the caller
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub collect_assets {
my ( $dbh, $sth, $epid ) = @_;
my ( $rv, $h, @result );
#
# Query the database
#
$rv = $sth->execute($epid);
if ( $dbh->err ) {
warn $dbh->errstr;
}
while ($h = $sth->fetchrow_hashref) {
push(@result,$h->{filename});
}
return @result;
}
#=== FUNCTION ================================================================
# NAME: mark_assets_uploaded
# PURPOSE: Marks the assets relating to an episode as 'uploaded'
# PARAMETERS: $dbh Handle for the SQLite database
# $epid Episode id
# RETURNS: Number of updates
# DESCRIPTION: Mark any assets for a given episode as uploaded, if they are
# not so marked. Expected to be used during an update from JSON
# data collected from the IA.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub mark_assets_uploaded {
my ( $dbh, $epid ) = @_;
my ($rows);
$rows = $dbh->do(
q{UPDATE assets SET uploaded = 1
WHERE episode_id = ? AND uploaded = 0},
undef,
$epid,
) or die $dbh->errstr;
$rows += 0;
return $rows;
}
#=== FUNCTION ================================================================
# NAME: scan_dir
# PURPOSE: Scans a file from the HPR server generated with a simple
# 'find' command which lists all the files and directories under
# the ~/www/eps/ directory.
# PARAMETERS: $dbh Handle for the SQLite database
# $file Name of file of directory data
# RETURNS: Nothing
# DESCRIPTION: Under development
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub scan_dir {
my ( $dbh, $file ) = @_;
my ( %dirtree, $ptr, %shows, $key, $id );
#
# Open the file of paths
#
open( my $fh, "<:encoding(UTF-8)", $file )
or die "Unable to open '$file'\n";
#
# Loop through all paths. If it's one of the audio files then skip it
#
while ( my $line = <$fh> ) {
chomp($line);
next if ( $line =~ /(flac|mp3|ogg|opus|spx|wav)$/ );
#
# Point into the tree hash and add the necessary nodes from the split
# path. The result is a hierarchical has structure where the 'leaf'
# node has an empty anonymous hash as its value.
#
# %dirtree = {
# 'www' => {
# 'eps' => {
# 'hpr2356' => {
# 'index.html' => {},
# 'fix-ssh-on-pi.bash.txt' => {}
# },
# },
# },
# }
#
$ptr = \%dirtree;
$ptr = $ptr->{$_} //= {} for split( /\//, $line );
}
close($fh);
#print Dumper(\%dirtree),"\n";
#
# Build a hash indexed by IA identifier containing an array per value with
# the files relating to the show therein
#
$ptr = \%dirtree;
# TODO if there are multiple items at a level which one to test
$key = ( keys(%$ptr) )[0];
#$key = first { defined($_) } keys(%$ptr);
until ( $key =~ /^hpr[0-9]{4}/ ) {
print "$key\n";
$ptr = $ptr->{$key};
$key = ( keys(%$ptr) )[0];
}
#print join(", ",keys(%$ptr));
# TODO Doesn't deal with sub-directories
foreach my $k ( keys(%$ptr) ) {
if ( ($id) = ( $k =~ /^(hpr[0-9]{4})/ ) ) {
unless ( defined( $shows{$id} ) ) {
$shows{$id} = [];
}
push( @{ $shows{$id} }, $k );
}
}
print Dumper( \%shows ), "\n";
}
#=== FUNCTION ================================================================
# NAME: find_assets
# PURPOSE: An alternative way to look for assets; connect to the server
# with SSH and use a 'find' command for matching files and
# directories.
# PARAMETERS: $ssh Net::OpenSSH object previously set up to
# connect to the server
# $episode episode number we're dealing with
# $rempath path to search on the server
# $rfiles hashref to receive the files (assets) found
# RETURNS: Number of files found
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub find_assets {
my ($ssh, $episode, $rempath, $rfiles) = @_;
my $urlbase = 'https://hackerpublicradio.org/eps/';
my (@result, @row, $URL, $file, $assetcount);
$rempath .= '/' unless ($rempath =~ /\/$/);
@result = $ssh->capture({ timeout => 10 },
"find $rempath -regextype egrep -regex '.*/hpr${episode}.*' -printf '%y,%p,%s\n'");
$ssh->error and warn "remote 'find' command failed: " . $ssh->error;
# d,/home/hpr/www/eps/hpr3775,85
# f,/home/hpr/www/eps/hpr3775/hpr3775_source.wav,75006546
# f,/home/hpr/www/eps/hpr3775/hpr3775.vtt,13127
# f,/home/hpr/www/eps/hpr3775/hpr3775.srt,13830
# f,/home/hpr/www/eps/hpr3775/hpr3775.txt,11119
# f,/home/hpr/www/eps/hpr3775.mp3,7449559
# f,/home/hpr/www/eps/hpr3775.ogg,10631998
# f,/home/hpr/www/eps/hpr3775.spx,3516736
$assetcount = 0;
$rfiles->{$episode} = [];
for my $file (@result) {
@row = split( ',', $file );
if ( $row[0] eq 'f' ) {
unless ( $row[1] =~ /$episode\.(mp3|ogg|spx)$/ ) {
( $URL = $row[1] ) =~ s/$rempath/$urlbase/;
( $file = $row[1] ) =~ s/$rempath//;
push(
@{ $rfiles->{$episode} },
{ filename => $file, URL => $URL }
);
$assetcount++;
}
}
}
_debug( $DEBUG >= 2, "Results from 'find':\n" . Dumper( \@result ) );
#
# Return the asset count
#
return $assetcount;
}
#=== FUNCTION ================================================================
# NAME: find_links
# PURPOSE: Parses the HTML in a string for links so that a list of assets
# relating to this show can be made
# PARAMETERS: $episode episode number we're dealing with
# $html string containing HTML
# $rlinks hashref to receive the links found
# RETURNS: Number of links found
# DESCRIPTION: Given HTML from the main notes or a subsidiary file the
# function parses this looking for links in 'a' or 'img' tags.
# Links are standardised, making them absolute if relative and
# removing any 'fragment'. The links need to be to files on the
# HPR website to be of interest. If so the filename part is
# extracted. If it follows the format 'hpr9999' then it's
# checked to see if it's for the current show. If not it's
# ignored. If the filename ends with a '/' then it's assumed
# it's shorthand for 'index.html' so this name is appended. Then
# the link and filename are stashed in the hash referenced by
# $rlinks. If the filename ends with '.html' then we need to
# parse it in turn, so we get the contents of the link and
# recurse to parse it. We return the number of HPR links found
# in the pass through the HTML.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub find_links {
my ( $episode, $html, $rlinks ) = @_;
my ($tree, $epstr, $linkre, $re2, $filepath,
$uri, $slink, $linkcount, $content
);
_debug( $DEBUG >= 3, "find_links enter\n" );
#
# Create a tree object
#
$tree = HTML::TreeBuilder->new;
$tree->ignore_unknown(0);
$tree->no_expand_entities(1);
$tree->p_strict(1);
$tree->store_comments(1);
$tree->warn(1);
$tree->parse_content($html)
or die "HTML::TreeBuilder failed to parse notes: $!\n";
my $baseURL = "https://hackerpublicradio.org";
$epstr = sprintf( "hpr%04d", $episode );
$linkre = qr{
^https?://
(?:www.)?
(?:hacker|hobby)publicradio.org/eps/
(.+)$
}x;
#(?:(hpr$epstr/.+)|(hpr$epstr.+)|(.+))$
#
# Counting new links found and stashed
#
$linkcount = 0;
#
# Scan for links
#
for ( @{ $tree->extract_links( 'a', 'img' ) } ) {
my ( $link, $element, $attr, $tag ) = @$_;
#
# Standardise the link (expands relative URLs, removes any fragment).
# Set $URI::ABS_REMOTE_LEADING_DOTS to ensure leading dots in relative
# URIs are removed.
#
local $URI::ABS_REMOTE_LEADING_DOTS = 1;
$uri = URI->new_abs( $link, $baseURL );
$slink = sprintf( "%s:%s", $uri->scheme, $uri->opaque );
#
# Is it an HPR link?
#
if ( $slink =~ $linkre ) {
#
# The URL we found might be a link into an HTML file with an
# '#anchor' component ("fragment"). Save the last bracketed match,
# without any 'fragment' if there is one to get a clean filename
# or path.
#
( $filepath = "$+" ) =~ s/#.*$//;
_debug( $DEBUG >= 3, "Link: $slink\n" );
_debug( $DEBUG >= 3, "File path: $filepath\n" );
#
# Does this file path begin with an 'hpr' prefix? If so is it the
# show id? If not we don't want to process it.
#
if ( $filepath =~ /^(hpr[0-9]{1,4})/ ) {
if ( $1 ne $epstr ) {
_debug( $DEBUG >= 3, "Ignored $slink\n" );
next;
}
}
#
# The path and URL might end with a slash which means the URL is
# relying on the Web server to fill in the filename as
# 'index.html'. We have to make this explicit.
#
if ( $slink =~ /\/$/ ) {
$slink .= 'index.html';
$filepath .= 'index.html';
}
#
# Initialise this hash element if needed
#
unless ( exists( $rlinks->{$episode} ) ) {
$rlinks->{$episode} = [];
}
#
# Stash this filename if it's not already stashed, and if it's
# HTML get the link and recurse
#
unless (
any { $_->{filename} eq $filepath } @{ $rlinks->{$episode} }
)
{
_debug( $DEBUG >= 3, "Stashed $slink and $filepath\n" );
push(
@{ $rlinks->{$episode} },
{ filename => $filepath, URL => $slink }
);
$linkcount++;
#
# An HTML file has to be investigated
#
if ( $filepath =~ /\.html$/ ) {
$content = get($slink);
unless ( defined($content) ) {
carp "Link $slink returned nothing\n";
}
else {
$linkcount
+= find_links( $episode, $content, $rlinks );
}
}
}
}
}
_debug( $DEBUG >= 3, "find_links exiting with $linkcount links\n" );
#
# Return the link count
#
return $linkcount;
}
#=== FUNCTION ================================================================
# NAME: count_rows
# PURPOSE: Counts the rows in a given SQLite table
# PARAMETERS: $dbh Handle for the SQLite database
# $table Name of table
# RETURNS: Number of rows
# DESCRIPTION: Builds SQL from a template including the selected $table.
# Returns the number of rows once the query has been run.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub count_rows {
my ( $dbh, $table ) = @_;
my ( $sql, $sth, $h, $count );
#
# Count rows in the selected SQLite table
#
$sql = "SELECT count(*) AS rowcount FROM $table";
$sth = $dbh->prepare($sql);
$sth->execute();
if ( $dbh->err ) {
croak $dbh->errstr;
}
$count = 0;
if ($h = $sth->fetchrow_hashref) {
$count = $h->{rowcount};
}
return $count;
}
#=== FUNCTION ================================================================
# NAME: coalesce
# PURPOSE: To find the first defined argument and return it
# PARAMETERS: Arbitrary number of arguments
# RETURNS: The first defined argument or undef if there are none
# DESCRIPTION: Just a simple way of ensuring an 'undef' value is never
# returned when doing so might be a problem.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub coalesce {
foreach (@_) {
return $_ if defined($_);
}
return undef; ## no critic
}
#=== FUNCTION ================================================================
# NAME: assets_match
# PURPOSE: To compare found assets and those in the database
# PARAMETERS: $found_obj an asset object (hashref) found by parsing show
# notes
# $db_obj an asset object (hashref) from the database
# RETURNS: Value 1 or 2 if they match, otherwise zero
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub assets_match {
my ( $found_obj, $db_obj ) = @_;
return 0 if ( !defined($found_obj) || !defined($db_obj) );
my ( $t1, $t2 ) = (
( $found_obj->{filename} eq $db_obj->{filename} ),
( $found_obj->{URL} eq $db_obj->{URL} )
);
return 2 if ( $t1 && $t2 );
return 1 if ( $t1 || $t2 );
}
#=== FUNCTION ================================================================
# NAME: equal
# PURPOSE: Compare two strings even if undefined
# PARAMETERS: $s1 The first string
# $s2 The second string
# RETURNS: True if both strings are undefined, false if one isn't
# defined, otherwise the result of comparing them.
# DESCRIPTION: Works on the principle that two undefined strings are equal,
# a defined and an undefined string are not, and otherwise they
# are equal if they are equal!
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub equal {
my ( $s1, $s2 ) = @_;
return 1 if ( !defined($s1) && !defined($s2) );
return 0 if ( !defined($s1) || !defined($s2) );
return ( $s1 eq $s2 );
}
#=== FUNCTION ================================================================
# NAME: _debug
# PURPOSE: Prints debug reports
# PARAMETERS: $active Boolean: 1 for print, 0 for no print
# $message Message to print
# RETURNS: Nothing
# DESCRIPTION: Outputs a message if $active is true. It removes any trailing
# newline and then adds one in the 'print' to the caller doesn't
# have to bother. Prepends the message with 'D> ' to show it's
# a debug message.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub _debug {
my ( $active, $message ) = @_;
chomp($message);
print "D> $message\n" if $active;
}
#=== FUNCTION ================================================================
# NAME: Usage
# PURPOSE: Displays a usage message and exit
# PARAMETERS: None
# RETURNS: To command line level with exit value 1
# DESCRIPTION: Builds the usage message using global values
# THROWS: no exceptions
# COMMENTS: none
# SEE ALSO: n/a
#===============================================================================
#sub Usage {
# print STDERR <<EOD;
#
#Usage: $PROG [options] directory
#
#$PROG v$VERSION
#
# -help Display this information
# -[no]dry-run Enable/disable dry run mode (default off)
# -[no]verbose Enable/disable verbose mode (default off)
# -debug=N Set the debug level
# -mode=MODE Selects the mode from the following list:
# - initialise: rebuild the SQLite database from MySQL
# (deletes any data already uploaded)
# - update: updates the SQLite database from updates
# found in the MySQL database
# - json: load the 'archive_date' field from a JSON
# file. Also sets the 'uploaded' flag and populates
# the 'IA_URL' field
# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
# - scandir: scans a file captured from the HPR server
# by running a 'find' command on the 'eps' directory
# where all the show files reside. This file is
# scanned to determine which shows have files other
# than the audio so we can keep a tally of which shows
# have had these uploaded to the IA
# ** Not fully implemented **
# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
# -episode=N1 [-episode=N2 ...]
# In -mode=update defines one or more single episodes to
# process otherwise, if this option is not given, all
# new episodes in the database are processed. The
# episodes are expected to have been already added if
# the option is used, and the 'title' and 'summary'
# fields and the assets (if any) are to be processed.
# -range=N1 [-range=N2]
# An alternative way of defining existing shows to be
# processed in -mode=update. The option can only be
# repeated twice. The smaller number defines the start
# of the range, and the larger one the end of the range.
# So -range=834 -range=840 defines the range 836-840. If
# one number is given (or two the same) this means the
# same as defining one episode. The episodes are
# expected to have been already added and the 'title'
# and 'summary' fields and the assets (if any) are to be
# processed.
# -json=FILE Defines the file to use for -mode=json
# -scandir=FILE Defines a file to use for -mode=scandir
# -dbconfig=FILE Defines an alternative MySQL configuration file
#
#EOD
# exit(1);
#}
#=== FUNCTION ================================================================
# NAME: Options
# PURPOSE: Processes command-line options
# PARAMETERS: $optref Hash reference to hold the options
# RETURNS: Undef
# DESCRIPTION: Process the options we want to offer. See the documentation
# for details
# THROWS: no exceptions
# COMMENTS: none
# SEE ALSO: n/a
#===============================================================================
sub Options {
my ($optref) = @_;
my @options = (
"help", "documentation|man",
"debug=i", "mode=s",
"json=s", "scandir=s",
"episode=i@", "range=i@",
"dry-run!", "verbose!",
"dbconfig=s",
);
if ( !GetOptions( $optref, @options ) ) {
pod2usage(
-msg => "$PROG version $VERSION\n",
-exitval => 1,
-verbose => 0
);
}
return;
}
__END__
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Application Documentation
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#{{{
=head1 NAME
upload_manager - manages a SQLite database of details of shows on archive.org
=head1 VERSION
This documentation refers to upload_manager version 0.2.19
=head1 USAGE
./upload_manager [-help] [-documentation] [-[no]dry-run] [-[no]verbose]
[-debug=N] -mode=MODE [-episode=N1 [-episode=N2 ...]] [-range=START
[-range=END]] [-json=FILE] [-scandir=FILE] [-dbconfig=FILE]
=head1 OPTIONS
=over 8
=item B<-help>
Display a brief summary of how to use this script.
=item B<-documentation> or B<-man>
Display the entirety of the internal documentation in the form of a manual
page.
=item B<-[no]dry-run>
Enable/disable dry run mode (default off)
=item B<-[no]verbose>
Enable/disable verbose mode (default off)
=item B<-debug=N>
Sets the debug level:
=over 4
=item B<0>
This is the default value, and causes no debug output to be generated.
=item B<1>
TBA
=item B<2>
Produces quite a lot of asset-related output. All of the output from the lower debug levels is
displayed as well as:
=over 4
=item .
Contents of the %assets hash. This is generated when scanning a show in the
MySQL database in order to find any associated assets.
=item .
The episode number being checked and the number of assets found while
processing assets. A dump of the assets from the SQLite database is shown as
well as the count of assets found therre.
=item .
If there are assets related to a show and there are already some in the SQLite
database, a comparison is made to see if any updates are needed. These
differences are listed.
=item .
If new assets are being added, these are reported from the hash
%assets_by_file.
=item .
Assets are added using a multiple INSERT statement, and details of what is to
be inserted is shown in the array @multiple_insert.
=back
=item B<3>
Produces the most output. All of the output from the lower debug levels is
displayed as well as:
=over 4
=item .
Contents of the @episodes array. This is generated by using the B<-episode=N>
option once or many times. It is shown before and after the removal of
duplicates.
=item .
Contents of the @range array. This is generated by using the B<-range=N>
option once or twice.
=back
=back
=item B<-mode=MODE>
Selects the mode of operation of the script from the following list:
=over 4
=item B<initialise>
Rebuilds the SQLite database from the MySQL data. Use with caution, though
the script will not initialise tables which contain data.
=item B<update>
Updates the SQLite database from updates found in the MySQL database. Exactly
how this is done is controlled by other options. See below for details.
=item B<json>
Load the 'archive_date' field from a JSON file. Also sets the 'uploaded' flag
and populates the 'IA_URL' and 'item_last_updated' fields.
=item B<scandir>
Scans a file captured from the HPR server by running a 'find' command on the
'eps' directory where all the show files reside. This file is scanned to
determine which shows have files other than the audio so we can keep a tally
of which shows have had these uploaded to the IA
** Not fully implemented; may be phased out **
=back
=item B<-episode=N1 [-episode=N2 ...]>
In B<-mode=update> defines one or more single episodes to process otherwise, if
this option is not given, all new episodes in the database are processed. The
episodes are expected to have been already added if this option is used, and
the 'title' and 'summary' fields and the assets (if any) are to be processed.
=item B<-range=N1 [-range=N2]>
An alternative way of defining existing shows to be processed in
B<-mode=update>. The option can only be repeated twice. The smaller number
defines the start of the range, and the larger one the end of the range. So
B<-range=834 -range=840> defines the range 836-840. If one number is given (or
two the same) this means the same as defining one episode. The episodes are
expected to have been already added and the 'title' and 'summary' fields and
the assets (if any) are to be processed.
=item B<-json=FILE>
Defines the file to use for B<-mode=json>. The contents of the file are
expected to be those produced by running B<collect_show_data>.
=item B<-scandir=FILE>
Defines a file to use for B<-mode=scandir>. This feature is not fully
implemented at the moment.
=item B<-dbconfig=FILE>
Defines an alternative MySQL configuration file
=back
=head1 DESCRIPTION
A full description of the application and its features.
May include numerous subsections (i.e. =head2, =head3, etc.)
=head1 DIAGNOSTICS
A list of every error and warning message that the application can generate
(even the ones that will "never happen"), with a full explanation of each
problem, one or more likely causes, and any suggested remedies. If the
application generates exit status codes (e.g. under Unix) then list the exit
status associated with each error.
=head1 CONFIGURATION AND ENVIRONMENT
A full explanation of any configuration system(s) used by the application,
including the names and locations of any configuration files, and the
meaning of any environment variables or properties that can be set. These
descriptions must also include details of any configuration language used
=head1 DEPENDENCIES
A list of all the other modules that this module relies upon, including any
restrictions on versions, and an indication whether these required modules are
part of the standard Perl distribution, part of the module's distribution,
or must be installed separately.
=head1 INCOMPATIBILITIES
A list of any modules that this module cannot be used in conjunction with.
This may be due to name conflicts in the interface, or competition for
system or program resources, or due to internal limitations of Perl
(for example, many modules that use source code filters are mutually
incompatible).
=head1 BUGS AND LIMITATIONS
A list of known problems with the module, together with some indication
whether they are likely to be fixed in an upcoming release.
Also a list of restrictions on the features the module does provide:
data types that cannot be handled, performance issues and the circumstances
in which they may arise, practical limitations on the size of data sets,
special cases that are not (yet) handled, etc.
The initial template usually just has:
There are no known bugs in this module.
Please report problems to <Maintainer name(s)> (<contact address>)
Patches are welcome.
=head1 AUTHOR
<Author name(s)> (<contact address>)
=head1 LICENCE AND COPYRIGHT
Copyright (c) <year> <copyright holder> (<contact address>). All rights reserved.
Followed by whatever licence you wish to release it under.
For Perl code that is often just:
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See perldoc perlartistic.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
=cut
#}}}
# [zo to open fold, zc to close]
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
Reference in New Issue Copy Permalink