hpr-tools/Database/edit_series

#!/usr/bin/env perl
#===============================================================================
#
#         FILE: edit_series
#
#        USAGE: ./edit_series [-help] [-debug=N] [-[no]update] [-config=FILE]
#               [-series_id=id] [-[no]regex] [-[no]description] [-[no]private]
#               [-[no]valid] series_name
#
#  DESCRIPTION: A simple editor for the HPR miniseries table
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: Based on edit_host
#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
#      VERSION: 0.0.3
#      CREATED: 2020-06-21 17:58:19
#     REVISION: 2021-06-23 22:11:13
#
#===============================================================================

use 5.010;
use strict;
use warnings;
use utf8;

use Getopt::Long;
use Pod::Usage;

use Config::General;
use File::Temp;
use File::Slurper qw{ read_text };
use SQL::Abstract;
use DBI;

use Data::Dumper;

#
# Version number (manually incremented)
#
our $VERSION = '0.0.3';

#
# 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";

#
# Declarations
#
my ( $dbh, $sth1, $h1, $rc );
my ( $series_name, %changes );

#
# Enable Unicode mode
#
binmode STDOUT, ":encoding(UTF-8)";
binmode STDERR, ":encoding(UTF-8)";

#
# Options and arguments
#
my %options;
Options( \%options );

#
# Default help
#
pod2usage( -msg => "Version $VERSION\n", -exitval => 1 )
    if ( $options{'help'} );

#
# Collect options
#
my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );

my $cfgfile
    = ( defined( $options{config} ) ? $options{config} : $configfile );

my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
my $regexp   = ( defined( $options{'regexp'} )   ? $options{'regexp'}   : 0 );

my $description = $options{'description'};
my $private     = $options{'private'};
my $valid       = $options{'valid'};

#
# There must be at least one field to change. We check for the definition here
# because the values returned may be zero or one or the variable may be
# undefined.
#
die "Select one of -[no]description, -[no]private and -[no]valid\n"
    unless ( defined($description) || defined($private) || defined($valid) );

#
# Was a series id provided (through an option)?
#
my $series_id = $options{'series_id'};

#
# Deal with the two routes: one via the unique series id, and the other vai the
# less unique series name
#
unless ($series_id) {
    #
    # Get the arg
    #
    $series_name = shift;
    pod2usage( -msg => "Specify the series name\n", -exitval => 1 )
        unless $series_name;
}

#
# Sanity check
#
die "Unable to find $cfgfile\n" unless ( -e $cfgfile );

