HPR/hpr-tools
5
0
Fork 1
Code Issues 12 Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'main' of repo.anhonesthost.net:HPR/hpr-tools

Browse Source
This commit is contained in:
Ken Fallon 2025-05-08 17:36:28 +02:00
commit ce929988e7
4 changed files with 1297 additions and 228 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Database/edit_episode
View File

@ -14,9 +14,9 @@
# BUGS: --- # BUGS: ---
# NOTES: Had to revert to MySQL due to a problem with DBD::MariaDB # NOTES: Had to revert to MySQL due to a problem with DBD::MariaDB
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.1.3 # VERSION: 0.1.4
# CREATED: 2015-06-17 23:17:50 # CREATED: 2015-06-17 23:17:50
# REVISION: 2022-02-16 20:07:45 # REVISION: 2024-07-20 11:21:19
# #
#=============================================================================== #===============================================================================
@ -39,7 +39,7 @@ use Data::Dumper;
# #
# Version number (manually incremented) # Version number (manually incremented)
# #
our $VERSION = '0.1.3'; our $VERSION = '0.1.4';
# #
# Script and directory names # Script and directory names
@ -301,11 +301,11 @@ sub change_episode {
# #
if ($rv) { if ($rv) {
my $ccount = scalar( keys(%changes) ); my $ccount = scalar( keys(%changes) );
printf "Updated database (%d %s to the eps row)\n", printf "Updated database (%d %s to the eps row for show %s)\n",
$ccount, _plural( 'change', $ccount ); $ccount, _plural( 'change', $ccount ), $show;
} }
else { else {
print "Episode not updated due to error\n"; print "Episode $show not updated due to error\n";
} }
} }
@ -603,7 +603,7 @@ edit_episode - edit one or more fields in the database for a given HPR show
=head1 VERSION =head1 VERSION
This documentation refers to edit_episode version 0.1.3 This documentation refers to edit_episode version 0.1.4
=head1 USAGE =head1 USAGE

591
Database/query2csv
View File

