forked from HPR/hpr-tools
		
	
		
			
	
	
		
			135 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
		
		
			
		
	
	
			135 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| 
								 | 
							
								#!/usr/bin/env perl
							 | 
						||
| 
								 | 
							
								#===============================================================================
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#         FILE: query2json
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#        USAGE: ./query2json 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.
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#      OPTIONS: ---
							 | 
						||
| 
								 | 
							
								# REQUIREMENTS: ---
							 | 
						||
| 
								 | 
							
								#         BUGS: ---
							 | 
						||
| 
								 | 
							
								#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
							 | 
						||
| 
								 | 
							
								#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
							 | 
						||
| 
								 | 
							
								#      VERSION: 0.0.2
							 | 
						||
| 
								 | 
							
								#      CREATED: 2021-06-18 13:24:49
							 | 
						||
| 
								 | 
							
								#     REVISION: 2023-01-05 16:17:24
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#===============================================================================
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								use 5.010;
							 | 
						||
| 
								 | 
							
								use strict;
							 | 
						||
| 
								 | 
							
								use warnings;
							 | 
						||
| 
								 | 
							
								use utf8;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								use Config::General;
							 | 
						||
| 
								 | 
							
								use JSON;
							 | 
						||
| 
								 | 
							
								use DBI;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								use Data::Dumper;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Version number (manually incremented)
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								our $VERSION = '0.0.2';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Script and directory names
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								( my $PROG = $0 ) =~ s|.*/||mx;
							 | 
						||
| 
								 | 
							
								( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
							 | 
						||
| 
								 | 
							
								$DIR = '.' unless $DIR;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#-------------------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# Declarations
							 | 
						||
| 
								 | 
							
								#-------------------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Constants and other declarations
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								my $basedir    = "$ENV{HOME}/HPR/Database";
							 | 
						||
| 
								 | 
							
								my $configfile = "$basedir/.hpr_livedb.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();
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#-------------------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# Options and arguments
							 | 
						||
| 
								 | 
							
								#-------------------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								$query = shift;
							 | 
						||
| 
								 | 
							
								die "Usage: $PROG query\n" unless $query;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#-------------------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# 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 = 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
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								$sth1 = $dbh->prepare($query) or die $DBI::errstr;
							 | 
						||
| 
								 | 
							
								if ( $dbh->err ) {
							 | 
						||
| 
								 | 
							
								    warn $dbh->errstr;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Perform the query
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								$sth1->execute;
							 | 
						||
| 
								 | 
							
								if ( $dbh->err ) {
							 | 
						||
| 
								 | 
							
								    warn $dbh->errstr;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Grab everything as an arrayref of hashrefs
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								$result = $sth1->fetchall_arrayref( {} );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Prepare for JSON, forcing object key sorting (expensive)
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								$json = JSON->new->utf8->canonical;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Encode the Perl structure to JSON
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								print $json->encode($result), "\n";
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								exit;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
							 |