470 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			470 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/env perl
 | |
| #===============================================================================
 | |
| #
 | |
| #         FILE: create_series
 | |
| #
 | |
| #        USAGE: ./create_series -name=NAME -description=DESC [-[no]private]
 | |
| #               [-image=IMAGE] [-[no]valid] [-[no]updatedb] [-config=FILE] [-help]
 | |
| #
 | |
| #  DESCRIPTION: Create a new series in the HPR database
 | |
| #
 | |
| #      OPTIONS: ---
 | |
| # REQUIREMENTS: ---
 | |
| #         BUGS: ---
 | |
| #        NOTES: ---
 | |
| #       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
 | |
| #      VERSION: 0.0.4
 | |
| #      CREATED: 2015-01-15 16:09:09
 | |
| #     REVISION: 2022-04-12 21:37:02
 | |
| #
 | |
| #===============================================================================
 | |
| 
 | |
| use 5.010;
 | |
| use strict;
 | |
| use warnings;
 | |
| use utf8;
 | |
| 
 | |
| use Getopt::Long;
 | |
| use Pod::Usage;
 | |
| 
 | |
| use Config::General;
 | |
| 
 | |
| use Try::Tiny;
 | |
| use IO::Prompter;
 | |
| 
 | |
| use DBI;
 | |
| 
 | |
| use Data::Dumper;
 | |
| 
 | |
| #
 | |
| # Version number (manually incremented)
 | |
| #
 | |
| our $VERSION = '0.0.4';
 | |
| 
 | |
| #
 | |
| # 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/Database";
 | |
| my $configfile = "$basedir/.hpr_db.cfg";
 | |
| 
 | |
| my ( $dbh, $sth1, $h1, $rv, $rc );
 | |
| my ( $answer, $id );
 | |
| 
 | |
| #
 | |
| # Enable Unicode mode
 | |
| #
 | |
| binmode STDOUT, ":encoding(UTF-8)";
 | |
| binmode STDERR, ":encoding(UTF-8)";
 | |
| 
 | |
| #-------------------------------------------------------------------------------
 | |
| # Options and arguments
 | |
| #-------------------------------------------------------------------------------
 | |
| #
 | |
| # Process options
 | |
| #
 | |
| my %options;
 | |
| Options( \%options );
 | |
| 
 | |
| #
 | |
| # Default help
 | |
| #
 | |
| pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
 | |
|     if ( $options{'help'} );
 | |
| 
 | |
| #
 | |
| # Collect options
 | |
| #
 | |
| my $cfgfile
 | |
|     = ( defined( $options{config} ) ? $options{config} : $configfile );
 | |
| 
 | |
| my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
 | |
| 
 | |
| my $name        = $options{'name'};
 | |
| my $description = $options{'description'};
 | |
| my $private = ( defined( $options{'private'} ) ? $options{'private'} : 0 );
 | |
| my $image   = ( defined( $options{'image'} ) ? $options{'image'} : '' );
 | |
| my $valid   = ( defined( $options{'valid'} ) ? $options{'valid'} : 1 );
 | |
| 
 | |
| die "Options -name and -description are mandatory\n"
 | |
|     unless ( $name && $description );
 | |
| 
 | |
| #
 | |
| # Sanity check
 | |
| #
 | |
| die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
 | |
| 
 | |
| #
 | |
| # Check we have the right values
 | |
| #
 | |
| printf "Planning to add the following series:\n" .
 | |
|     "Name:        %s\n" .
 | |
|     "Description: %s\n" .
 | |
|     "Private:     %s\n" .
 | |
|     "Image:       '%s'\n" .
 | |
|     "Valid:       %s\n",
 | |
|     $name,
 | |
|     $description,
 | |
|     ( $private ? 'Yes' : 'No' ),
 | |
|     $image,
 | |
|     ( $valid ? 'Yes' : 'No');
 | |
| 
 | |
| print "Note that -updatedb has not been set, so no changes will be made.\n"
 | |
|     unless ($updatedb);
 | |
| 
 | |
| #
 | |
| # Ask for confirmation, failing gracefully if there's a problem
 | |
| #
 | |
| try {
 | |
|     $answer = prompt(
 | |
|         -in     => *STDIN,
 | |
|         -out    => *STDERR,
 | |
|         -prompt => 'Is this correct? ',
 | |
|         -style  => 'red',
 | |
|         -yn
 | |
|     );
 | |
| }
 | |
| catch {
 | |
|     warn "Problem collecting answer $_";
 | |
|     $answer = 0;
 | |
| };
 | |
| 
 | |
| unless ($answer) {
 | |
|     print "Exiting...\n";
 | |
|     exit;
 | |
| }
 | |
| 
 | |
| #-------------------------------------------------------------------------------
 | |
| # 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};
 | |
| 
 | |
| # 2022-04-12 The MariaDB driver was there and then it wasn't!
 | |
| #
 | |
| #$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
 | |
| #    $dbuser, $dbpwd, { AutoCommit => 1 } )
 | |
| #    or die $DBI::errstr;
 | |
| 
 | |
