307 lines
9.4 KiB
Plaintext
307 lines
9.4 KiB
Plaintext
|
#!/usr/bin/env perl
|
||
|
#===============================================================================
|
||
|
#
|
||
|
# FILE: check_reservations
|
||
|
#
|
||
|
# USAGE: ./check_reservations
|
||
|
#
|
||
|
# DESCRIPTION: Interrogate the 'reservations' table in the live HPR database
|
||
|
# through an SSH tunnel. The result is used to look at and
|
||
|
# report the state of processing on the local system.
|
||
|
#
|
||
|
# The original version of this script ran a remote command on
|
||
|
# the VPS, but was very vulnerable to VPS and tunnel failure.
|
||
|
#
|
||
|
# OPTIONS: ---
|
||
|
# REQUIREMENTS: ---
|
||
|
# BUGS: ---
|
||
|
# NOTES: ---
|
||
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
||
|
# VERSION: 0.0.8
|
||
|
# CREATED: 2019-01-07 12:29:06
|
||
|
# REVISION: 2023-07-01 23:04:16
|
||
|
#
|
||
|
#===============================================================================
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
use utf8;
|
||
|
use feature qw{ postderef say signatures state };
|
||
|
no warnings qw{ experimental::postderef experimental::signatures };
|
||
|
|
||
|
use Carp;
|
||
|
use Getopt::Long;
|
||
|
use Config::General;
|
||
|
use DBI;
|
||
|
|
||
|
#
|
||
|
# Version number (manually incremented)
|
||
|
#
|
||
|
our $VERSION = '0.0.8';
|
||
|
|
||
|
#
|
||
|
# 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/Show_Submission";
|
||
|
my $cache = "$basedir/shownotes";
|
||
|
my $configfile = "$basedir/.hpr_db.cfg";
|
||
|
my $reserved = '9999';
|
||
|
|
||
|
my ( $dbh, $sth1, $h1 );
|
||
|
my ( $show, @res);
|
||
|
my $count = 0;
|
||
|
|
||
|
#
|
||
|
# Interpretations of the new status values in the database
|
||
|
#
|
||
|
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
# The sequence seems to be:
|
||
|
# 1. User selects a free slot (request.php), status becomes
|
||
|
# REQUEST_UNVERIFIED, verified is 0, no email address recorded yet, IP
|
||
|
# address recorded
|
||
|
# 2. User enters the email address to receive the link to the form and presses
|
||
|
# 'Next'. An email is sent with the link and status changes to
|
||
|
# REQUEST_EMAIL_SENT, now the email address is filled out but verified
|
||
|
# is 0 still.
|
||
|
# 3. User clicks the link in the email they received which takes them to the
|
||
|
# form, now the state becomes EMAIL_LINK_CLICKED and verified is 1. We see
|
||
|
# this as 'pending', the first status we take account of since we exclude
|
||
|
# all records in the 'reservations' table where verified is 0.
|
||
|
# 4. The user completes the form and hits the 'Send' button. When all files
|
||
|
# have been uploaded the status changes to SHOW_SUBMITTED.
|
||
|
#
|
||
|
# 2022-04-07 New values added:
|
||
|
#
|
||
|
# 5. METADATA_PROCESSED signals that the processing of notes and related
|
||
|
# things is complete
|
||
|
# 6. MEDIA_TRANSCODED indicates that Ken has done the transcoding and posted
|
||
|
# the show.
|
||
|
# 7. UPLOADED_TO_IA indicates that the IA upload has been done (by me usually)
|
||
|
# 8. UPLOADED_TO_RSYNC_NET final step shows that the files (audio & assets)
|
||
|
# have been archived/backed up
|
||
|
#
|
||
|
# 2023-07-02 New value added for reserve shows
|
||
|
#
|
||
|
# 9. RESERVE_SHOW_SUBMITTED indication that a reserve show has been uploaded
|
||
|
# and stashed away ready for adding to a slot at a later time.
|
||
|
#
|
||
|
# I don't think there's a way of knowing what has happened between
|
||
|
# EMAIL_LINK_CLICKED and SHOW_SUBMITTED.
|
||
|
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
#
|
||
|
my %status = (
|
||
|
REQUEST_UNVERIFIED => 'unverified', # shouldn't be returned
|
||
|
REQUEST_EMAIL_SENT => 'email sent', # been sent the email with a link
|
||
|
EMAIL_LINK_CLICKED => 'pending', # filling in the form/sending the show
|
||
|
RESERVE_SHOW_SUBMITTED => 'reserved show', # reserve show received
|
||
|
SHOW_SUBMITTED => 'uploaded', # all done
|
||
|
METADATA_PROCESSED => 'metadata processed', # notes processed, etc
|
||
|
SHOW_POSTED => 'in the database', # awaiting audio transcoding
|
||
|
MEDIA_TRANSCODED => 'transcoded', # audio transcoded
|
||
|
UPLOADED_TO_IA => 'uploaded to IA', # uploaded to IA
|
||
|
UPLOADED_TO_RSYNC_NET => 'archived', # archived on rsync.net
|
||
|
);
|
||
|
|
||
|
#
|
||
|
# Enable Unicode mode
|
||
|
#
|
||
|
binmode STDOUT, ":encoding(UTF-8)";
|
||
|
binmode STDERR, ":encoding(UTF-8)";
|
||
|
|
||
|
#-------------------------------------------------------------------------------
|
||
|
# Options and arguments
|
||
|
#-------------------------------------------------------------------------------
|
||
|
|
||
|
#
|
||
|
# Process options
|
||
|
#
|
||
|
my %options;
|
||
|
Options( \%options );
|
||
|
|
||
|
#
|
||
|
# Default help
|
||
|
#
|
||
|
Usage() if ( $options{'help'} );
|
||
|
|
||
|
#
|
||
|
# Collect options
|
||
|
#
|
||
|
my $cfgfile
|
||
|
= ( defined( $options{config} ) ? $options{config} : $configfile );
|
||
|
|
||
|
#
|
||
|
# Sanity checks
|
||
|
#
|
||
|
die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
|
||
|
|
||
|
#-------------------------------------------------------------------------------
|
||
|
# Configuration file - load data
|
||
|
#-------------------------------------------------------------------------------
|
||
|
my $conf = Config::General->new(
|
||
|
-ConfigFile => $cfgfile,
|
||
|
-InterPolateVars => 1,
|
||
|
-ExtendedAccess => 1,
|
||
|
);
|
||
|
my %config = $conf->getall();
|
||
|
|
||
|
#-------------------------------------------------------------------------------
|
||
|
# Connect to the database
|
||
|
#-------------------------------------------------------------------------------
|
||
|
my $dbhost = $config{database}->{host} // '127.0.0.1';
|
||
|
my $dbport = $config{database}->{port} // 3306;
|
||
|
my $dbname = $config{database}->{name};
|
||
|
my $dbuser = $config{database}->{user};
|
||
|
my $dbpwd = $config{database}->{password};
|
||
|
$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
|
||
|
$dbuser, $dbpwd, { AutoCommit => 1 } )
|
||
|
or croak $DBI::errstr;
|
||
|
|
||
|
#
|
||
|
# Enable client-side UTF8
|
||
|
#
|
||
|
$dbh->{mysql_enable_utf8} = 1;
|
||
|
|
||
|
#
|
||
|
# Set the local timezone to UTC for this connection
|
||
|
#
|
||
|
$dbh->do("set time_zone = '+00:00'") or carp $dbh->errstr;
|
||
|
|
||
|
#
|
||
|
# Query the reservations table for shows which are more or less kosher.
|
||
|
# 2023-07-01 the episode number 9999 is currently a marker that the show is
|
||
|
# for the reserve queue, so we omit it
|
||
|
#
|
||
|
$sth1 = $dbh->prepare(
|
||
|
q{SELECT * FROM reservations WHERE ep_num > 0 ORDER BY timestamp});
|
||
|
$sth1->execute();
|
||
|
if ( $dbh->err ) {
|
||
|
carp $dbh->errstr;
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Collect details of all the verified reservations found, with an
|
||
|
# interpretation of their state and the email of the sender. For each show
|
||
|
# look at its local state and report it.
|
||
|
#
|
||
|
while ( $h1 = $sth1->fetchrow_hashref() ) {
|
||
|
$show = $h1->{ep_num};
|
||
|
|
||
|
if ($show == $reserved) {
|
||
|
push(@res,$h1);
|
||
|
next;
|
||
|
}
|
||
|
|
||
|
$count++;
|
||
|
|
||
|
my @atts;
|
||
|
push( @atts, "+dir" ) if ( -e "$cache/hpr${show}" );
|
||
|
push( @atts, "+shownotes" ) if ( -s "$cache/hpr${show}/shownotes.txt" );
|
||
|
push( @atts, "+processed" ) if ( -e "$cache/hpr${show}/hpr${show}.html" );
|
||
|
push( @atts, "+uploaded" ) if ( -e "$cache/hpr${show}/.uploaded" );
|
||
|
|
||
|
printf "[%02d] %04d: %-18s (%s) %s\n", $count, $show,
|
||
|
(
|
||
|
exists( $status{ $h1->{status} } )
|
||
|
? $status{ $h1->{status} }
|
||
|
: 'unknown'
|
||
|
),
|
||
|
$h1->{email},
|
||
|
join( "; ", @atts );
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# If for some reason there aren't any reservations tell the caller
|
||
|
#
|
||
|
say "No show reservations" if ( $count == 0 );
|
||
|
|
||
|
if (@res) {
|
||
|
say " ";
|
||
|
say "Reserve queue entries";
|
||
|
$count = 0;
|
||
|
|
||
|
for my $r (@res) {
|
||
|
$count++;
|
||
|
|
||
|
printf "[%02d] %-24s %s (%s)\n", $count,
|
||
|
(
|
||
|
exists( $status{ $r->{status} } )
|
||
|
? $status{ $r->{status} }
|
||
|
: 'unknown'
|
||
|
),
|
||
|
$r->{timestamp},
|
||
|
$r->{email};
|
||
|
|
||
|
}
|
||
|
}
|
||
|
|
||
|
exit;
|
||
|
|
||
|
#=== FUNCTION ================================================================
|
||
|
# NAME: Usage
|
||
|
# PURPOSE: Display 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;
|
||
|
$PROG v$VERSION
|
||
|
|
||
|
Usage: $PROG [options]
|
||
|
|
||
|
Scans the HPR database table 'reservations' and reports what new shows are
|
||
|
indicated there and what state they are in.
|
||
|
|
||
|
Options:
|
||
|
|
||
|
-help Display this information
|
||
|
-config=FILE This option allows an alternative configuration file
|
||
|
to be used. This file defines the location of the
|
||
|
database, its port, its name and the username and
|
||
|
password to be used to access it. This feature was
|
||
|
added to allow the script to access alternative
|
||
|
databases or the live database over an SSH tunnel.
|
||
|
|
||
|
If the option is omitted the default file is used:
|
||
|
.hpr_db.cfg
|
||
|
|
||
|
EOD
|
||
|
exit(1);
|
||
|
}
|
||
|
|
||
|
#=== FUNCTION ================================================================
|
||
|
# NAME: Options
|
||
|
# PURPOSE: Processes command-line options
|
||
|
# PARAMETERS: $optref Hash reference to hold the options
|
||
|
# RETURNS: Undef
|
||
|
# DESCRIPTION:
|
||
|
# THROWS: no exceptions
|
||
|
# COMMENTS: none
|
||
|
# SEE ALSO: n/a
|
||
|
#===============================================================================
|
||
|
sub Options {
|
||
|
my ($optref) = @_;
|
||
|
|
||
|
my @options = ( "help", "config=s", );
|
||
|
|
||
|
Usage() if ( !GetOptions( $optref, @options ) );
|
||
|
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=100:fo=tcrqn21:fdm=marker
|
||
|
|