@ -3,30 +3,41 @@
# #
# FILE: query2csv # FILE: query2csv
# #
# USAGE: ./query2csv query # USAGE: ./query2csv [-help] [-documentation|-man] [-debug=N]
# [-config=FILE] [-query=FILE]
# [-dbarg=ARG1 [-dbarg=ARG2] ...] [-[no-]header] [QUERY]
# #
# DESCRIPTION: Runs a query given as the only argument. Caution is needed # DESCRIPTION: Runs a query given as the only argument, or provided in
# since *any* query will be run. The result of the query is # a file. Caution is needed since *any* query will be run. The
# output in CSV form on STDOUT. The CSV is always quoted to # result of the query is output in CSV form on STDOUT or to
# cater for the more simplistic consumers. # a file. The -header option allows a CSV header of column names
# to be added (default not added). If the query contains '?'
# placeholders they can be filled with -dbarg=ARG options.
# #
# OPTIONS: --- # OPTIONS: ---
# REQUIREMENTS: --- # REQUIREMENTS: ---
# BUGS: --- # BUGS: ---
# NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB # NOTES: ---
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.0.2 # VERSION: 0.0.4
# CREATED: 2015-07-11 15:53:01 # CREATED: 2015-07-11 15:53:01
# REVISION: 2022-02-16 23:17:16 # REVISION: 2025-05-06 21:12:08
# #
#=============================================================================== #===============================================================================
use 5.010; use v5.40;
use strict;
use warnings;
use utf8; use utf8;
use open ':std', ':encoding(UTF-8)';
use feature qw{ say try };
use Cwd qw( getcwd abs_path ); # Detecting where the script lives
use Getopt::Long;
use Pod::Usage;
use Config::General; use Config::General;
use File::Slurper qw{ read_text };
use Text::CSV_XS; use Text::CSV_XS;
use DBI; use DBI;
@ -35,14 +46,12 @@ use Data::Dumper;
# #
# Version number (manually incremented) # Version number (manually incremented)
# #
our $VERSION = '0.0.2'; our $VERSION = '0.0.4';
# #
# Script and directory names # Script name
# #
( my $PROG = $0 ) =~ s|.*/||mx; ( my $PROG = $0 ) =~ s|.*/||mx;
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
$DIR = '.' unless $DIR;
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
# Declarations # Declarations
@ -50,58 +59,140 @@ $DIR = '.' unless $DIR;
# #
# Constants and other declarations # Constants and other declarations
# #
my $basedir = "$ENV{HOME}/HPR/Database"; #
my $configfile = "$basedir/.hpr_livedb.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, $aref1 ); my ( $dbh, $sth1, $aref1 );
my ( $query, $csv ); my ( $query, @names, $csv );
my ( $pcount, $acount );
#
# Enable Unicode mode
#
binmode STDOUT, ":encoding(UTF-8)";
binmode STDERR, ":encoding(UTF-8)";
#
# Load database configuration data
#
my $conf = Config::General->new(
-ConfigFile => $configfile,
-InterPolateVars => 1,
-ExtendedAccess => 1
);
my %config = $conf->getall();
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
# Options and arguments # Options and arguments
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
$query = shift; my %options;
die "Usage: $PROG query\n" unless $query; Options( \%options );
#
# Default help
#
pod2usage( -msg => "Version $VERSION\n", -exitval => 1, -verbose => 0 )
if ( $options{'help'} );
#
# Full documentation if requested with -doc
#
pod2usage(
-msg => "$PROG version $VERSION\n",
-verbose => 2,
-exitval => 1,
-noperldoc => 0,
) if ( $options{'documentation'} );
#
# Collect options
#
my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
my $cfgfile
= ( defined( $options{config} ) ? $options{config} : $configfile );
my $queryfile = $options{query};
my $header = ( defined( $options{header} ) ? $options{header} : 0 );
my $outfile = $options{output};
_debug( $DEBUG >= 3, '$outfile: ' . $outfile ) if ($outfile);
my @dbargs = _dbargs( \%options );
_debug( $DEBUG >= 3, '@dbargs: ' . join( ',', @dbargs ) );
#-------------------------------------------------------------------------------
# Option checks and defaults
#-------------------------------------------------------------------------------
die "Unable to find configuration file $cfgfile\n" unless ( -e $cfgfile );
_debug( $DEBUG >= 3, '$cfgfile: ' . $cfgfile );
#
# Query is an argument string or is in a file
#
if ($queryfile) {
die "Unable to find query file $queryfile\n" unless ( -e $queryfile );
$query = read_text($queryfile);
}
else {
$query = shift;
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);
#
# Check the placeholder and argument counts are the same
#
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
);
}
#-------------------------------------------------------------------------------
# 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 => $configfile,
-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 # Connect to the database
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
my $dbhost = $config{database}->{host} // '127.0.0.1'; $dbh = db_connect(\%config);
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:host=$dbhost;port=$dbport;database=$dbname",
# $dbuser, $dbpwd, { AutoCommit => 1 } )
# or die $DBI::errstr;
$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname", #-------------------------------------------------------------------------------
$dbuser, $dbpwd, { AutoCommit => 1 } ) # Set up and perform the query
or die $DBI::errstr; #-------------------------------------------------------------------------------
#
# Enable client-side UTF8
#
$dbh->{mysql_enable_utf8} = 1;
#
# Set up the query
#
$sth1 = $dbh->prepare($query) or die $DBI::errstr; $sth1 = $dbh->prepare($query) or die $DBI::errstr;
if ( $dbh->err ) { if ( $dbh->err ) {
warn $dbh->errstr; warn $dbh->errstr;
@ -110,9 +201,18 @@ if ( $dbh->err ) {
# #
# Perform the query # Perform the query
# #
$sth1->execute; try {
if ( $dbh->err ) { $sth1->execute(@dbargs);
if ( $dbh->err ) {
warn $dbh->errstr; warn $dbh->errstr;
}
}
catch ($e) {
#
# The 'die' above was triggered. The error is in $_.
#
say STDERR "Failed to execute query.";
exit 1;
} }
# #
@ -122,16 +222,389 @@ $csv = Text::CSV_XS->new(
# { always_quote => 1 } # { always_quote => 1 }
); );
#
# Collect field names and output them at the start of the CSV if requested
#
if ($header) {
@names = @{$sth1->{NAME}};
_debug( $DEBUG >= 3, '@names: ' . Dumper(\@names) );
$csv->combine(@names);
say $outfh $csv->string();
}
# #
# Loop through the returned rows making and printing CSV. Each row is returned # Loop through the returned rows making and printing CSV. Each row is returned
# as an arrayref to make it easy to join everything. # as an arrayref to make it easy to join everything.
# #
while ( $aref1 = $sth1->fetchrow_arrayref ) { while ( $aref1 = $sth1->fetchrow_arrayref ) {
$csv->combine(@$aref1); $csv->combine(@$aref1);
print $csv->string(), "\n"; say $outfh $csv->string();
} }
close($outfh);
exit; 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
# PARAMETERS: $active Boolean: 1 for print, 0 for no print
# $message Message to print
# RETURNS: Nothing
# DESCRIPTION: Outputs a message if $active is true. It removes any trailing
# newline and then adds one in the 'print' to the caller doesn't
# have to bother. Prepends the message with 'D> ' to show it's
# a debug message.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub _debug {
my ( $active, $message ) = @_;
chomp($message);
print STDERR "D> $message\n" if $active;
}
#=== FUNCTION ================================================================
# NAME: _dbargs
# PURPOSE: Collects database arguments for the main query
# PARAMETERS: $opts hash reference holding the options
# RETURNS: An array holding all of the arguments
# DESCRIPTION: If there are -dbargs options they will be an array in the hash
# returned by Getopt::Long. We return the array to the caller.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub _dbargs {
my ($opts) = @_;
my @args;
if ( defined( $opts->{dbargs} ) ) {
@args = @{ $opts->{dbargs} };
}
return (@args);
}
#=== 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", "documentation|man", "debug=i", "config=s",
"output=s", "query=s", "dbargs=s@", "header!",
);
if ( !GetOptions( $optref, @options ) ) {
pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
}
return;
}
__END__
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Application Documentation
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#{{{
=head1 NAME
query2csv - A script for generating CSV from database query
=head1 VERSION
This documentation refers to query2csv version 0.0.4
=head1 USAGE
query2csv [-help] [-documentation|-man] [-debug=N] [-config=FILE]
[-query=FILE] [-output=FILE] [-[no]header] [QUERY]
=head1 OPTIONS
=over 4
=item B<-help>
Prints a brief help message describing the usage of the program, and then exits.
=item B<-documentation> or B<-man>
Displays the entirety of the documentation (using a pager), and then exits. To
generate a PDF version use:
pod2pdf query2csv --out=query2csv.pdf
=item B<-debug=N>
Selects a level of debugging. Debug information consists of a line or series
of lines prefixed with the characters 'D>':
=over 4
=item B<0>
No debug output is generated: this is the default
=item B<3>
Prints all data structures from options or from the database
=back
(The debug levels need work!)
=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.
See the CONFIGURATION AND ENVIRONMENT section below for the file format.
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>
The script needs an SQL query to be applied to the database. This may be
supplied as a file, in which case this option gives the name of the file.
Alternatively the query can be given as a delimited string on the command
line.
If neither method is used the script aborts with an error message.
=item B<-dbarg=ARG> [ B<-dbarg=ARG> ... ]
The query can have place holders ('?') in it and the corresponding values for
these placeholders can be passed to the script through the B<-dbarg=ARG>
option. The option can be repeated as many times as required and the order of
B<ARG> values is preserved.
=item B<-[no-]header>
This option allows a header to be added to the CSV output with the names of
the database columns in CSV format. By default this is not produced.
=back
=head1 DESCRIPTION
The purpose of the script is to run a query against a local database. It will
query SQLite or MySQL/MariaDB databases. The database choice is made via
a configuration file using B<dbtype = TYPE>. The default file points to the
local SQLite copy of the HPR database, but the alternative (discussed later)
can access the equivalent MySQL database.
The data returned from the query is then passed through a CSV conversion
library and the results output to the terminal or to a file.
=head1 DIAGNOSTICS
=over 4
=item B<Unable to find configuration file ...>
The nominated (or default) configuration file could not be found.
=item B<Unable to find query file ...>
The nominated query file could not be found.
=item B<Couldn't open ...: ...>
The nominated query file could not be opened.
=item B<various database errors>
An error has occurred while performing a database operation.
=item B<Failed to execute query.>
There is a mismatch between the number of placeholders in the query ('?'
characters) and the number of arguments provided through the B<-dbargs=ARG>
option. The script will attempt to analyse whether there are too many or too
few arguments
=back
=head1 CONFIGURATION AND ENVIRONMENT
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 formats are as follows:
SQLite format:
<database>
dbtype = SQLite
name = /home/cendjm/HPR/Community_News/hpr.db
</database>
MySQL/MariaDB format:
<database>
dbtype = MySQL
host = 127.0.0.1
name = DBNAME
user = DBUSER
password = PASSWORD
</database>
=head1 EXAMPLES
query2csv -help
# Find tags fields shorter than 5 characters between shows 1 and 2000
query2csv -config=.hpr_sqlite.cfg \
'SELECT id,summary,tags FROM eps WHERE id BETWEEN 1 AND 2000
AND length(tags) < 5 ORDER BY id'
# Find hosts who have released HPR shows during 2025. The database
# arguments are the dates of the start and end of the year
year=2025
query2csv -query=hosts_showcount.sqlite.sql \
-dbargs "${year}-01-01" -dbargs "${year}-12-31"
=head1 DEPENDENCIES
Config::General
Cwd
Data::Dumper
DBI
File::Slurper
Getopt::Long
Pod::Usage
Text::CSV_XS
=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) 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.
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 # vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