| $dbh = DBI->connect( "dbi:mysql:database=$dbname;host=$dbhost;port=$dbport",
 | |
|     $dbuser, $dbpwd, { AutoCommit => 1 } )
 | |
|     or die $DBI::errstr;
 | |
| 
 | |
| #
 | |
| # Enable client-side UTF8
 | |
| #
 | |
| $dbh->{mysql_enable_utf8} = 1;
 | |
| 
 | |
| #
 | |
| # Does a series with this name already exist?
 | |
| #
 | |
| $sth1 = $dbh->prepare(q{
 | |
|     SELECT id AS count FROM miniseries WHERE name = ?
 | |
| });
 | |
| $sth1->execute($name);
 | |
| if ( $dbh->err ) {
 | |
|     warn $dbh->errstr;
 | |
| }
 | |
| if ( $h1 = $sth1->fetchrow_hashref ) {
 | |
|     print "A series with the name '$name' already exists\n";
 | |
|     exit;
 | |
| }
 | |
| 
 | |
| #
 | |
| # Should be OK to create the series if we get here, so long as we've been
 | |
| # asked to do so.
 | |
| #
 | |
| if ($updatedb) {
 | |
|     #
 | |
|     # Go into transaction mode here so we can fail safely
 | |
|     #
 | |
|     $rc = $dbh->begin_work or die $dbh->errstr;
 | |
| 
 | |
|     #
 | |
|     # Perform the INSERT
 | |
|     #
 | |
|     $rv = $dbh->do(q{
 | |
|         INSERT INTO miniseries (name,description,private,image,valid)
 | |
|         VALUES(?,?,?,?,?)
 | |
|     },
 | |
|         undef,
 | |
|         $name,
 | |
|         $description,
 | |
|         $private,
 | |
|         $image,
 | |
|         $valid
 | |
|     );
 | |
| 
 | |
|     #
 | |
|     # Respond to any error by rolling back
 | |
|     #
 | |
|     if ( $dbh->err ) {
 | |
|         warn $dbh->errstr;
 | |
|         eval{ $dbh->rollback };
 | |
|         $rv = 0;
 | |
|     }
 | |
|     else {
 | |
|         $dbh->commit;
 | |
|     }
 | |
|     $rv = 0 if ( $rv eq '0E0' );
 | |
| 
 | |
|     #
 | |
|     # Report any success
 | |
|     #
 | |
|     if ($rv) {
 | |
|         #
 | |
|         # Find out what id we just generated and report it if found
 | |
|         #
 | |
|         $id = $dbh->last_insert_id();
 | |
|         if ($id) {
 | |
|             print "Series added with id $id\n";
 | |
|         } else {
 | |
|             print "Series added\n";
 | |
|         }
 | |
|     }
 | |
|     else {
 | |
|         print "Series not added due to error\n";
 | |
|     }
 | |
| 
 | |
| } else {
 | |
|     print "Option -noupdatedb chosen, database not updated\n";
 | |
| }
 | |
| 
 | |
| #
 | |
| # We've finished with the database
 | |
| #
 | |
| $dbh->disconnect;
 | |
| 
 | |
| exit;
 | |
| 
 | |
| #===  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", "updatedb!", "name=s",
 | |
|         "description=s", "private!", "image:s",   "valid!"
 | |
|     );
 | |
| 
 | |
|     if ( !GetOptions( $optref, @options ) ) {
 | |
|         pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
 | |
|     }
 | |
| 
 | |
|     return;
 | |
| }
 | |
| 
 | |
| __END__
 | |
| 
 | |
| #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 | |
| #  Application Documentation
 | |
| #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 | |
| #{{{
 | |
| 
 | |
| =head1 NAME
 | |
| 
 | |
| create_series - create a new series in the 'miniseries' table in the HPR DB
 | |
| 
 | |
| =head1 VERSION
 | |
| 
 | |
| This documentation refers to create_series version 0.0.4
 | |
| 
 | |
| 
 | |
| =head1 USAGE
 | |
| 
 | |
|     create_series -name=NAME -description=DESC [-[no]private]
 | |
|         [-image=IMAGE] [-[no]valid] [-[no]updatedb] [-config=FILE] [-help]
 | |
| 
 | |
|     desc="An overview of this open-source graphics program, "
 | |
|     desc+="with a focus on photographic issues."
 | |
|     create_series -update -name='GIMP' -description="$desc"
 | |
| 
 | |
| =head1 OPTIONS
 | |
| 
 | |
| =over 4
 | |
| 
 | |
| =item B<-[no]updatedb>
 | |
| 
 | |
| This option is required to make the script apply any changes that are made to
 | |
| the database. By default no updates are applied (B<-noupdatedb>).
 | |
| 
 | |
| =item B<-name=NAME>
 | |
| 
 | |
| This mandatory option defines the title for the new series. The limit on the
 | |
| length of the name is 100 characters and the script will reject anything
 | |
| longer than this.
 | |
| 
 | |
| =item B<-description=DESC>
 | |
| 
 | |
| This mandatory option defines the description for the new series. There is no limit on the
 | |
| length of this field, but it may be difficult to enter very large amounts of
 | |
