#!/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