584
Database/query2json
View File

@ -3,29 +3,40 @@
# #
# FILE: query2json # FILE: query2json
# #
# USAGE: ./query2json query # USAGE: ./query2json [-help] [-documentation|-man] [-debug=N]
# [-config=FILE] [-query=FILE]
# [-dbarg=ARG1 [-dbarg=ARG2] ...] [QUERY]
# #
# DESCRIPTION: Runs a query given as the only argument. Caution is needed # DESCRIPTION: Runs a query given as the only argument, or provided in
# since *any* query will be run. The result of the query is # a file. Caution is needed since *any* query will be run. The
# output in JSON form on STDOUT. # result of the query is output in JSON form on STDOUT or to
# a file. If the query contains '?' placeholders they can be
# filled with -dbarg=ARG options.
# #
# OPTIONS: --- # OPTIONS: ---
# REQUIREMENTS: --- # REQUIREMENTS: ---
# BUGS: --- # BUGS: ---
# NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB # NOTES: ---
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.0.2 # VERSION: 0.0.3
# CREATED: 2021-06-18 13:24:49 # CREATED: 2021-06-18 13:24:49
# REVISION: 2023-01-05 16:17:24 # REVISION: 2025-05-07 09:50:34
# #
#=============================================================================== #===============================================================================
use 5.010; use v5.40;
use strict;
use warnings;
use utf8; use utf8;
use open ':std', ':encoding(UTF-8)';
use feature qw{ say try };
use Cwd qw( getcwd abs_path ); # Detecting where the script lives
use Getopt::Long;
use Pod::Usage;
use Config::General; use Config::General;
use File::Slurper qw{ read_text };
use JSON; use JSON;
use DBI; use DBI;
@ -34,14 +45,12 @@ use Data::Dumper;
# #
# Version number (manually incremented) # Version number (manually incremented)
# #
our $VERSION = '0.0.2'; our $VERSION = '0.0.3';
# #
# Script and directory names # Script name
# #
( my $PROG = $0 ) =~ s|.*/||mx; ( my $PROG = $0 ) =~ s|.*/||mx;
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
$DIR = '.' unless $DIR;
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
# Declarations # Declarations
@ -49,58 +58,137 @@ $DIR = '.' unless $DIR;
# #
# Constants and other declarations # Constants and other declarations
# #
my $basedir = "$ENV{HOME}/HPR/Database"; #
my $configfile = "$basedir/.hpr_livedb.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, $aref1 ); my ( $dbh, $sth1, $aref1 );
my ( $query, $result, $json ); my ( $query, $result, $json );
my ( $pcount, $acount );
#
# Enable Unicode mode
#
binmode STDOUT, ":encoding(UTF-8)";
binmode STDERR, ":encoding(UTF-8)";
#
# Load database configuration data
#
my $conf = Config::General->new(
-ConfigFile => $configfile,
-InterPolateVars => 1,
-ExtendedAccess => 1
);
my %config = $conf->getall();
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
# Options and arguments # Options and arguments
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
$query = shift; my %options;
die "Usage: $PROG query\n" unless $query; Options( \%options );
#
# Default help
#
pod2usage( -msg => "Version $VERSION\n", -exitval => 1, -verbose => 0 )
if ( $options{'help'} );
#
# Full documentation if requested with -doc
#
pod2usage(
-msg => "$PROG version $VERSION\n",
-verbose => 2,
-exitval => 1,
-noperldoc => 0,
) if ( $options{'documentation'} );
#
# Collect options
#
my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
my $cfgfile
= ( defined( $options{config} ) ? $options{config} : $configfile );
my $queryfile = $options{query};
my $outfile = $options{output};
_debug( $DEBUG >= 3, '$outfile: ' . $outfile ) if ($outfile);
my @dbargs = _dbargs( \%options );
_debug( $DEBUG >= 3, '@dbargs: ' . join( ',', @dbargs ) );
#-------------------------------------------------------------------------------
# Option checks and defaults
#-------------------------------------------------------------------------------
die "Unable to find configuration file $cfgfile\n" unless ( -e $cfgfile );
_debug( $DEBUG >= 3, '$cfgfile: ' . $cfgfile );
#
# Query is an argument string or is in a file
#
if ($queryfile) {
die "Unable to find query file $queryfile\n" unless ( -e $queryfile );
$query = read_text($queryfile);
}
else {
$query = shift;
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);
#
# Check the placeholder and argument counts are the same
#
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
);
}
#-------------------------------------------------------------------------------
# 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 => $configfile,
-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 # Connect to the database
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
my $dbhost = $config{database}->{host} // '127.0.0.1'; $dbh = db_connect(\%config);
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:host=$dbhost;port=$dbport;database=$dbname",
# $dbuser, $dbpwd, { AutoCommit => 1 } )
# or die $DBI::errstr;
$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname", #-------------------------------------------------------------------------------
$dbuser, $dbpwd, { AutoCommit => 1 } ) # Set up and perform the query
or die $DBI::errstr; #-------------------------------------------------------------------------------
#
# Enable client-side UTF8
#
$dbh->{mysql_enable_utf8} = 1;
#
# Set up the query
#
$sth1 = $dbh->prepare($query) or die $DBI::errstr; $sth1 = $dbh->prepare($query) or die $DBI::errstr;
if ( $dbh->err ) { if ( $dbh->err ) {
warn $dbh->errstr; warn $dbh->errstr;
@ -109,26 +197,398 @@ if ( $dbh->err ) {
# #
# Perform the query # Perform the query
# #
$sth1->execute; try {
if ( $dbh->err ) { $sth1->execute(@dbargs);
if ( $dbh->err ) {
warn $dbh->errstr; warn $dbh->errstr;
}
}
catch ($e) {
#
# The 'die' above was triggered. The error is in $_.
#
say STDERR "Failed to execute query.";
exit 1;
} }
#
# Grab everything as an arrayref of hashrefs
#
$result = $sth1->fetchall_arrayref( {} );
# #
# Prepare for JSON, forcing object key sorting (expensive) # Prepare for JSON, forcing object key sorting (expensive)
# #
$json = JSON->new->utf8->canonical; $json = JSON->new->utf8->canonical;
#
# Grab everything as an arrayref of hashrefs
#
$result = $sth1->fetchall_arrayref( {} );
# #
# Encode the Perl structure to JSON # Encode the Perl structure to JSON
# #
print $json->encode($result), "\n"; say $outfh $json->encode($result);
close($outfh);
exit; 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
# PARAMETERS: $active Boolean: 1 for print, 0 for no print
# $message Message to print
# RETURNS: Nothing
# DESCRIPTION: Outputs a message if $active is true. It removes any trailing
# newline and then adds one in the 'print' to the caller doesn't
# have to bother. Prepends the message with 'D> ' to show it's
# a debug message.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub _debug {
my ( $active, $message ) = @_;
chomp($message);
print STDERR "D> $message\n" if $active;
}
#=== FUNCTION ================================================================
# NAME: _dbargs
# PURPOSE: Collects database arguments for the main query
# PARAMETERS: $opts hash reference holding the options
# RETURNS: An array holding all of the arguments
# DESCRIPTION: If there are -dbargs options they will be an array in the hash
# returned by Getopt::Long. We return the array to the caller.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub _dbargs {
my ($opts) = @_;
my @args;
if ( defined( $opts->{dbargs} ) ) {
@args = @{ $opts->{dbargs} };
}
return (@args);
}
#=== 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", "documentation|man", "debug=i", "config=s",
"output=s", "query=s", "dbargs=s@",
);
if ( !GetOptions( $optref, @options ) ) {
pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
}
return;
}
__END__
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Application Documentation
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#{{{
=head1 NAME
query2json - A script for generating CSV from database query
=head1 VERSION
This documentation refers to query2json version 0.0.3
=head1 USAGE
query2json [-help] [-documentation|-man] [-debug=N] [-config=FILE]
[-query=FILE] [-output=FILE] [-[no]header] [QUERY]
=head1 OPTIONS
=over 4
=item B<-help>
Prints a brief help message describing the usage of the program, and then exits.
=item B<-documentation> or B<-man>
Displays the entirety of the documentation (using a pager), and then exits. To
generate a PDF version use:
pod2pdf query2json --out=query2json.pdf
=item B<-debug=N>
Selects a level of debugging. Debug information consists of a line or series
of lines prefixed with the characters 'D>':
=over 4
=item B<0>
No debug output is generated: this is the default
=item B<3>
Prints all data structures from options or from the database
=back
(The debug levels need work!)
=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.
See the CONFIGURATION AND ENVIRONMENT section below for the file format.
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>
The script needs an SQL query to be applied to the database. This may be
supplied as a file, in which case this option gives the name of the file.
Alternatively the query can be given as a delimited string on the command
line.
If neither method is used the script aborts with an error message.
=item B<-dbarg=ARG> [ B<-dbarg=ARG> ... ]
The query can have place holders ('?') in it and the corresponding values for
these placeholders can be passed to the script through the B<-dbarg=ARG>
option. The option can be repeated as many times as required and the order of
B<ARG> values is preserved.
=item B<-[no-]header>
This option allows a header to be added to the CSV output with the names of
the database columns in CSV format. By default this is not produced.
=back
=head1 DESCRIPTION
The purpose of the script is to run a query against a local database. It will
query SQLite or MySQL/MariaDB databases. The database choice is made via
a configuration file using B<dbtype = TYPE>. The default file points to the
local SQLite copy of the HPR database, but the alternative (discussed later)
can access the equivalent MySQL database.
The data returned from the query is then passed through a JSON conversion
library and the results output to the terminal or to a file.
=head1 DIAGNOSTICS
=over 4
=item B<Unable to find configuration file ...>
The nominated (or default) configuration file could not be found.
=item B<Unable to find query file ...>
The nominated query file could not be found.
=item B<Couldn't open ...: ...>
The nominated query file could not be opened.
=item B<various database errors>
An error has occurred while performing a database operation.
=item B<Failed to execute query.>
There is a mismatch between the number of placeholders in the query ('?'
characters) and the number of arguments provided through the B<-dbargs=ARG>
option. The script will attempt to analyse whether there are too many or too
few arguments
=back
=head1 CONFIGURATION AND ENVIRONMENT
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 formats are as follows:
SQLite format:
<database>
dbtype = SQLite
name = /home/cendjm/HPR/Community_News/hpr.db
</database>
MySQL/MariaDB format:
<database>
dbtype = MySQL
host = 127.0.0.1
name = DBNAME
user = DBUSER
password = PASSWORD
</database>
=head1 EXAMPLES
query2json -help
# Find tags fields shorter than 5 characters between shows 1 and 2000
query2json -config=.hpr_sqlite.cfg \
'SELECT id,summary,tags FROM eps WHERE id BETWEEN 1 AND 2000
AND length(tags) < 5 ORDER BY id'
# Find hosts who have released HPR shows during 2025. The database
# arguments are the dates of the start and end of the year
year=2025
query2json -query=hosts_showcount.sqlite.sql \
-dbargs "${year}-01-01" -dbargs "${year}-12-31"
=head1 DEPENDENCIES
Config::General
Cwd
Data::Dumper
DBI
File::Slurper
Getopt::Long
Pod::Usage
Text::CSV_XS
=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) 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.
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 # vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