| text here. One solution might be to prepare the text in a file and use
 | |
| a command substitution to enter it.
 | |
| 
 | |
|     create_series -update -name='GIMP' -description="$(cat GIMP.txt)"
 | |
| 
 | |
| =item B<-[no]private>
 | |
| 
 | |
| Series can be private or public. Selecting B<-private> creates a new private
 | |
| series, whereas B<-noprivate> creates a public series. The default is to
 | |
| create a public one.
 | |
| 
 | |
| =item B<-image=IMAGE>
 | |
| 
 | |
| The image field in the database is not currently used. Three series have
 | |
| a short text string in this field, but no data in the field seems to be used
 | |
| anywhere. It would be possible to add data to this field in the database when
 | |
| creating a series, and this option is available to do so, but by default
 | |
| an empty string is inserted. Note that the database design does not allow this
 | |
| field to be NULL for unknown reasons.
 | |
| 
 | |
| =item B<-[no]valid>
 | |
| 
 | |
| Series can be valid or invalid. Selecting B<-valid> creates a new valid
 | |
| series, whereas B<-novalid> creates an invalid series. The default is to
 | |
| create a valid one.
 | |
| 
 | |
| Series marked invalid are not displayed, but there are none in this state at
 | |
| the moment.
 | |
| 
 | |
| =item B<-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.
 | |
| 
 | |
| See the CONFIGURATION AND ENVIRONMENT section below for the file format.
 | |
| 
 | |
| If the option is omitted the default file is used: B<.hpr_db.cfg>
 | |
| 
 | |
| =back
 | |
| 
 | |
| =head1 DESCRIPTION
 | |
| 
 | |
| The script collects the necessary attributes for a new series in the HPR
 | |
| database, displays them for validation and if requested, adds them to the
 | |
| database.
 | |
| 
 | |
| Every series must have a name and a description. The settings for I<private>,
 | |
| I<image> and I<valid> have defaults as described above. The values and
 | |
| defaults are shown as follows and the user is prompted to decide whether to
 | |
| proceed with series creation or not:
 | |
| 
 | |
|     Planning to add the following series:
 | |
|     Name:        GIMP
 | |
|     Description: An overview of this open-source graphics program, with a focus on photographic issues.
 | |
|     Private:     No
 | |
|     Image:       ''
 | |
|     Valid:       Yes
 | |
|     Is this correct?
 | |
| 
 | |
| Answering 'Y' to this prompt will result in creation (assuming this is
 | |
| possible).
 | |
| 
 | |
| Upon creation the script reports the B<id> value assigned to the series. This
 | |
| is useful to know when adding episodes to the series.
 | |
| 
 | |
| =head1 DIAGNOSTICS
 | |
| 
 | |
| =over 4
 | |
| 
 | |
| =item B<Options -name and -description are mandatory>
 | |
| 
 | |
| Both of these options must be present when creating a new series. This is
 | |
| a fatal error.
 | |
| 
 | |
| =item B<DBI connect ... failed: Access denied for user ... >
 | |
| 
 | |
| The database connection has been denied. Check the configuration details (see
 | |
| below). This a fatal error.
 | |
| 
 | |
| =back
 | |
| 
 | |
| =head1 CONFIGURATION AND ENVIRONMENT
 | |
| 
 | |
| The script obtains the credentials it requires to open the HPR database from
 | |
| a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
 | |
| directory holding the script. This configuration file can be overridden using
 | |
| the B<-config=FILE> option as described above.
 | |
| 
 | |
| The configuration file format is as follows:
 | |
| 
 | |
|  <database>
 | |
|      host = 127.0.0.1
 | |
|      port = PORT
 | |
|      name = DATABASE
 | |
|      user = USERNAME
 | |
|      password = PASSWORD
 | |
|  </database>
 | |
| 
 | |
| =head1 DEPENDENCIES
 | |
| 
 | |
|  Config::General
 | |
|  DBI
 | |
|  Data::Dumper
 | |
|  Getopt::Long
 | |
|  IO::Prompter
 | |
|  Pod::Usage
 | |
|  Try::Tiny
 | |
| 
 | |
| =head1 BUGS AND LIMITATIONS
 | |
| 
 | |
| There are no known bugs in this module.
 | |
| Please report problems to Dave Morriss  (Dave.Morriss@gmail.com)
 | |
| Patches are welcome.
 | |
| 
 | |
| =head1 AUTHOR
 | |
| 
 | |
| Dave Morriss (Dave.Morriss@gmail.com)
 | |
| 
 | |
| =head1 LICENCE AND COPYRIGHT
 | |
| 
 | |
| Copyright (c) 2015-2020 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
 | |
| 
 | |
| This module is free software; you can redistribute it and/or
 | |
| modify it under the same terms as Perl itself. See perldoc perlartistic.
 | |
| 
 | |
| This program is distributed in the hope that it will be useful,
 | |
| but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | |
| 
 | |
| =cut
 | |
| 
 | |
| #}}}
 | |
| 
 | |
| # [zo to open fold, zc to close]
 | |
| 
 | |
| # vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
 | |
| 
 |