forked from HPR/hpr-tools
		
	
		
			
				
	
	
		
			307 lines
		
	
	
		
			9.4 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			307 lines
		
	
	
		
			9.4 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/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
 | 
						|
 |