forked from HPR/hpr-tools
		
	
		
			
	
	
		
			470 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
		
		
			
		
	
	
			470 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| 
								 | 
							
								#!/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
							 | 
						||
| 
								 | 
							
								
							 |