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