#
# Load configuration data
#
my $conf = new Config::General(
    -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 one minute 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;

#
# Prepare to read the database either for the series_id or the exact or
# approximate name
#
if ($series_id) {
    #
    # Simple series_id query
    #
    $sth1 = $dbh->prepare(q{SELECT * FROM miniseries WHERE id = ?});
    $sth1->execute($series_id);
    if ( $dbh->err ) {
        warn $dbh->errstr;
    }
}
else {
    #
    # Series name query
    #
    if ($regexp) {
        #
        # Regexp match requested. Count how many matches there are
        #
        $sth1 = $dbh->prepare(
            q{SELECT count(*) AS count FROM miniseries WHERE name REGEXP ?});
        $sth1->execute($series_name);
        if ( $dbh->err ) {
            warn $dbh->errstr;
        }
        if ( $h1 = $sth1->fetchrow_hashref ) {
            my $matches = $h1->{count};
            if ($matches > 1) {
                die "Too many matches to regex '$series_name' ($matches)\n";
            } elsif ($matches == 0) {
                die "No matches to regex '$series_name'\n";
            }
        }
        else {
            die "Unable to find series matching regex '$series_name'\n";
        }

        $sth1 = $dbh->prepare(q{SELECT * FROM miniseries WHERE name REGEXP ?});
    }
    else {
        $sth1 = $dbh->prepare(q{SELECT * FROM miniseries WHERE name = ?});
    }

    #
    # Execute the query
    #
    $sth1->execute($series_name);
    if ( $dbh->err ) {
        warn $dbh->errstr;
    }
}

#
# Did we find it?
#
if ( $h1 = $sth1->fetchrow_hashref ) {
    #
    # Found. Save the series_id to simplify the update if we don't already have
    # it
    #
    $series_id //= $h1->{id};

    #
    # Report on the series details
    #
    printf "Series details\n" .
        "Id:          %s\n" .
        "Name:        %s\n" .
        "Description: %s\n" .
        "Private:     %s\n" .
        "Image:       '%s'\n" .
        "Valid:       %s\n",
        $h1->{id},
        $h1->{name},
        (   length( $h1->{description} ) > 80
            ? substr( $h1->{description}, 0, 80 ) . '...'
            : $h1->{description} ),
        $h1->{private},
        $h1->{image},
        $h1->{valid};

    #
    # So what needs changing?
    #
    #<<< [perltidy messes up the following]
    if ($description) {
        $changes{description} = check_field( 'description',
            scalar( run_editor( $h1->{description}, ['+set paste'] ) ), 1500, qr{(\n)} );
    }
    if (defined($private)) {
        $changes{private} = $private if ($h1->{private} ne $private);
    }
    if (defined($valid)) {
        $changes{valid} = $valid if ($h1->{valid} ne $valid);
    }
    #>>>
    print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );

    #
    # Are we updating the database then?
    #
    if ($updatedb) {
        #
        # Was anything edited?
        #
        if (%changes) {
            #
            # Did the edits do anything? If not delete the element from the
            # hash since there's no point writing it to the database
            #
            for my $key ( keys(%changes) ) {
                if ( $changes{$key} eq $h1->{$key} ) {
                    print "No change made to $key, ignored\n";
                    delete( $changes{$key} );
                }
            }
            print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
        }

        #
        # If there's anything left apply the changes
        #
        if (%changes) {
            #
            # Go into transaction mode here so we can fail safely
            #
            $rc = $dbh->begin_work or die $dbh->errstr;

            my $sql   = SQL::Abstract->new;
            my %where = ( id => $series_id );
            my ( $stmt, @bind )
                = $sql->update( 'miniseries', \%changes, \%where );
            #print "$stmt\n";
            #print join( ",", map {"'$_'"} @bind ), "\n";

            my $sth = $dbh->prepare($stmt);
            my $rv  = $sth->execute(@bind);

            #
            # 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' );

            #
            # Update the log file
            #
            if ($rv) {
                print "Updated database\n";
                print "Changed fields: ",
                    join( ", ", sort( keys(%changes) ) ), "\n";
            }
            else {
                print "Series not updated due to error\n";
            }

        }
        else {
            print "There was nothing to do\n";
        }
    }
    else {
        print "Database not updated\n";
    }
}
else {
    if ($series_id) {
        print "Unable to find series number $series_id\n";
    }
    else {
        print "Unable to find series name $series_name\n";
    }
}

exit;

#===  FUNCTION  ================================================================
#         NAME: run_editor
#      PURPOSE: Run an interactive vim editor on a string
#   PARAMETERS: $string         String to edit
#               $options        An arrayref containing options for vim
#                               (optional). Example '+set paste'. Each option
#                               (such as '-c startinsert') needs to be
#                               a separate array element.
#      RETURNS: Edited string
#  DESCRIPTION: Makes a temporary file with File::Temp ensuring that the file
#               is in utf8 mode. Writes the edit string to the file and invokes
#               the 'vim' editor on it. The resulting file is then read back
#               into a string and returned to the caller, again taking care to
#               retain utf8 mode.
#       THROWS: No exceptions
#     COMMENTS: File::Slurp and UTF-8 don't go well together. Moved to
#               File::Slurper instead
#     SEE ALSO: N/A
#===============================================================================
sub run_editor {
    my ( $string, $options ) = @_;

    #
    # Build an arguments array for 'system'
    #
    my @args;
    push( @args, @$options ) if $options;

    #
    # Make a temporary file
    #
    my $tfh = File::Temp->new;
    binmode $tfh, ":encoding(UTF-8)";
    my $tfn = $tfh->filename;
    print $tfh $string if $string;
    $tfh->close;

    #
    # Add the filename to the arguments
    #
    push( @args, $tfn );

    die "Edit failed\n"
        unless ( system( ( 'vim', @args ) ) == 0 );

    return read_text($tfn);
}

