Updates to three scripts

Database/edit_episode: updated a message Database/query2csv, Database/query2tt2: updated both scripts to handle SQLite and MySQL databases; both take (almost) the same options; both query a database in a similar way with arguments to match placeholders; 'query2tt2' takes a TT² template and options to feed to it; converted the database connection section to a function 'db_connect'; both have comprehensive POD documentation.
2025-05-06 21:35:23 +01:00
parent 16d62131a1
commit 118ee00677
3 changed files with 770 additions and 164 deletions
--- a/Database/query2tt2
+++ b/Database/query2tt2
@@ -3,11 +3,11 @@
 #
 #         FILE: query2tt2
 #
-#        USAGE: ./query2tt2 [-help] [-debug=N] [-config=FILE] [-query=FILE]
-#               [-template=FILE]
+#        USAGE: ./query2tt2 [-help] [-documentation|-man] [-debug=N]
+#               [-config=FILE] [-query=FILE] [-template=FILE]
 #               [-dbarg=ARG1 [-dbarg=ARG2] ...]
-#               [-define KEY1=VALUE1 [-define KEY2=VALUE2] ...
-#               [-define KEYn=VALUEn]] [QUERY]
+#               [-define KEY1=VALUE1 [-define KEY2=VALUE2] ...]
+#               [QUERY]
 #
 #  DESCRIPTION: Built for use with the Hacker Public Radio database, but could
 #               be used in any context with a MariaDB database.
@@ -24,31 +24,26 @@
 #      OPTIONS: ---
 # REQUIREMENTS: ---
 #         BUGS: ---
-#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
+#        NOTES: ---
 #       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
-#      VERSION: 0.0.5
+#      VERSION: 0.0.8
 #      CREATED: 2021-06-18 13:24:49
-#     REVISION: 2024-06-29 18:42:49
+#     REVISION: 2025-05-06 16:39:25
 #
 #===============================================================================

-use 5.010;
-use strict;
-use warnings;
+use v5.40;
 use utf8;
-use open ':encoding(UTF-8)';
+use open ':std', ':encoding(UTF-8)';

-# Using experimental features, some of which require warnings to be turned off
 use feature qw{ say try };
-no warnings qw{
-    experimental::try
-};
+
+use Cwd qw( getcwd abs_path );                 # Detecting where the script lives

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

 use Config::General;
-#use Try::Tiny;
 use File::Slurper qw{ read_text };
 use Hash::Merge;
 use Template;
@@ -59,14 +54,12 @@ use Data::Dumper;
 #
 # Version number (manually incremented)
 #
-our $VERSION = '0.0.5';
+our $VERSION = '0.0.8';

 #
 # Script and directory names
 #
 ( my $PROG = $0 ) =~ s|.*/||mx;
-( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
-$DIR = '.' unless $DIR;

 #-------------------------------------------------------------------------------
 # Declarations
@@ -74,11 +67,16 @@ $DIR = '.' unless $DIR;
 #
 # Constants and other declarations
 #
-my $basedir    = "$ENV{HOME}/HPR/Database";
-my $configfile = "$basedir/.hpr_db.cfg";
+#
+# Make a variable to hold the working directory where the script is located
+#
+( my $basedir = abs_path($0) ) =~ s|/?[^/]*$||mx;
+
+my $configfile = "$basedir/.hpr_sqlite.cfg";

 my ( $dbh, $sth1 );
 my ( $query, $result, @names, $document );
+my ( $pcount, $acount );

 #
 # Default template iterates through all rows in the 'result' matrix and for
@@ -94,15 +92,10 @@ my $def_template = <<'ENDTPL';
 [% END -%]
 ENDTPL

-#-------------------------------------------------------------------------------
+################################################################################
 # There should be no need to edit anything after this point
-#-------------------------------------------------------------------------------
+################################################################################

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

 #-------------------------------------------------------------------------------
 # Options and arguments
@@ -124,7 +117,7 @@ pod2usage(
    -verbose => 2,
    -exitval => 1,
    -noperldoc => 0,
-) if ( $options{'doc'} );
+) if ( $options{'documentation'} );


 #
@@ -143,6 +136,9 @@ my %defs   = _define( \%options );
 _debug( $DEBUG >= 3, '@dbargs: ' . join( ',', @dbargs ) );
 _debug( $DEBUG >= 3, '%defs: ' . Dumper(\%defs) );

+my $outfile = $options{output};
+_debug( $DEBUG >= 3, '$outfile: ' . $outfile ) if ($outfile);
+
 #-------------------------------------------------------------------------------
 # Option checks and defaults
 #-------------------------------------------------------------------------------
