From 586c8e537eb815005591f561ede60f74b12aaf87 Mon Sep 17 00:00:00 2001 From: Dave Morriss Date: Wed, 7 May 2025 10:06:01 +0100 Subject: [PATCH] Updated query2json, and tidied query2csv --- Database/query2csv | 9 +- Database/query2json | 586 +++++++++++++++++++++++++++++++++++++++----- 2 files changed, 529 insertions(+), 66 deletions(-) diff --git a/Database/query2csv b/Database/query2csv index a800b66..517d909 100755 --- a/Database/query2csv +++ b/Database/query2csv @@ -49,7 +49,7 @@ use Data::Dumper; our $VERSION = '0.0.4'; # -# Script and directory names +# Script name # ( my $PROG = $0 ) =~ s|.*/||mx; @@ -141,6 +141,9 @@ _debug( $DEBUG >= 3, '$query: ' . Dumper(\$query) ); $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"; @@ -543,8 +546,8 @@ MySQL/MariaDB format: dbtype = MySQL host = 127.0.0.1 - name = hpr_hpr - user = hpradmin + name = DBNAME + user = DBUSER password = PASSWORD diff --git a/Database/query2json b/Database/query2json index d952a04..ac2ddc6 100755 --- a/Database/query2json +++ b/Database/query2json @@ -3,29 +3,40 @@ # # 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 -# since *any* query will be run. The result of the query is -# output in JSON form on STDOUT. +# DESCRIPTION: Runs a query given as the only argument, or provided in +# a file. Caution is needed since *any* query will be run. The +# 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: --- # 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.2 +# VERSION: 0.0.3 # 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 strict; -use warnings; +use v5.40; 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 File::Slurper qw{ read_text }; use JSON; use DBI; @@ -34,14 +45,12 @@ use Data::Dumper; # # 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 $DIR = $0 ) =~ s|/?[^/]*$||mx; -$DIR = '.' unless $DIR; #------------------------------------------------------------------------------- # Declarations @@ -49,58 +58,137 @@ $DIR = '.' unless $DIR; # # 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 ( $query, $result, $json ); - -# -# 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(); +my ( $pcount, $acount ); #------------------------------------------------------------------------------- # Options and arguments #------------------------------------------------------------------------------- -$query = shift; -die "Usage: $PROG query\n" unless $query; +my %options; +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 #------------------------------------------------------------------------------- -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:host=$dbhost;port=$dbport;database=$dbname", -# $dbuser, $dbpwd, { AutoCommit => 1 } ) -# or die $DBI::errstr; +$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 ) { warn $dbh->errstr; @@ -109,26 +197,398 @@ if ( $dbh->err ) { # # Perform the query # -$sth1->execute; -if ( $dbh->err ) { - warn $dbh->errstr; +try { + $sth1->execute(@dbargs); + if ( $dbh->err ) { + 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) # $json = JSON->new->utf8->canonical; +# +# Grab everything as an arrayref of hashrefs +# +$result = $sth1->fetchall_arrayref( {} ); + # # Encode the Perl structure to JSON # -print $json->encode($result), "\n"; +say $outfh $json->encode($result); +close($outfh); 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 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. 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 + +The nominated (or default) configuration file could not be found. + +=item B + +The nominated query file could not be found. + +=item B + +The nominated query file could not be opened. + +=item B + +An error has occurred while performing a database operation. + +=item B + +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: + + + dbtype = SQLite + name = /home/cendjm/HPR/Community_News/hpr.db + + +MySQL/MariaDB format: + + + dbtype = MySQL + host = 127.0.0.1 + name = DBNAME + user = DBUSER + password = PASSWORD + + +=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