hpr-tools/Database/edit_episode

#!/usr/bin/env perl
#===============================================================================
#
#         FILE: edit_episode
#
#        USAGE: ./edit_episode [-h] [-debug=N] [-config=FILE] [-[no]update]
#                       [-[no]title] [-[no]summary] [-[no]tags] [-[no]notes]
#                       [-[no]ctitle] [-[no]ctext] [-cnumber=N] shownumber
#
#  DESCRIPTION: A simple command-line editor for the HPR database
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: Had to revert to MySQL due to a problem with DBD::MariaDB
#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
#      VERSION: 0.1.4
#      CREATED: 2015-06-17 23:17:50
#     REVISION: 2024-07-20 11:21:19
#
#===============================================================================

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.1.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";

#
# Declarations
#
my ( $dbh, $sth1, $h1, $rc );
my (%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 $title   = ( defined( $options{'title'} )   ? $options{'title'}   : 0 );
my $summary = ( defined( $options{'summary'} ) ? $options{'summary'} : 0 );
my $tags    = ( defined( $options{'tags'} )    ? $options{'tags'}    : 0 );
my $notes   = ( defined( $options{'notes'} )   ? $options{'notes'}   : 0 );
my $ctitle  = ( defined( $options{'ctitle'} )  ? $options{'ctitle'}  : 0 );
my $ctext   = ( defined( $options{'ctext'} )   ? $options{'ctext'}   : 0 );
my $cnumber = $options{'cnumber'};

die "Select one of -title, -summary, -tags, -notes, -ctitle and -ctext\n"
    unless ( $title || $summary || $tags || $notes || $ctitle || $ctext );

die "Needs a comment number (-cnumber=N)\n"
    if ( ( $ctitle || $ctext ) && ( !$cnumber ) );

#
# Get the arg
#
my $show = shift;
pod2usage( -msg => "Specify the show number\n", -exitval => 1 ) unless $show;

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

#$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 for the selected episode and count the number
# of comments it has in case we need to know later.
#
$sth1 = $dbh->prepare(q{
    SELECT
        e.*, count(c.id) as comment_count
    FROM eps e
    LEFT JOIN comments c ON e.id = c.eps_id
    GROUP BY e.id
    HAVING e.id = ?
});
$sth1->execute($show);
if ( $dbh->err ) {
    warn $dbh->errstr;
}

#
# Did we find the episode?
#
if ( $h1 = $sth1->fetchrow_hashref ) {
    #
    # Found, so do the episode details need changing?
    #
    if ( $title || $summary || $tags || $notes ) {
        change_episode( $dbh, $h1, $show, $updatedb, $title, $summary, $tags,
            $notes );
    }

    #
    # Are we to change comment details?
    #
    if ( $ctitle || $ctext ) {
        if ( $h1->{comment_count} > 0 ) {
            change_comment( $dbh, $h1, $show, $cnumber, $updatedb, $ctitle,
                $ctext );
        }
        else {
            print "This show has no comments\n";
        }
    }
}
else {
    print "Unable to find show number $show\n";
}

#$dbh->disconnect;

exit;

#===  FUNCTION  ================================================================
#         NAME: change_episode
#      PURPOSE: Make changes to a row in the 'eps' table for a show
#   PARAMETERS: $dbh            open handle of the MySQL database
#               $h              handle of the query that returned the episode
#                               record and comment count
#               $show           show number being updated
#               $updatedb       Boolean; true when changes are to be made
#               $title          Boolean; true when the episode title is to be
#                               changed
#               $summary        Boolean; true when the episode summary is to be
#                               changed
#               $tags           Boolean; true when the episode tags are to be
#                               changed
#               $notes          Boolean; true when the episode notes are to be
#                               changed
#      RETURNS: Nothing
#  DESCRIPTION: The episode has been found in the database. The requested
#               changes are applied. If after comparing old with new changes
#               are found they are applied, otherwise nothing is done.
#       THROWS: No exceptions
#     COMMENTS: None
#     SEE ALSO: N/A
#===============================================================================
sub change_episode {
    my ( $dbh, $h, $show, $updatedb, $title, $summary, $tags, $notes ) = @_;

    my (%changes);

    #<<< [perltidy messes up the following]
    if ($title) {
        $changes{title} = check_field( 'title',
            scalar( run_editor( $h->{title} ) ), 100, qr{(\n)} );
    }
    if ($summary) {
        $changes{summary} = check_field( 'summary',
            scalar( run_editor( $h->{summary} ) ), 100, qr{(\n)} );
    }
    if ($tags) {
        $changes{tags} = check_field( 'tags',
            scalar( run_editor( $h->{tags} ) ), 200, qr{(\n)} );
    }
    if ($notes) {
        $changes{notes} = run_editor( $h->{notes}, ['+set filetype=html'] );
    }
    #>>>
    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 $h->{$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 => $show );
            my ( $stmt, @bind ) = $sql->update( 'eps', \%changes, \%where );

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

            #
            # Report the update
            #
            if ($rv) {
                my $ccount = scalar( keys(%changes) );
                printf "Updated database (%d %s to the eps row for show %s)\n",
                    $ccount, _plural( 'change', $ccount ), $show;
            }
            else {
                print "Episode $show not updated due to error\n";
            }

        }
        else {
            #
            # No changes were found
            #
            print "There was nothing to do\n";
        }
    }
    else {
        print "Option -noupdatedb chosen database not updated\n";
    }

    return;
}