@@ -158,11 +154,31 @@ if ($queryfile) {
 }
 else {
    $query = shift;
-    pod2usage( -msg => "Please specify a SQL query\n", -exitval => 1 )
+    pod2usage(
+        -msg     => "Please specify a SQL query\n",
+        -exitval => 1,
+        -verbose => 0
+        )
        unless $query;
 }
 _debug( $DEBUG >= 3, '$query: ' . Dumper(\$query) );

+#
+# Count placeholders in the query and the arguments provided
+#
+$pcount = grep {/\?/} split( '', $query );
+$acount = scalar(@dbargs);
+
+if ( $pcount ne $acount) {
+    say STDERR "Query placeholder vs argument mismatch";
+    say STDERR "Placeholders = $pcount, Arguments = $acount";
+    pod2usage(
+        -msg       => "Wrong number of DB arguments\n",
+        -exitvalue => 1,
+        -verbose   => 0
+    );
+}
+
 #
 # Template is the default pre-defined string or a filename
 #
@@ -176,41 +192,49 @@ _debug(
    $DEBUG >= 3,
    '$template: '
        . (ref($template) eq ''
-        ? "filename $template"
+        ? "filename = $template"
        : "reference to string\n$$template")
 );

 #-------------------------------------------------------------------------------
-# Load database configuration data
+# Open the output file (or STDOUT)
+#-------------------------------------------------------------------------------
+my $outfh;
+if ($outfile) {
+    open( $outfh, ">:encoding(UTF-8)", $outfile )
+        or die "Unable to open $outfile for writing: $!";
+}
+else {
+    open( $outfh, ">&", \*STDOUT )
+        or die "Unable to initialise for writing: $!";
+}
+
+#-------------------------------------------------------------------------------
+# Load database configuration data; allow environment variables
 #-------------------------------------------------------------------------------
 my $conf = Config::General->new(
    -ConfigFile      => $cfgfile,
    -InterPolateVars => 1,
+    -InterPolateEnv  => 1,
    -ExtendedAccess  => 1
 );
 my %config = $conf->getall();

+#
+# Set defaults
+#
+$config{database}->{dbtype} //= 'SQLite';
+$config{database}->{host}   //= '127.0.0.1';
+$config{database}->{port}   //= 3306;
+
 #-------------------------------------------------------------------------------
 # 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 = db_connect(\%config);

-$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
-    $dbuser, $dbpwd, { AutoCommit => 1 } )
-    or die $DBI::errstr;
-
-#
-# Enable client-side UTF8
-#
-$dbh->{mysql_enable_utf8} = 1;
-
-#
-# Set up the query
-#
+#-------------------------------------------------------------------------------
+# Set up and perform the query
+#-------------------------------------------------------------------------------
 $sth1 = $dbh->prepare($query) or die $DBI::errstr;
 if ( $dbh->err ) {
    die $dbh->errstr;
@@ -229,11 +253,8 @@ catch ($e) {
    #
    # The 'die' above was triggered. The error is in $_.
    #
-    my $pcount = grep {/\?/} split( '', $query );
-    my $acount = scalar(@dbargs);
-    print STDERR "Failed to execute query.\n";
-    print STDERR "Placeholder/Argument mismatch: $pcount/$acount\n";
-    exit;
+    say STDERR "Failed to execute query.";
+    exit 1;
 }

 #
@@ -249,14 +270,16 @@ _debug( $DEBUG >= 3, '$result: ' . Dumper($result) );
 _debug( $DEBUG >= 3, '@names: ' . Dumper(\@names) );

 #
-# Set up the template
+# Set up the template object. Look for template files where the script lives
+# and in the current directory.
 #
 my $tt = Template->new(
    {   ABSOLUTE     => 1,
+        RELATIVE     => 1,
        ENCODING     => 'utf8',
-        INCLUDE_PATH => $basedir,
+        INCLUDE_PATH => [ $basedir, getcwd() ],
    }
-);
+) || die Template->error(), "\n";

 #
 # Send collected data to the template
@@ -274,10 +297,87 @@ _debug( $DEBUG >= 3, '$vars: ' . Dumper($vars) );

 $tt->process( $template, $vars, \$document, { binmode => ':utf8' } )
    || die $tt->error(), "\n";
-print $document;
+print $outfh $document;
+close($outfh);
+_debug( $DEBUG >= 3, '$document: ' . Dumper($document) );

 exit;

