#!/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, I and I 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 value assigned to the series. This is useful to know when adding episodes to the series. =head1 DIAGNOSTICS =over 4 =item B Both of these options must be present when creating a new series. This is a fatal error. =item B 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: host = 127.0.0.1 port = PORT name = DATABASE user = USERNAME password = PASSWORD =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