#===  FUNCTION  ================================================================
#         NAME: change_comment
#      PURPOSE: Make changes to a comment relating to a show
#   PARAMETERS: $dbh            open handle of the MySQL database
#               $h              handle of the query that returned the episode
#                               record and comment count
#               $show           show number being updated
#               $cnumber        comment number within show
#               $updatedb       Boolean; true when changes are to be made
#               $ctitle         Boolean; true when the comment title is to be
#                               changed
#               $ctext          Boolean; true when the comment text is to be
#                               changed
#      RETURNS: Nothing
#  DESCRIPTION: The episode has been found in the database and the number of
#               comments determined. We know there are more than zero comments
#               otherwise this routine woulkd not have been called. We check
#               that the requested comment number is in range here (if could
#               have been done before invocation). We query the target comment
#               and modify one or both of the requested fields. If, after
#               comparing old with new, changes are found, they are applied,
#               otherwise nothing is done.
#       THROWS: No exceptions
#     COMMENTS: None
#     SEE ALSO: N/A
#===============================================================================
sub change_comment {
    my ( $dbh, $h, $show, $cnumber, $updatedb, $ctitle, $ctext ) = @_;

    my ( $sth1, $h1 );
    my (%changes);

    if ( $cnumber <= $h->{comment_count} ) {
        #
        # Get the requested comment
        #
        $sth1 = $dbh->prepare(
            q{
                SELECT *
                FROM comments
                WHERE eps_id = ?
                ORDER BY comment_timestamp
                LIMIT 1
                OFFSET ?
            }
        );
        $sth1->execute( $show, $cnumber - 1 );
        if ( $dbh->err ) {
            warn $dbh->errstr;
        }

        #
        # If found perform changes, otherwise it wasn't found (not sure how
        # that's possible but you never know)
        #
        if ( $h1 = $sth1->fetchrow_hashref ) {
            if ($ctitle) {
                $changes{comment_title} = run_editor( $h1->{comment_title} );
            }
            if ($ctext) {
                $changes{comment_text} = run_editor( $h1->{comment_text} );
            }
            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 => $h1->{id} );
                    my ( $stmt, @bind )
                        = $sql->update( 'comments', \%changes, \%where );

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

                    #
                    # Report the update
                    #
                    if ($rv) {
                        my $ccount = scalar(keys(%changes));
                        printf "Updated database (%d %s to the comments row)\n",
                            $ccount, _plural( 'change', $ccount );
                    }
                    else {
                        print "Comment not updated due to error\n";
                    }

                }
                else {
                    print "There was nothing to do\n";
                }
            }
            else {
                print "Option -noupdatedb chosen database not updated\n";
            }
        }
    }
    else {
        print "Requested comment is out of range\n";
    }

    return;
}

#===  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: _plural
#      PURPOSE: Add an 's' to a word depending on a number
#   PARAMETERS: $word           word to pluralise
#               $count          number being used in message
#      RETURNS: The word in a plural form or not
#  DESCRIPTION: Just hides the expression that adds an 's' or not behind
#               a function call
#       THROWS: No exceptions
#     COMMENTS: None
#     SEE ALSO: N/A
#===============================================================================
sub _plural {
    my ( $word, $count ) = @_;

    return $word . ( abs($count) != 1 ? 's' : '' );
}

