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
 | |
| 
 |