+#===  FUNCTION  ================================================================
+#         NAME: db_connect
+#      PURPOSE: Connects to a database using configuration settings including
+#               the database type
+#   PARAMETERS: $cfg            Config::General object
+#      RETURNS: Database handle
+#  DESCRIPTION: The 'dbtype' field in the configuration file gets a default,
+#               but the 'name' field is mandatory. Depending on the
+#               (lowercase) type name a different form of database connect is
+#               performed after '$dbtype' is set to the format the DBD driver
+#               needs. The database handle is returned (unless there's an
+#               error).
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub db_connect {
+    my ($cfg) = @_;
+
+    my ( $dbh, $dbtype, $dbname );
+
+    $dbtype = $config{database}->{dbtype};
+    $dbname = $config{database}->{name};
+    die "Database name is mandatory\n" unless $dbname;
+
+    #
+    # Connect according to the database type
+    #
+    if ($dbtype =~ /sqlite/i) {
+        #
+        # The name for the SQLite driver is 'DBD:SQLite'
+        #
+        $dbtype = 'SQLite';
+
+        $dbh = DBI->connect( "DBI:$dbtype:dbname=$dbname",
+            "", "", { AutoCommit => 1, sqlite_unicode => 1,  } )
+            or die $DBI::errstr;
+    }
+    elsif ($dbtype =~ /mysql/i) {
+        #
+        # The name for the MySQL driver is 'DBD:mysql'
+        #
+        $dbtype = 'mysql';
+
+        my $dbhost = $config{database}->{host};
+        my $dbport = $config{database}->{port};
+        my $dbuser = $config{database}->{user};
+        my $dbpwd  = $config{database}->{password};
+
+        $dbh = DBI->connect( "DBI:$dbtype:host=$dbhost;port=$dbport;database=$dbname",
+            $dbuser, $dbpwd, { AutoCommit => 1 } )
+            or die $DBI::errstr;
+
+        #
+        # Enable client-side UTF8
+        #
+        $dbh->{mysql_enable_utf8} = 1;
+
+        # $dbh->trace('2|SQL');
+    }
+    elsif ($dbtype =~ /pg/i) {
+        #
+        # The name for the PostgreSQL driver is 'DBD:Pg'
+        #
+        $dbtype = 'Pg';
+
+        die "The PostgreSQL database type is not catered for yet.\n";
+    }
+    else {
+        die "Unknown database type: $dbtype\n";
+    }
+
+    return $dbh;
+}
+
 #===  FUNCTION  ================================================================
 #         NAME: _debug
 #      PURPOSE: Prints debug reports
@@ -299,7 +399,6 @@ sub _debug {
    print STDERR "D> $message\n" if $active;
 }

-
 #===  FUNCTION  ================================================================
 #         NAME: _dbargs
 #      PURPOSE: Collects database arguments for the main query
