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