hpr-tools/Database/edit_host

#!/usr/bin/env perl
#===============================================================================
#
#         FILE: edit_host
#
#        USAGE: ./edit_host [-help] [-debug=N] [-[no]update] [-config=FILE]
#               [-[no]espeak_name] [-hostid=id] [-[no]regex] host_name
#
#  DESCRIPTION: A simple editor for the HPR hosts table
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: DBI::MariaDB was here for a while then reverted to DBI::mysql.
#               Had to revert this script onn 2023-01-22.
#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
#      VERSION: 0.0.7
#      CREATED: 2018-04-07 22:05:06
#     REVISION: 2023-01-22 14:06:48
#
#===============================================================================

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

#
# 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 ( $host_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 $email   = ( defined( $options{'email'} )   ? $options{'email'}   : 0 );
my $profile = ( defined( $options{'profile'} ) ? $options{'profile'} : 0 );
my $espeak_name
    = ( defined( $options{'espeak_name'} ) ? $options{'espeak_name'} : 0 );

#
# There must be at least one field to change
#
die "Select one of -email, -profile and -espeak_name\n"
    unless ( $email || $profile || $espeak_name );

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

#
# Deal with the two routes: one via the unique host id, and the other vai the
# less unique host name
#
unless ($hostid) {
    #
    # Get the arg
    #
    $host_name = shift;
    pod2usage( -msg => "Specify the host name\n", -exitval => 1 )
        unless $host_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};

#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
#    $dbuser, $dbpwd, { AutoCommit => 1 } )
#    or die $DBI::errstr;

$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
    $dbuser, $dbpwd, { AutoCommit => 1 } )
    or die $DBI::errstr;

#
# Prepare to read the database either for the hostid or the exact or
# approximate name
#
if ($hostid) {
    #
    # Simple hostid query
    #
    $sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE hostid = ?});
    $sth1->execute($hostid);
    if ( $dbh->err ) {
        die $dbh->errstr;
    }
}
else {
    #
    # Host name query
    #
    if ($regexp) {
        #
        # Regexp match requested. Count how many matches there are
        #
        $sth1 = $dbh->prepare(
            q{SELECT count(*) AS count FROM hosts WHERE host REGEXP ?});
        $sth1->execute($host_name);
        if ( $dbh->err ) {
            warn $dbh->errstr;
        }
        if ( $h1 = $sth1->fetchrow_hashref ) {
            die "Too many matches to regex $host_name\n"
                unless $h1->{count} == 1;
        }
        else {
            die "Unable to find host matching regex $host_name\n";
        }

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

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

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

    #
    # So what needs changing?
    #
    #<<< [perltidy messes up the following]
    if ($email) {
        $changes{email} = check_field( 'email',
            scalar( run_editor( $h1->{email}, ['+set paste'] ) ), 256, qr{(\n)} );
    }
    if ($profile) {
        $changes{profile} = run_editor( $h1->{profile}, ['+set paste'] );
    }
    if ($espeak_name) {
        $changes{espeak_name} = check_field( 'espeak_name',
            scalar( run_editor( $h1->{espeak_name} ) ), 256, qr{(\n)} );
    }
    #>>>
    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 = ( hostid => $hostid );
            my ( $stmt, @bind ) = $sql->update( 'hosts', \%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";
            }
            else {
                print "Database not updated due to error\n";
            }

        }
        else {
            print "There was nothing to do\n";
        }
    }
    else {
        print "Database not updated\n";
    }
}
else {
    if ($hostid) {
        print "Unable to find host number $hostid\n";
    }
    else {
        print "Unable to find host name $host_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",
        "hostid=i", "regexp",  "email!",    "profile!",
        "espeak_name!",
    );

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

    return;
}

__END__


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

=head1 NAME

edit_host - edit one or more fields in the database for a given host

=head1 VERSION

This documentation refers to edit_host version 0.0.7


=head1 USAGE

    edit_host [-h] [-debug=N] [-[no]updatedb] [-hostid=ID] [-regexp]
    [-[no]email] [-[no]profile] [-[no]espeak_name] [-config=FILE] hostname

    edit_host -updatedb -espeak_name operat0r
    edit_host -updatedb -espeak_name -regexp oper
    edit_host -updatedb -email -espeak -host=225


=head1 REQUIRED ARGUMENTS

=over 4

=item B<hostname>

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

Unless the B<-regexp> option is provided (see the OPTIONS section) the
hostname 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<hostname> 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<-hostid=ID>

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

=item B<-[no]email>

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

=item B<-[no]profile>

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

=item B<-[no]espeak_name>

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

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

=over 4

=item B<email>

A single line of up to 256 characters of text. The line is stored in a 'TEXT'
field but it makes no sense to make it too long even though an email address
can be arbitrarily long. The current maximum address length in the database is
44 characters.

=item B<profile>

A multi-line line of text of arbitrary length and content. The contents are
the host's profile in optional HTML format to be displayed on the page which
lists all of their contributions to HPR.

=item B<espeak_name>

A single line of up to 256 characters of text. The line is stored in a 'TEXT'
field but it makes no sense to make it too long. Its purpose is to provide the
'espeak' program with a form of the host name (or alias) which can be spoken
as the host requires. For example the host 'thelovebug' finds his name spoken
as "thel ove bug" and this can be corrected by storing 'TheLoveBug' in this
field.

=back

=head1 DIAGNOSTICS

=over 4

=item B<Select one of -email, -profile and -espeak_name>

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

=item B<Specify the host name>

If no host name has been provided, and the B<-hostid=ID> option has not been
used the script is unable to determine the host 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 hostname has been provided that matches too many hosts in
the database. Try again with a less ambiguous name. This a fatal error.

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

In B<-regex> mode a hostname has been provided that matches no hosts 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) 2018 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