forked from HPR/hpr-tools
		
	
		
			
	
	
		
			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 | ||
|  | 
 |