@@ -362,8 +461,11 @@ sub Options {
    my ($optref) = @_;

    my @options = (
-        "help",    "doc",        "debug=i",   "config=s",
-        "query=s", "template=s", "dbargs=s@", "define=s%",
+        "help",       "documentation|man",
+        "debug=i",    "config=s",
+        "output=s",   "query=s",
+        "template=s", "dbargs=s@",
+        "define=s%",
    );

    if ( !GetOptions( $optref, @options ) ) {
@@ -386,26 +488,14 @@ query2tt2 - A script for formatting a report from database query using a templat

 =head1 VERSION

-This documentation refers to query2tt2 version 0.0.5
+This documentation refers to query2tt2 version 0.0.8

 =head1 USAGE

-    query2tt2 [-help] [-doc] [-debug=N] [-config=FILE] [-query=FILE]
-         [-template=FILE] [-dbargs=ARG1 [-dbarg=ARG2] ...]
+    query2tt2 [-help] [-documentation|-man] [-debug=N] [-config=FILE]
+         [-query=FILE] [-template=FILE] [-dbargs=ARG1 [-dbarg=ARG2] ...]
         [define KEY1=VALUE [define key2=VALUE2] ...] [QUERY]

-    query2tt2 -help
-
-    query2tt2 -query=tag_query_580-589.sql
-
-    query2tt2 -config=.hpr_livedb.cfg -template=query2tt2_taglist.tpl \
-    'select id,summary,tags from eps where id between 580 AND 589 AND (length(summary) = 0 or length(tags) = 0) ORDER BY id'
-
-    query2tt2 -config=.hpr_livedb.cfg -query=hosts_showcount.sql \
-        -dbargs '2021-01-01' -dbargs '2021-12-31' \
-        -def year=2021 -template=~/HPR/Community_News/hosts_list.tpl
-
-
 =head1 OPTIONS

 =over 4
@@ -414,7 +504,7 @@ This documentation refers to query2tt2 version 0.0.5

 Prints a brief help message describing the usage of the program, and then exits.

-=item B<-doc>
+=item B<-documentation> or B<-man>

 Displays the entirety of the documentation (using a pager), and then exits. To
 generate a PDF version use:
@@ -445,11 +535,17 @@ Prints all data structures from options or from the database
 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 HPR database over an SSH tunnel.
+to access alternative databases.

 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>
+If the option is omitted the default file is used: B<.hpr_sqlite.cfg>
+
+=item B<-output=FILE>
+
+This option defines an output file to receive the result of the query. If the
+option is omitted the notes are written to STDOUT, allowing them to be
+redirected if required.

 =item B<-query=FILE>

@@ -474,30 +570,32 @@ The results of the query are fed to the Template Toolkit system for
 reformatting. This option provides the name of the template definition file.
 If this option is omitted then the script uses a very simple internal template
 which is roughly equivalent to the effect in MySQL/MariaDB of ending a query
-with I<\G>.
+with I<\G> or using I<.mode list> with SQLite.

 See below in the B<DESCRIPTION> section for the constraints imposed on the
 contents of the template.

-Output from the template is written to STDOUT.
+Output from the template is written to STDOUT or to the file designated with
+the B<-out=FILE> option.

 =item B<-define KEY1=VALUE1> [ B<-define KEY2=VALUE2> ... B<-define KEYn=VALUEn> ]

 The Template Toolkit (TT2) template may receive values from the command line
 using this option. The argument to the B<-define> option is a B<key=value>
 pair. Keys should be unique otherwise they will overwrite one another. They
-should also not be 'names' or 'result' because these keys are used internally
-(for the data from the database). See below for more details. The keys will
-become TT2 variables and the values will be assigned to them.
+should also not be I<'names'> or I<'result'> because these keys are used
+internally (for the data from the database). See below for more details. The
+keys will become TT2 variables and the values will be assigned to them.

 =back

 =head1 DESCRIPTION

 The purpose of the script is to run a query against the HPR database (a local
-copy or the live one on the server over an SSH tunnel). The database choice is
-made via a configuration file. The default file points to the local database,
-but the alternative (discussed later) accesses the live database.
+copy in SQLite or MySQL form or the live one on the server over an SSH
+tunnel). The database choice is made via a configuration file. The default
+file points to the local database, but the alternative (discussed later)
+accesses the live database.

 The data returned from the query is then passed through a Template Toolkit
 template so that it can be formatted. There are many ways in which this can be
@@ -566,26 +664,64 @@ An error has occurred while processing the template.

 =head1 CONFIGURATION AND ENVIRONMENT

-The script obtains the credentials it requires to open the MariaDB 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
+The script obtains the credentials it requires to open the SQLite or MariaDB database
+from a configuration file. No credentials are required for the SQLite format.
+The name of the MySQL database or the SQLite file it expects is specified as
+a simple name or as an absolute file path. This configuration file can be overridden
 using the B<-config=FILE> option as described above.

-The configuration file format is as follows:
+The configuration file formats are as follows:
+
+SQLite format:

 <database>
-     host = 127.0.0.1
-     port = PORT
-     name = DATABASE
-     user = USERNAME
+     dbtype = SQLite
+     name   = /home/cendjm/HPR/Community_News/hpr.db
+ </database>
+
+MySQL/MariaDB format:
+
+ <database>
+     dbtype   = MySQL
+     host     = 127.0.0.1
+     name     = hpr_hpr
+     user     = hpradmin
     password = PASSWORD
 </database>

+=head1 EXAMPLES
+
+ # Request minimal help
+ query2tt2 -help
+
+ # Request full internal documentation
+ query2tt2 -man
+
+ # Run a query from a file and output in the default format
+ query2tt2 -query=tag_query_580-589.sql
+
+ # Run the query on the command line and process the results using
+ # a specific template
+ query2tt2 -config=.hpr_sqlite.cfg -template=query2tt2_taglist.tpl \
+     'select id,summary,tags from eps where id between 580 AND 589
+     AND (length(summary) = 0 or length(tags) = 0) ORDER BY id'
+
+ # Run a query from a file. The query has two placeholders which receive
+ # values from the '-dbarg' options. A template processes the output and
+ # takes a TT2 variable 'year' which is used by the template. Output is in
+ # HTML format and is written to a file.
+ query2tt2 -config=.hpr_sqlite.cfg -query=hosts_showcount.sql \
+     -dbargs '2024-01-01' -dbargs '2024-12-31' \
+     -def year=2024 -template=~/HPR/Community_News/hosts_list.tpl \
+     -out=host_showcount.html
+
+
 =head1 DEPENDENCIES

    Config::General
-    DBI
+    Cwd
    Data::Dumper
+    DBI
    File::Slurper
    Getopt::Long
    Hash::Merge
@@ -605,8 +741,8 @@ Dave Morriss (Dave.Morriss@gmail.com)

 =head1 LICENCE AND COPYRIGHT

-Copyright (c) 2021, 2022, 2024 Dave Morriss (Dave.Morriss@gmail.com). All
-rights reserved.
+Copyright (c) 2021, 2022, 2024, 2025 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.