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