330
Database/query2tt2
View File

@ -3,11 +3,11 @@
# #
# FILE: query2tt2 # FILE: query2tt2
# #
# USAGE: ./query2tt2 [-help] [-debug=N] [-config=FILE] [-query=FILE] # USAGE: ./query2tt2 [-help] [-documentation|-man] [-debug=N]
# [-template=FILE] # [-config=FILE] [-query=FILE] [-template=FILE]
# [-dbarg=ARG1 [-dbarg=ARG2] ...] # [-dbarg=ARG1 [-dbarg=ARG2] ...]
# [-define KEY1=VALUE1 [-define KEY2=VALUE2] ... # [-define KEY1=VALUE1 [-define KEY2=VALUE2] ...]
# [-define KEYn=VALUEn]] [QUERY] # [QUERY]
# #
# DESCRIPTION: Built for use with the Hacker Public Radio database, but could # DESCRIPTION: Built for use with the Hacker Public Radio database, but could
# be used in any context with a MariaDB database. # be used in any context with a MariaDB database.
@ -24,31 +24,26 @@
# OPTIONS: --- # OPTIONS: ---
# REQUIREMENTS: --- # REQUIREMENTS: ---
# BUGS: --- # BUGS: ---
# NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB # NOTES: ---
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.0.5 # VERSION: 0.0.8
# CREATED: 2021-06-18 13:24:49 # 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 v5.40;
use strict;
use warnings;
use utf8; 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 }; 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 Getopt::Long;
use Pod::Usage; use Pod::Usage;
use Config::General; use Config::General;
#use Try::Tiny;
use File::Slurper qw{ read_text }; use File::Slurper qw{ read_text };
use Hash::Merge; use Hash::Merge;
use Template; use Template;
@ -59,14 +54,12 @@ use Data::Dumper;
# #
# Version number (manually incremented) # Version number (manually incremented)
# #
our $VERSION = '0.0.5'; our $VERSION = '0.0.8';
# #
# Script and directory names # Script and directory names
# #
( my $PROG = $0 ) =~ s|.*/||mx; ( my $PROG = $0 ) =~ s|.*/||mx;
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
$DIR = '.' unless $DIR;
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
# Declarations # Declarations
@ -74,11 +67,16 @@ $DIR = '.' unless $DIR;
# #
# Constants and other declarations # 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 ( $dbh, $sth1 );
my ( $query, $result, @names, $document ); my ( $query, $result, @names, $document );
my ( $pcount, $acount );
# #
# Default template iterates through all rows in the 'result' matrix and for # Default template iterates through all rows in the 'result' matrix and for
@ -94,15 +92,10 @@ my $def_template = <<'ENDTPL';
[% END -%] [% END -%]
ENDTPL ENDTPL
#------------------------------------------------------------------------------- ################################################################################
# There should be no need to edit anything after this point # 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 # Options and arguments
@ -124,7 +117,7 @@ pod2usage(
-verbose => 2, -verbose => 2,
-exitval => 1, -exitval => 1,
-noperldoc => 0, -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, '@dbargs: ' . join( ',', @dbargs ) );
_debug( $DEBUG >= 3, '%defs: ' . Dumper(\%defs) ); _debug( $DEBUG >= 3, '%defs: ' . Dumper(\%defs) );
my $outfile = $options{output};
_debug( $DEBUG >= 3, '$outfile: ' . $outfile ) if ($outfile);
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
# Option checks and defaults # Option checks and defaults
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
@ -158,11 +154,31 @@ if ($queryfile) {
} }
else { else {
$query = shift; $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; unless $query;
} }
_debug( $DEBUG >= 3, '$query: ' . Dumper(\$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 # Template is the default pre-defined string or a filename
# #
@ -176,41 +192,49 @@ _debug(
$DEBUG >= 3, $DEBUG >= 3,
'$template: ' '$template: '
. (ref($template) eq '' . (ref($template) eq ''
? "filename $template" ? "filename = $template"
: "reference to string\n$$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( my $conf = Config::General->new(
-ConfigFile => $cfgfile, -ConfigFile => $cfgfile,
-InterPolateVars => 1, -InterPolateVars => 1,
-InterPolateEnv => 1,
-ExtendedAccess => 1 -ExtendedAccess => 1
); );
my %config = $conf->getall(); 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 # Connect to the database
#------------------------------------------------------------------------------- #-------------------------------------------------------------------------------
my $dbhost = $config{database}->{host} // '127.0.0.1'; $dbh = db_connect(\%config);
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:mysql:host=$dbhost;port=$dbport;database=$dbname", #-------------------------------------------------------------------------------
$dbuser, $dbpwd, { AutoCommit => 1 } ) # Set up and perform the query
or die $DBI::errstr; #-------------------------------------------------------------------------------
#
# Enable client-side UTF8
#
$dbh->{mysql_enable_utf8} = 1;
#
# Set up the query
#
$sth1 = $dbh->prepare($query) or die $DBI::errstr; $sth1 = $dbh->prepare($query) or die $DBI::errstr;
if ( $dbh->err ) { if ( $dbh->err ) {
die $dbh->errstr; die $dbh->errstr;
@ -229,11 +253,8 @@ catch ($e) {
# #
# The 'die' above was triggered. The error is in $_. # The 'die' above was triggered. The error is in $_.
# #
my $pcount = grep {/\?/} split( '', $query ); say STDERR "Failed to execute query.";
my $acount = scalar(@dbargs); exit 1;
print STDERR "Failed to execute query.\n";
print STDERR "Placeholder/Argument mismatch: $pcount/$acount\n";
exit;
} }
# #
@ -249,14 +270,16 @@ _debug( $DEBUG >= 3, '$result: ' . Dumper($result) );
_debug( $DEBUG >= 3, '@names: ' . Dumper(\@names) ); _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( my $tt = Template->new(
{ ABSOLUTE => 1, { ABSOLUTE => 1,
RELATIVE => 1,
ENCODING => 'utf8', ENCODING => 'utf8',
INCLUDE_PATH => $basedir, INCLUDE_PATH => [ $basedir, getcwd() ],
} }
); ) || die Template->error(), "\n";
# #
# Send collected data to the template # Send collected data to the template
@ -274,10 +297,87 @@ _debug( $DEBUG >= 3, '$vars: ' . Dumper($vars) );
$tt->process( $template, $vars, \$document, { binmode => ':utf8' } ) $tt->process( $template, $vars, \$document, { binmode => ':utf8' } )
|| die $tt->error(), "\n"; || die $tt->error(), "\n";
print $document; print $outfh $document;
close($outfh);
_debug( $DEBUG >= 3, '$document: ' . Dumper($document) );
exit; 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 ================================================================ #=== FUNCTION ================================================================
# NAME: _debug # NAME: _debug
# PURPOSE: Prints debug reports # PURPOSE: Prints debug reports
@ -299,7 +399,6 @@ sub _debug {
print STDERR "D> $message\n" if $active; print STDERR "D> $message\n" if $active;
} }
#=== FUNCTION ================================================================ #=== FUNCTION ================================================================
# NAME: _dbargs # NAME: _dbargs
# PURPOSE: Collects database arguments for the main query # PURPOSE: Collects database arguments for the main query
@ -362,8 +461,11 @@ sub Options {
my ($optref) = @_; my ($optref) = @_;
my @options = ( my @options = (
"help", "doc", "debug=i", "config=s", "help", "documentation|man",
"query=s", "template=s", "dbargs=s@", "define=s%", "debug=i", "config=s",
"output=s", "query=s",
"template=s", "dbargs=s@",
"define=s%",
); );
if ( !GetOptions( $optref, @options ) ) { if ( !GetOptions( $optref, @options ) ) {
@ -386,26 +488,14 @@ query2tt2 - A script for formatting a report from database query using a templat
=head1 VERSION =head1 VERSION
This documentation refers to query2tt2 version 0.0.5 This documentation refers to query2tt2 version 0.0.8
=head1 USAGE =head1 USAGE
query2tt2 [-help] [-doc] [-debug=N] [-config=FILE] [-query=FILE] query2tt2 [-help] [-documentation|-man] [-debug=N] [-config=FILE]
[-template=FILE] [-dbargs=ARG1 [-dbarg=ARG2] ...] [-query=FILE] [-template=FILE] [-dbargs=ARG1 [-dbarg=ARG2] ...]
[define KEY1=VALUE [define key2=VALUE2] ...] [QUERY] [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 =head1 OPTIONS
=over 4 =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. 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 Displays the entirety of the documentation (using a pager), and then exits. To
generate a PDF version use: 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 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 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 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. 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> =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. 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 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 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 See below in the B<DESCRIPTION> section for the constraints imposed on the
contents of the template. 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> ] =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 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> 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 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 should also not be I<'names'> or I<'result'> because these keys are used
(for the data from the database). See below for more details. The keys will internally (for the data from the database). See below for more details. The
become TT2 variables and the values will be assigned to them. keys will become TT2 variables and the values will be assigned to them.
=back =back
=head1 DESCRIPTION =head1 DESCRIPTION
The purpose of the script is to run a query against the HPR database (a local 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 copy in SQLite or MySQL form or the live one on the server over an SSH
made via a configuration file. The default file points to the local database, tunnel). The database choice is made via a configuration file. The default
but the alternative (discussed later) accesses the live database. 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 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 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 =head1 CONFIGURATION AND ENVIRONMENT
The script obtains the credentials it requires to open the MariaDB database The script obtains the credentials it requires to open the SQLite or MariaDB database
from a configuration file. The name of the file it expects is B<.hpr_db.cfg> from a configuration file. No credentials are required for the SQLite format.
in the directory holding the script. This configuration file can be overridden 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. 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> <database>
dbtype = SQLite
name = /home/cendjm/HPR/Community_News/hpr.db
</database>
MySQL/MariaDB format:
<database>
dbtype = MySQL
host = 127.0.0.1 host = 127.0.0.1
port = PORT name = hpr_hpr
name = DATABASE user = hpradmin
user = USERNAME
password = PASSWORD password = PASSWORD
</database> </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 =head1 DEPENDENCIES
Config::General Config::General
DBI Cwd
Data::Dumper Data::Dumper
DBI
File::Slurper File::Slurper
Getopt::Long Getopt::Long
Hash::Merge Hash::Merge
@ -605,8 +741,8 @@ Dave Morriss (Dave.Morriss@gmail.com)
=head1 LICENCE AND COPYRIGHT =head1 LICENCE AND COPYRIGHT
Copyright (c) 2021, 2022, 2024 Dave Morriss (Dave.Morriss@gmail.com). All Copyright (c) 2021, 2022, 2024, 2025 Dave Morriss (Dave.Morriss@gmail.com).
rights reserved. All rights reserved.
This module is free software; you can redistribute it and/or This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See perldoc perlartistic. modify it under the same terms as Perl itself. See perldoc perlartistic.