#===  FUNCTION  ================================================================
#         NAME: check_field
#      PURPOSE: Checks the a field is not too long and doesn't contain certain
#               characters
#   PARAMETERS: $name           name of field
#               $field          string to be checked
#               $maxlen         maximum string length
#               $regex          regex containing illegal characters to be removed
#      RETURNS: The input string truncated and with any illegal characters
#               removed.
#  DESCRIPTION: Runs a substitution on the string then truncates the result if
#               it is too long.
#       THROWS: No exceptions
#     COMMENTS: None
#     SEE ALSO: N/A
#===============================================================================
sub check_field {
    my ( $name, $field, $maxlen, $regex ) = @_;

    return unless $field;

    $field =~ s/$regex//g;
    if ( length($field) > $maxlen ) {
        warn "Field '$name' too long ("
            . length($field)
            . "); truncated to "
            . $maxlen . "\n";
        $field = substr( $field, 0, $maxlen );
    }
    return $field;
}

#===  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",        "debug=i", "updatedb!",    "config=s",
        "series_id=i", "regexp",  "description!", "private!",
        "valid!",
    );

    if ( !GetOptions( $optref, @options ) ) {
        pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
    }

    return;
}

__END__


#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#  Application Documentation
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#{{{

=head1 NAME

edit_series - edit one or more fields in the database for a given series

=head1 VERSION

This documentation refers to edit_series version 0.0.3


=head1 USAGE

    edit_series [-h] [-debug=N] [-[no]updatedb] [-series_id=ID] [-regexp]
    [-[no]description] [-[no]private] [-[no]valid] [-config=FILE] series_name

    edit_series -updatedb -description GIMP
    edit_series -updatedb -description -regexp Awk
    edit_series -updatedb -noprivate -valid -series_id=102


=head1 REQUIRED ARGUMENTS

=over 4

=item B<series_name>

Unless the B<-series_id=ID> option is given (see the OPTIONS section) it is
necessary to provide a series name.

Unless the B<-regexp> option is provided (see the OPTIONS section) the
series name must match exactly, otherwise it is regarded as a MySQL regular
expression.

=back

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

This option causes the B<series_name> argument to be interpreted as a regular
expression for the MySQL database. By default the argument is treated as if it
is an exact match.

=item B<-series_id=ID>

The series can be specified by the series ID through this route. If this used then
the B<series_name> argument is not required (and is ignored if given).

=item B<-[no]description>

This option, if given (as B<-description>), indicates that the 'description'
field is to be edited.  The Vim editor is invoked to make changes. The default
is B<-nodescription> meaning that this field is not to be edited.

=item B<-[no]private>

This option, if given (as B<-private>), indicates that the 'private' field is
to be set to 'true'. If given as B<-noprivate> this field is set to 'false'.
If omitted altogether then the field is not changed.

=item B<-[no]valid>

This option, if given (as B<-valid>), indicates that the 'valid' field is to
be set to 'true'. If given as B<-novalid> this field is set to 'false'.
If omitted altogether then the field is not changed.

=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 B<edit_series> provides an editor interface to certain fields in
the B<miniseries> table of the HPR database. The fields are:

=over 4

=item B<description>

This field is stored in a 'TEXT' field in the database. It is possible for
the field to contain HTML, and some series do. In general it is better to keep
this field short since it is displayed in its entirety before the notes for
each show in the series.

=back

=head1 DIAGNOSTICS

=over 4

=item B<Select one of -description, -private and -valid>

At least one of these options is required. This a fatal error.

=item B<Specify the series name>

If no series name has been provided, and the B<-series_id=ID> option has not been
used the script is unable to determine the series to edit. This is a fatal
error.

=item B<Unable to find ...>

The configuration file containing details of the database cannot be found.
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.

=item B<Too many matches to regex ...>

In B<-regex> mode a series name has been provided that matches too many series in
the database. Try again with a less ambiguous name. This a fatal error.

=item B<Unable to find series matching regex ...>

In B<-regex> mode a series name has been provided that matches no qseries in the
database. Try again. This a fatal error.

=item B<Edit failed>

If the Vim edit session fails in some way the script reports it this way. This
a fatal error.

=item B<Field '...' is too long (...); truncated to ...>

The string provided for the field is greater than the limit and has been
truncated. This is a warning.

=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. To change this will require changing the script.

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
 File::Slurper
 File::Temp
 Getopt::Long
 Pod::Usage
 SQL::Abstract

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