#===  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", "config=s", "updatedb!", "title!",
        "summary!", "tags!",   "notes!", "ctitle!", "ctext!", "cnumber=i",
    );

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

    return;
}

__END__

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

=head1 NAME

edit_episode - edit one or more fields in the database for a given HPR show

=head1 VERSION

This documentation refers to edit_episode version 0.1.4


=head1 USAGE

    edit_episode [-help] [-debug=N] [-config=FILE] [-[no]updatedb] [-[no]title]
        [-[no]summary] [-[no]tags] [-[no]notes] [-[no]ctitle] [-[no]ctext]
        [-cnumber=N] shownumber

    edit_episode -updatedb -title 1234
    edit_episode -updatedb -title -summary 2000
    edit_episode -updatedb -tags 2050
    edit_episode -updatedb -notes 2045
    edit_episode -updatedb -ctext -cnumber=1 2813


=head1 REQUIRED ARGUMENTS

=over 4

=item B<shownumber>

The script must be provided with a single show number to operate on.

=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<-[no]title>

This option, if given (as B<-title>) indicates that the 'title' field of the
row for the selected episode is to be edited. The Vim editor is invoked to
make changes. The default is B<-notitle> meaning that this field is not to be
edited.

=item B<-[no]summary>

This option, if given (as B<-summary>) indicates that the 'summary' field of the
row for the selected episode is to be edited. The Vim editor is invoked to
make changes. The default is B<-nosummary> meaning that this field is not to be
edited.

=item B<-[no]tags>

This option, if given (as B<-tags>) indicates that the 'tags' field of the
row for the selected episode is to be edited. The Vim editor is invoked to
make changes. The default is B<-notags> meaning that this field is not to be
edited.

=item B<-[no]notes>

This option, if given (as B<-notes>) indicates that the 'notes' field of the
row for the selected episode is to be edited. The Vim editor is invoked to
make changes. The default is B<-nonotes> meaning that this field is not to be
edited.

=item B<-[no]ctitle>

This option, if given (as B<-ctitle>) indicates that the 'title' field of the
row for the selected comment is to be edited. The Vim editor is invoked to
make changes. The default is B<-noctitle> meaning that this field is not to be
edited.

=item B<-[no]ctext>

This option, if given (as B<-ctext>) indicates that the 'comment_text' field
of the row for the selected comment is to be edited. The Vim editor is invoked
to make changes. The default is B<-noctext> meaning that this field is not to
be edited.

=item B<-cnumber=N>

If comment fields are being edited then a comment index is required. The
comments are numbered starting from 1 and are sorted in the submission
timestamp order. This number must be in the range 1..N where I<N> is the
number of comments on this particular show.

=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

At least one of the options B<-title>, B<-summary>, B<-tags> and B<-notes>
must be provided otherwise the script will abort with an error.

=head1 DESCRIPTION

The script B<edit_episode> provides an editor interface to certain fields in
the HPR database. The fields are:

=over 4

=item B<title>

    A single line of up to 100 characters of text. The line is rendered as an
    "<h1>" tag on the web page and is incorporated into the RSS feed, so it
    must only contain characters legal in these contexts.

=item B<summary>

    A single line of up to 100 characters of text. The line is rendered as an
    "<h3>" tag on the web page and is incorporated into the RSS feed, so it
    must only contain characters legal in these contexts.

=item B<tags>

    A single line of up to 200 characters of text. The field holds tags
    relevant to the content of the episode in CSV format.

=item B<notes>

    A block of HTML which is to be included inside "<article>" tags making up
    the show notes on the web page for the episode.

=item B<comment_title>

    A single line of text. The title is stored in a 'text' field in the
    database and could be of any length, but will not be rendered correctly
    if it exceeds 100 characters.

=item B<comment_text>

    A block of text (NOT HTML) which is the body of the comment. There are no
    limit contraints here although the code that initiaslly accepts a comment
    does impose a limit. Thus it would be unwise to make this field too large.

=back

=head1 DIAGNOSTICS

=over 4

=item B<Select one of -title, -summary, -tags, -notes, -ctitle and -ctext>

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

=item B<Needs a comment number (-cnumber=N)>

If one of B<-ctitle> and B<-ctext> is provided then a comment number is needed.

=item B<Specify the show number>

The show number has been omitted. This 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<Edit failed>

If the Vim edit session fails in some way the script reports it this way.

=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
 File::Slurp
 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) 2015-2019 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