HPR/hpr-tools
8
1
Fork 2
Code Issues 14 Pull Requests Packages Projects Releases Wiki Activity
Files
db9b491324a43b0feba28fec3f084e9366e4472d
hpr-tools/Database/edit_episode

833 lines
25 KiB
Perl
Executable File
Raw Blame History

#!/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.3
# CREATED: 2015-06-17 23:17:50
# REVISION: 2022-02-16 20:07:45
#
#===============================================================================
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.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 (%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)\n",
$ccount, _plural( 'change', $ccount );
}
else {
print "Episode 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.3
=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
Reference in New Issue View Git Blame Copy Permalink