asql-1.7/ 0000755 0001750 0001750 00000000000 12024306563 010516 5 ustar skx skx asql-1.7/t/ 0000755 0001750 0001750 00000000000 12024306562 010760 5 ustar skx skx asql-1.7/t/perl-syntax.t 0000644 0001750 0001750 00000002514 12024306562 013435 0 ustar skx skx #!/usr/bin/perl -w
#
# Test that every perl file we have passes the syntax check.
#
# Steve
# --
#
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find all the files beneath the current directory,
# and call 'checkFile' with the name.
#
find( { wanted => \&checkFile, no_chdir => 1 }, '.' );
#
# Check a file.
#
# If this is a perl file then call "perl -c $name", otherwise
# return
#
sub checkFile
{
# The file.
my $file = $File::Find::name;
# We don't care about directories
return if ( ! -f $file );
# `modules.sh` is a false positive.
return if ( $file =~ /modules.sh$/ );
# See if it is a perl file.
my $isPerl = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( )
{
if ( $line =~ /\/usr\/bin\/perl/ )
{
$isPerl = 1;
}
}
close( INPUT );
#
# Return if it wasn't a perl file.
#
return if ( ! $isPerl );
#
# Now run 'perl -c $file' to see if we pass the syntax
# check. We add a couple of parameters to make sure we're
# really OK.
#
# use strict "vars";
# use strict "subs";
#
my $retval = system( "perl -Mstrict=subs -Mstrict=vars -c $file 2>/dev/null >/dev/null" );
is( $retval, 0, "Perl file passes our syntax check: $file" );
}
asql-1.7/t/modules.sh 0000755 0001750 0001750 00000001064 12024306562 012770 0 ustar skx skx #!/bin/sh
#
# Automatically attempt to create a test which ensures all the modules
# used in the code are availabe.
#
# Steve
# --
# http://www.steve.org.uk/
#
#
cat < modules.t
.PHONY:
true
clean:
rm *~
asql-1.7/t/pod.t 0000644 0001750 0001750 00000000451 12024306562 011727 0 ustar skx skx #!/usr/bin/perl -w
#
# Test that the POD we use in our modules is valid.
#
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
#
# Run the test(s).
#
my @poddirs = qw( bin );
all_pod_files_ok( all_pod_files( @poddirs ) );
asql-1.7/t/no-tabs.t 0000644 0001750 0001750 00000003470 12024306562 012514 0 ustar skx skx #!/usr/bin/perl -w
#
# Test that none of our scripts contain any literal TAB characters.
#
# Steve
# --
#
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find all the files beneath the current directory,
# and call 'checkFile' with the name.
#
find( { wanted => \&checkFile, no_chdir => 1 }, '.' );
#
# Check a file.
#
#
sub checkFile
{
# The file.
my $file = $File::Find::name;
# We don't care about directories
return if ( ! -f $file );
# Nor about backup files.
return if ( $file =~ /~$/ );
# Nor about files which start with ./debian/
return if ( $file =~ /^\.\/debian\// );
# See if it is a shell/perl file.
my $isShell = 0;
my $isPerl = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( )
{
if ( ( $line =~ /\/bin\/sh/ ) ||
( $line =~ /\/bin\/bash/ ) )
{
$isShell = 1;
}
if ( $line =~ /\/usr\/bin\/perl/ )
{
$isPerl = 1;
}
}
close( INPUT );
#
# We don't care about files which are neither perl nor shell.
#
if ( $isShell || $isPerl )
{
#
# Count TAB characters
#
my $count = countTabCharacters( $file );
is( $count, 0, "Script has no tab characters: $file" );
}
}
#
# Count and return the number of literal TAB characters contained
# in the specified file.
#
sub countTabCharacters
{
my ( $file ) = (@_);
my $count = 0;
open( FILE, "<", $file )
or die "Cannot open $file - $!";
foreach my $line ( )
{
# We will count multiple tab characters in a single line.
while( $line =~ /(.*)\t(.*)/ )
{
$count += 1;
$line = $1 . $2;
}
}
close( FILE );
return( $count );
}
asql-1.7/.version 0000644 0001750 0001750 00000000004 12024306562 012175 0 ustar skx skx 1.7
asql-1.7/.release 0000644 0001750 0001750 00000000653 12024306562 012142 0 ustar skx skx #
# Configuration file for 'release'.
#
# http://release.repository.steve.org.uk/
#
# Steve
# --
#
#
# Command to run
#
preupload="make release"
#
#
# Pattern for our release tarball.
#
pattern=asql-[0-9].[0-9].tar.gz*
#
# Version number
#
version=.version
#
# Pattern for our GPG-signature.
#
signature=asql-[0-9].[0-9].tar.gz.asc
#
# Upload location.
#
upload=s-steve@www.steve.org.uk:htdocs/Software/asql
asql-1.7/Makefile 0000644 0001750 0001750 00000003001 12024306562 012147 0 ustar skx skx #
# Makefile for 'asql'.
#
# Steve
# --
#
#
# Only used to build distribution tarballs.
#
DIST_PREFIX = ${TMP}
VERSION = 1.7
BASE = asql
stubb:
@echo "Valid targets are"
@echo " "
@echo " clean - Remove temporary files"
@echo " commands - Make our command reference."
@echo " diff - See differences from the remote repository"
@echo " install - Install the scripts into /etc"
@echo " release - Build a tarball"
@echo " update - Update from the repository"
@echo " "
clean:
-find . -name '*~' -delete
-find . -name 'build-stamp' -delete
-rm bin/*.bak
commands:
perl ./bin/make-cmds ./bin/asql > ./COMMANDS
diff:
hg diff 2>/dev/null
install:
mkdir -p ${PREFIX}/usr/bin/
cp bin/asql ${PREFIX}/usr/bin/asql
chmod 755 ${PREFIX}/usr/bin/asql
release: clean commands
rm -rf $(DIST_PREFIX)/$(BASE)-$(VERSION)
rm -f $(DIST_PREFIX)/$(BASE)-$(VERSION).tar.gz
cp -R . $(DIST_PREFIX)/$(BASE)-$(VERSION)
rm -rf $(DIST_PREFIX)/$(BASE)-$(VERSION)/debian
perl -pi -e "s/UNRELEASED/$(VERSION)/g" $(DIST_PREFIX)/$(BASE)-$(VERSION)/bin/asql
rm -rf $(DIST_PREFIX)/$(BASE)-$(VERSION)/.hg*
cd $(DIST_PREFIX) && tar -cvf $(DIST_PREFIX)/$(BASE)-$(VERSION).tar $(BASE)-$(VERSION)/
gzip $(DIST_PREFIX)/$(BASE)-$(VERSION).tar
mv $(DIST_PREFIX)/$(BASE)-$(VERSION).tar.gz .
rm -rf $(DIST_PREFIX)/$(BASE)-$(VERSION)
gpg --armour --detach-sign $(BASE)-$(VERSION).tar.gz
echo $(VERSION) > .version
test:
prove --shuffle t/
test-verbose:
prove --verbose --shuffle t/
update:
hg pull --update 2>/dev/null
asql-1.7/bin/ 0000755 0001750 0001750 00000000000 12024306562 011265 5 ustar skx skx asql-1.7/bin/asql 0000755 0001750 0001750 00000101156 12024306562 012157 0 ustar skx skx #!/usr/bin/perl -w
=head1 NAME
asql - Provide an SQL interface to Apache logfiles.
=cut
=head1 SYNOPSIS
asql [options]
General Options:
--help Show brief help intstructions.
--manual Show more complete help.
--version Show the version of the software.
Scripting Options:
--load Load the named file, or glob.
--execute Execute a single query then exit.
Options:
--file Rather than running as a shell read commands from a named file.
--quiet Don't show the banner at startup.
=cut
=head1 DESCRIPTION
asql provides a simple console interface to allow a user to
query the contents of an Apache logfile via an SQL interface.
The shell features include:
=over 8
=item Persistent alias definitions.
=item Command line completion
=item Command history
=item Simple scriptability
=back
=cut
=head1 INTRODUCTION
The asql shell will create a temporary SQLite database based upon
any number of Apache logfiles. This temporary database may then
be interactively queried using common SQL syntax.
To get started you should load your logfiles into the database:
=for example begin
load /var/log/apache2/acces*
=for example end
(The tool will automatically decompress files which have been
compressed with gzip or bzip2.)
Once you've loaded at least one file you may run queries, for
example:
=for example begin
SELECT source,COUNT(id),SUM(size) AS Number FROM logs GROUP BY source ORDER BY Number DESC, source
=for example end
This example will show the number of requests each distinct IP address has
made, along with the total size of the files they've requested.
As you can see we've selected three columns "source", COUNT(id), and
"SUM(size)". You may see which other columns are available via the
"show" command.
Because parsing the Apache logfile(s) specified might be quite
slow there is the option of dumping the temporary SQLite database
to a known filename with the 'save' command. The analog to the
save command is the 'restore' command, which will read in an
existing SQLite database and allow future queries to be executed
against it.
=cut
=head1 FILES
When the shell starts up it will read and intepret the initialisation
file of ~/.asqlrc if it exists. Any commands present in that file
will be executed prior to the launch of the interactive session.
All aliases will be read and written to the file ~/.asql.aliases.
All interactive history will be written to the file ~/.asql.
=cut
=head1 AUTHOR
Steve
--
http://www.steve.org.uk/
=cut
=head1 LICENSE
Copyright (c) 2007,2008,2009,2010,2011 by Steve Kemp. All rights reserved.
This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.
The LICENSE file contains the full text of the license.
=cut
use strict;
use warnings;
use Data::Dumper;
use DBI;
use English;
use Getopt::Long;
use File::Copy qw/copy/;
use File::Temp qw/tempfile/;
use Pod::Usage;
#
# Release number of this script: set by "make release".
#
my $RELEASE = '1.7';
#
# Holder for values read from the configuration file, and the
# default values.
#
my %CONFIG;
#
# Name of default save database
#
$CONFIG{ 'savedb' } = $ENV{ 'HOME' } . "/.asql.db";
#
# Name of alias filename.
#
$CONFIG{ 'aliases' } = $ENV{ 'HOME' } . "/.asql.aliases";
#
# Name of the RC file.
#
$CONFIG{ 'startup' } = $ENV{ 'HOME' } . "/.asqlrc";
#
# Name of the history file
#
$CONFIG{ 'history' } = $ENV{ 'HOME' } . "/.asql";
#
# Aliases..
#
my %ALIASES;
#
# Dispatch table which contains the mapping between the commands
# we make available and the routine which implements that behaviour.
#
# This table also contains both the long and the short form of each
# commands help text.
#
#
# START_COMMAND_TABLE
#
my %dispatch = (
"alias" => {
sub => \&do_alias,
args => "[name sql...]",
help =>
"Define a persistent alias, or list those aliases currently defined.\n\nIf no arguments are given all current aliases, as loaded from the\nalias file are displayed.\n\nAliases persist by default and may be created by running something\nlike this:\n\n alias agents SELECT distinct(agent) FROM logs\n\nOnce this has been entered the new command 'agents' will run the given\nquery.\n\nTo remove the alias run:\n\n alias agents\n\n",
info => "Define, or view, persistent aliases.",
},
"alter" => {
sub => sub {my ($args) = (@_); do_sql( "alter", $args );},
help => "Run an ALTER query against the database.\n",
info => "Run an ALTER query against the database.",
},
"create" => {
sub => sub {my ($args) = (@_); do_sql( "create", $args );},
help => "Run a CREATE query against the database.\n",
info => "Run a CREATE query against the database.",
},
"delete" => {
sub => sub {my ($args) = (@_); do_sql( "delete", $args );},
help => "Run a DELETE query against the database.\n",
info => "Run a DELETE query against the database.",
},
"drop" => {
sub => sub {my ($args) = (@_); do_sql( "drop", $args );},
help => "Run a DROP query against the database.\n",
info => "Run a DROP query against the database.",
},
"insert" => {
sub => sub {my ($args) = (@_); do_sql( "insert", $args );},
help => "Run an INSERT query against the database.\n",
info => "Run an INSERT query against the database.",
},
"load" => {
sub => \&do_load,
args => "[file|glob] [--label=name",
help =>
"Load an Apache logfile into the currently open table.\n\nYou may either specify a single file, or a glob pattern.\n\nFiles with a .gz, or .bz2 suffix will be automtically decompressed and loaded.\n\nTo save time parsing the logfile(s) specified you may save the database once\nit has been populated via 'save' and 'restore'.",
info => "Load an Apache logfile.",
},
"exit" => { sub => \&do_exit,
help => "Exit the shell.",
info => "Exit the shell.",
},
"help" => {
sub => \&do_help,
args => "[command]",
help =>
"If a command is given then show help about that command.\n\nIf no command is specified give an overview of all available commands.\n",
info => "Show general, or command-specific, help information.",
},
"quit" => # Dupe: exit
{ sub => \&do_exit,
help => "Exit this shell.",
info => "Exit this shell.",
},
"restore" => {
sub => \&do_restore,
args => '[filename]',
help =>
"Load a SQLite database which was previously saved via 'save'.\n\nThis immediately makes any previously saved records available, without the need to reload the logile(s).\n",
info => "Load a previously save'd temporary database.",
},
"save" => {
sub => \&do_save,
args => '[filename]',
help =>
"Save the temporary SQLite database which was create at startup time.\n\nThis means you won't need to wait for the relatively slow logfile parsing\nat startup. Use the 'restore' command to reload this database in the future.",
info => "Save the temporary database.",
},
"select" => {
sub => sub {my ($args) = (@_); do_sql( "select", $args );},
help =>
"Run a SELECT query against the database.\nExample queries\n\n SELECT distinct(source) FROM logs\n\nSELECT referer,COUNT(referer) AS number from logs GROUP BY referer ORDER BY number DESC,referer\n\netc.",
info => "Run a SELECT query against the database.",
},
"show" => { sub => \&do_show,
help => "Show the structure of the database.",
info => "Show the structure of the database.",
},
"update" => {
sub => sub {my ($args) = (@_); do_sql( "update", $args );},
help => "Run an UPDATE query against the database.\n",
info => "Run an UPDATE query against the database.",
},
);
#
# END_COMMAND_TABLE
#
my %months;
$months{ 'jan' } = 1;
$months{ 'feb' } = 2;
$months{ 'mar' } = 3;
$months{ 'apr' } = 4;
$months{ 'may' } = 5;
$months{ 'jun' } = 6;
$months{ 'jul' } = 7;
$months{ 'aug' } = 8;
$months{ 'sep' } = 9;
$months{ 'oct' } = 10;
$months{ 'nov' } = 11;
$months{ 'dec' } = 12;
####
#
# Start of code
#
####
#
# Parse any command line arguments which might be present.
#
# Do this first so that --help, etc, works.
#
parseCommandLineArguments();
#
# Sanity check our perl module availability.
#
sanityCheck();
#
# Load any aliases
#
loadAliases();
#
# Create a temporary database file
#
my ( undef, $DBIFILE ) = File::Temp::tempfile();
#
# Show our banner.
#
showBanner();
#
# Setup a signal handler to make sure we cleanup appropriately,
# specifically so that we save our aliases.
#
$SIG{ INT } = "do_exit";
#
# If the user has a startup-file then load that prior to running
# any interactive/scripted session.
#
if ( -e $CONFIG{ 'startup' } )
{
processFile( $CONFIG{ 'startup' } );
}
#
# Load data?
#
if ( $CONFIG{ 'load' } )
{
do_load( $CONFIG{ 'load' } );
}
#
# Execute directly?
#
if ( $CONFIG{ 'execute' } )
{
processLine( $CONFIG{ 'execute' } );
do_exit();
}
#
# Run the contents of a named file?
#
if ( $CONFIG{ 'file' } )
{
# Run the scripted file, and save our history.
processFile( $CONFIG{ 'file' } );
do_exit();
}
#
# OK interactive usage.
#
# Create the readline interface, and save the attributes away
# so that we may use them in our command completion code.
#
my $term = createTerminal();
my $attribs = $term->Attribs;
#
# Load any command history which might be present.
#
loadHistory($term);
# NOTE: this never returns.
#
runMainLoop($term);
#
# Never reached
#
exit;
=begin doc
Parse any command line options which might be present.
=end doc
=cut
sub parseCommandLineArguments
{
my $SHOW_HELP = 0;
my $SHOW_MANUAL = 0;
my $SHOW_VERSION = 0;
#
# Parse options.
#
exit
if (
!GetOptions( "help", \$SHOW_HELP,
"manual", \$SHOW_MANUAL,
"version", \$SHOW_VERSION,
"file=s", \$CONFIG{ 'file' },
"load=s", \$CONFIG{ 'load' },
"execute=s", \$CONFIG{ 'execute' },
"quiet", \$CONFIG{ 'quiet' },
) );
pod2usage(1) if $SHOW_HELP;
pod2usage( -verbose => 2 ) if $SHOW_MANUAL;
if ($SHOW_VERSION)
{
print "asql v$RELEASE\n";
exit;
}
}
=begin doc
Sanity check that we can load the Perl modules we require.
=end doc
=cut
sub sanityCheck
{
#
# Test we have the perl modules we need.
#
BEGIN
{
eval {
require Term::ReadLine;
require Term::ReadLine::Gnu;
};
}
if ($@)
{
print "Package 'Term::ReadLine::Gnu' not installed.\n";
print "Aborting\n";
sleep 5;
exit;
}
}
=begin doc
Load any persistent aliases which might be present.
=end doc
=cut
sub loadAliases
{
# no file == no aliases
return if ( !-e $CONFIG{ 'aliases' } );
# read the file into this buffer.
my $aliases = '';
open( INPUT, "<", $CONFIG{ 'aliases' } ) or
die "Failed to read aliases file $CONFIG{'aliases'} : $!";
foreach my $line ()
{
$aliases .= $line if ( defined($line) );
}
close(INPUT);
#
# Evaluate and store any aliases
#
my $VAR1 = undef;
my $f = eval($aliases);
%ALIASES = %$f if ($f);
}
=begin doc
Dump out any saved aliases.
=end doc
=cut
sub saveAliases
{
open( INPUT, ">", $CONFIG{ 'aliases' } ) or
die "Failed to write aliases file $CONFIG{'aliases'} : $!";
print INPUT Dumper( \%ALIASES );
close(INPUT);
}
=begin doc
This routine is the core of the shell, it should parse evaluate
and display the result(s) of the specified query.
=end doc
=cut
sub runQuery
{
my ($sql) = (@_);
#
# Make sure we have a database handle
#
my $dbh = $CONFIG{ 'dbi' };
if ( !$dbh || !$dbh->ping() )
{
print "Database handle closed - trying to reopen!\n";
$dbh = DBI->connect_cached( "dbi:SQLite:dbname=$DBIFILE", "", "",
{ AutoCommit => 1 } );
if ( !$dbh )
{
print "Failed\n";
return;
}
else
{
print "Re-connected\n";
$CONFIG{ 'dbi' } = $dbh;
}
}
#
# Prepare the statement
#
my $sth = $dbh->prepare($sql);
if ($sth)
{
#
# Execute it and show the results.
#
$sth->execute();
print "@$_\n" while $_ = $sth->fetchrow_arrayref();
$sth->finish();
print "\n";
}
else
{
#
# Failed to compile - the user will already see
# an error, but we'll reiterate it.
#
print "Failed to compile SQL\n";
}
}
=begin doc
Show the startup banner for the shell.
=end doc
=cut
sub showBanner
{
return if ( ( $CONFIG{ 'quiet' } ) ||
( $CONFIG{ 'execute' } ) );
print "asql v$RELEASE - type 'help' for help.\n";
}
=begin doc
Create the terminal interface, complete with command completion.
Rather than hard-wiring the commands which are available we take them
from our global dispatch table.
=end doc
=cut
sub createTerminal
{
my $term = new Term::ReadLine 'asql';
#
# Process our dispatch table to determine which commands
# are available.
#
my @cmds = ();
#
# Add all commands.
#
push @cmds, ( keys %dispatch );
push @cmds, ( keys %ALIASES );
#
# Add completion
#
my $attribs = $term->Attribs;
$attribs->{ completion_entry_function } =
$attribs->{ list_completion_function };
$attribs->{ completion_word } = \@cmds;
$attribs->{ attempted_completion_function } = \&completion;
#
# Return it
#
return ($term);
}
=begin doc
Here we perform filename completion for the second arg - if the first
argument is "load" or "restore".
If not we complete based upon our command names, and any loaded aliases.
=end doc
=cut
sub completion
{
my ( $text, $line, $start, $end ) = @_;
if ( ( substr( $line, 0, $start ) =~ /^load([ \t]+)$/i ) ||
( substr( $line, 0, $start ) =~ /^restore([ \t]+)$/i ) )
{
return
$term->completion_matches( $text,
$attribs->{ 'filename_completion_function' } );
}
else
{
return ( grep( /\Q^$text/, keys %dispatch, keys %ALIASES ) );
}
}
=begin doc
If the user has a history present in ~/.asql load it up.
=end doc
=cut
sub loadHistory
{
my ($term) = (@_);
#
# Load the file, if it exists, from the home directory.
#
my $file = $CONFIG{ 'history' };
if ( -e $file )
{
#
# Load the history if we can.
#
if ( UNIVERSAL::can( $term, 'ReadHistory' ) )
{
$term->ReadHistory($file);
}
}
}
=begin doc
Read and intepret the contents of the given file, if it exists.
=end doc
=cut
sub processFile
{
my ($file) = (@_);
if ( !-e $file )
{
print "File not found: $file\n";
return;
}
open( INPUTFILE, "<", $file ) or
die "Failed to open $file - $!";
while ( my $line = )
{
chomp($line);
processLine($line) if ( defined($line) && length($line) );
}
close(INPUTFILE);
}
=begin doc
Run the input reading + dispatching loop. We use the dispatch
table already defined to handle input.
Parsing of command line input is extremely minimal - we break the
input line into "word" which is the first whitespace deliminated
token on the line and "args" which is the remainder of the line.
This is sufficient for our purposes.
=end doc
=cut
sub runMainLoop
{
my ($term) = (@_);
#
# Prompt
#
my $prompt = "asql> ";
#
# Command loop.
#
while ( defined( my $line = $term->readline($prompt) ) )
{
# Ignore empty lines.
next if ( !length($line) );
# Strip leading and trailing whitespace.
$line =~ s/^\s+//;
$line =~ s/\s+$//;
# The line is empty now?
next if ( !length($line) );
# actually process the input
processLine($line);
}
#
# Save history on exit.
#
do_exit();
}
=begin doc
Process a single line which has been read from the console, or from
a script file.
=end doc
=cut
sub processLine
{
my ($line) = (@_);
# strip trailing space & ";" characters.
$line =~ s/([ \t;]+)$//g;
# If we have arguments then split them up.
my ( $word, @args ) = split( /[ \t]/, $line );
# make sure we did receive a command
return if ( !$word );
# Lookup command in our dispatch table.
my $cmd = $dispatch{ lc($word) };
if ($cmd)
{
# Call the function with any arguments we might have.
$cmd->{ 'sub' }->( join( " ", @args ) );
# Add a successful line to our history, if we can.
if ( UNIVERSAL::can( $term, 'add_history' ) )
{
$term->add_history($line);
}
}
else
{
#
# Catch any alias definitions we might have present.
#
if ( $ALIASES{ $word } )
{
#
# OK we have an expansion
#
my $cmd = $ALIASES{ $word };
while ( $cmd =~ /(.*)\$([0-9]+)(.*)/ )
{
my $pre = $1;
my $subst = $2;
my $post = $3;
if ( (@args) && $args[$subst - 1] )
{
$subst = $args[$subst - 1];
}
$cmd = $pre . $subst . $post;
}
#
# Call ourself to process the line.
#
processLine($cmd);
#
# Add a successful line to our history, if we can.
#
if ( UNIVERSAL::can( $term, 'add_history' ) )
{
$term->add_history($line);
}
}
else
{
if ( defined($word) && length($word) )
{
print "Unknown command: '$word' - type 'help' for help.\n";
}
}
}
}
=begin doc
Show, or define a new alias
=end doc
=cut
sub do_alias
{
my ($line) = (@_);
if ( !defined($line) || !length($line) )
{
my $count = 0;
foreach my $name ( keys %ALIASES )
{
print "ALIAS $name $ALIASES{$name}\n";
$count += 1;
}
print "No aliases are currently defined.\n" unless ($count);
return;
}
#
# Define a new one
#
my ( $name, @rest ) = split( / /, $line );
my $value = join( " ", @rest );
print "ALIAS $name $value\n";
#
# Delete the current alias of that name, if it exists.
#
delete $ALIASES{ $name };
$ALIASES{ $name } = $value if ( defined($value) && ( length($value) ) );
}
=begin doc
Exit this shell, first saving any command history.
=end doc
=cut
sub do_exit
{
#
# The history file
#
my $file = $CONFIG{ 'history' };
#
# Save the history if the term module can.
#
if ( UNIVERSAL::can( $term, 'WriteHistory' ) )
{
$term->WriteHistory($file);
}
#
# Disconnect from the database
#
if ( $CONFIG{ 'dbi' } &&
$CONFIG{ 'dbi' }->ping() )
{
$CONFIG{ 'dbi' }->disconnect();
}
#
# Remove it
#
unlink($DBIFILE) if ( defined($DBIFILE) && ( -e $DBIFILE ) );
#
# Save any aliases
#
saveAliases();
exit;
}
=begin doc
Show the user some help.
When called with no arguments it will display all supported commands.
If called with arguments then they we will show only help for the
specified command(s).
=end doc
=cut
sub do_help
{
my ($term) = (@_);
#
# Help on a single command
#
if ( ( defined($term) ) && ( length($term) ) )
{
foreach my $cmd ( split( /[ \t]/, $term ) )
{
# Lookup command in our dispatch table.
my $c = $dispatch{ lc($cmd) };
if ($c)
{
# arguments for the command?
my $args = $c->{ 'args' } || '';
print "\nCommand: $cmd $args\n\n";
print $c->{ 'help' } . "\n";
}
else
{
print "Unknown command '$cmd' - no help text available\n";
}
}
return;
}
print "asql v$RELEASE\n";
print "The following commands are available within this shell:\n\n";
#
# Build up the short-help, indented it nicely.
#
foreach my $entry ( sort keys %dispatch )
{
my $hash = $dispatch{ $entry };
print sprintf( "%10s - %s\n", $entry, $hash->{ 'info' } );
}
#
# Footer.
#
print "\nFor command-specific help run \"help command\".\n\n";
}
=begin doc
Load the specified files into our tables.
=end doc
=cut
sub do_load
{
my (@files) = (@_);
#
# Create the tables if we've not already done so.
#
if ( !$CONFIG{ 'loaded' } )
{
#
# create a database handle
#
$CONFIG{ 'dbi' } =
DBI->connect_cached( "dbi:SQLite:dbname=$DBIFILE", "", "",
{ AutoCommit => 1 } );
#
# Delete the table if it already exists.
#
eval {
local $CONFIG{ 'dbi' }->{ PrintError } = 0;
$CONFIG{ 'dbi' }->do("DROP TABLE logs");
};
$CONFIG{ 'dbi' }->do(
"CREATE TABLE logs (id INTEGER PRIMARY KEY, source, request, status integer, size integer, method, referer, agent, version integer, date, user, label);"
);
$CONFIG{ 'loaded' } = 1;
}
#
# Did we get a label?
#
my $label = '';
my @FILES;
foreach my $arg (@files)
{
if ( $arg =~ /(.*)([ \t]+)--label=(.*)/ )
{
$arg = $1;
$label = $3;
}
push( @FILES, $arg );
}
#
# Now load each file.
#
foreach my $file (@FILES)
{
# skip arguments
next if ( $file =~ /^--/ );
# file exists - load it.
if ( -e $file )
{
loadFile( $file, $label );
}
else
{
# could be a glob?
foreach my $f ( glob($file) )
{
if ( -e $f )
{
loadFile( $f, $label );
}
else
{
# not found
print "Ignoring file which doesn't exist: $file\n";
}
}
}
}
}
=begin doc
reconnect to a named databae.
=end doc
=cut
sub do_restore
{
my ($file) = (@_);
$file = $CONFIG{ 'savedb' }
if ( ( !defined($file) ) || ( !length($file) ) );
if ( !-e $file )
{
print "The restore file dosen't exist: $file\n";
return;
}
#
# Disconnect
#
if ( $CONFIG{ 'dbi' } &&
$CONFIG{ 'dbi' }->ping() )
{
$CONFIG{ 'dbi' }->disconnect();
}
#
# Re-connect
#
$CONFIG{ 'dbi' } = DBI->connect_cached( "dbi:SQLite:dbname=$file", "", "",
{ AutoCommit => 1 } );
#
# fake a load - so that we may seleect.
#
$CONFIG{ 'loaded' } += 1;
}
=begin doc
Save the current temporary SQLite database to a file
=end doc
=cut
sub do_save
{
my ($file) = (@_);
$file = $CONFIG{ 'savedb' }
if ( ( !defined($file) ) || ( !length($file) ) );
print "Saving to : $file\n";
#
# Disconnect
#
if ( $CONFIG{ 'dbi' } &&
$CONFIG{ 'dbi' }->ping() )
{
$CONFIG{ 'dbi' }->disconnect();
}
#
# Copy the file
#
File::Copy::copy( $DBIFILE, $file );
#
# Reconnect
#
$CONFIG{ 'dbi' } =
DBI->connect_cached( "dbi:SQLite:dbname=$DBIFILE", "", "",
{ AutoCommit => 1 } );
}
=begin doc
This routine is called to invoke an SQL operation, the first argument
is an SQL keyword, the additional arguments are the rest of the query.
See the dispatch table for details of the different primary SQL commands
we accept.
=end doc
=cut
sub do_sql
{
my ( $command, $query ) = (@_);
#
# Make sure we received a query
#
if ( !length($query) )
{
print "Missing arguments\n";
return;
}
#
# Make sure we've loaded at least one file.
#
if ( !$CONFIG{ 'loaded' } )
{
print "No files loaded yet!\n";
return;
}
runQuery( $command . " " . $query );
}
=begin doc
Show the structure of our table.
=end doc
=cut
sub do_show
{
print <begin_work() or die "Failed to begin transaction: " . $DBI::errstr;
#
# Prepare the insertion statement.
#
my $sth = $dbh->prepare(
"INSERT INTO logs( source, request, status, size, method, referer, agent, version, date, user, label ) VALUES( ?,?,?,?,?,?,?,?,?,?,? )"
);
#
# Open the named logfile, using a pipe for .bz2/.gz files.
#
if ( $filename =~ /gz$/i )
{
#
# Will fail if there is no zcat installed.
#
open( INPUT, "zcat $filename|" ) or
die "Cannot read piped file - $filename : $! ";
}
elsif ( $filename =~ /bz2$/i )
{
#
# Will fail if there is no bzcat installed.
#
open( INPUT, "bzcat $filename|" ) or
die "Cannot read piped file - $filename : $! ";
}
else
{
# Open file normally.
open( INPUT, "<", $filename ) or
die "Cannot open file - $filename : $!";
}
#
# Cache of parsed dates + times.
#
my %cache;
#
# Parse each line in a minimal fashion.
#
foreach my $line ()
{
#
# Parse.
#
my $results = parseApacheLogLine($line);
#
# Warn on parse-failure if we're being verbose.
#
if ( $CONFIG{ 'verbose' } && !defined($results) )
{
print "WARNING: Failed to parse line\n";
}
#
# Skip insertion of a new row if we failed to parse.
#
next if ( !$results );
#
# Get the results, if they are present.
#
my $host = $results->{ 'host' } || "";
my $size = $results->{ 'bytes' } || "";
my $version = $results->{ 'version' } || "";
my $time = $results->{ 'time' } || "";
my $date = $results->{ 'date' } || "";
my $path = $results->{ 'file' } || "";
my $protocol = $results->{ 'rtype' } || "";
my $agent = $results->{ 'agent' } || "";
my $user = $results->{ 'user' } || "";
my $refer = $results->{ 'refer' } || "";
my $code = $results->{ 'code' } || "";
if ( $date =~ /^([^\/]+)\/([^\/]+)\/(.*)/ )
{
#
# If cached then use that value..
#
if ( $cache{ $date } )
{
$date = $cache{ $date };
}
else
{
#
# Otherwise we'll convert manually.
#
my $day = $1;
my $mon = $2;
my $year = $3;
$mon = $months{ lc($mon) };
#
# Update cache - and use it.
#
$cache{ $date } =
$year . "-" .
substr( "0" . $mon, -2 ) . "-" .
substr( "0" . $day, -2 );
$date = $cache{ $date };
}
$date = $date . 'T' . $time;
}
#
# HTTP version is of the form HTTP/N.N
#
$version = $1 if ( $version =~ /HTTP\/([0-9\.]+)/ );
#
# Insert row.
#
$sth->execute( $host, $path, $code, $size,
$protocol, $refer, $agent, $version,
$date, $user, $label
);
}
#
# All done
#
close(INPUT);
$sth->finish();
$dbh->commit() or die $DBI::errstr;
}
=begin doc
Parse a single line of Apache logfile into a hash-reference
we can work with.
=end doc
=cut
sub parseApacheLogLine
{
my ($line) = (@_);
my $pat_ipv4_address = qr/\d{1,3} \.
\d{1,3} \.
\d{1,3} \.
\d{1,3}/x;
#
# Regexp for finding IP address - this should cope with IPv4 & IPv6.
#
my $pat_ip_address;
#
# See if M is available, and use it if so.
#
my $module = "use Regexp::IPv6;";
eval($module);
if ($@)
{
#
# Error loading module - use IPv4 only.
#
$pat_ip_address = qr/($pat_ipv4_address)/x;
}
else
{
#
# Both available
#
$pat_ip_address = qr/($pat_ipv4_address | $Regexp::IPv6::IPv6_re)/x;
}
my $pat_quoted_field = qr/"((?:(?:(?:(?: # It can be...
[^"\\])* | # ...zero or more characters not quote or backslash...
(?:\\x[0-9a-fA-F][0-9a-fA-F])* | # ...a backslash quoted hexadecimal character...
(?:\\.*) # ...or a backslash escape.
))*))"/x;
my $parse_combined = qr/^ \s* # Start at the beginning
$pat_ip_address \s+ # IP address
(\S+) \s+ # Ident
(\S+) \s+ # Userid
\[([^\]]*)\] \s+ # Date and time
$pat_quoted_field \s+ # Request
(\d+) \s+ # Status
(\-|[\d]+) \s+ # Length of reply or "-"
$pat_quoted_field \s+ # Referer
$pat_quoted_field \s* # User agent
$ # End at the end
/x;
my $ref;
#
# Parse. Ahem.
#
if ( $line =~ /$parse_combined/ )
{
$ref->{ 'host' } = $1;
$ref->{ 'ident' } = $2;
$ref->{ 'user' } = $3;
$ref->{ 'date' } = $4;
$ref->{ 'file' } = $5;
$ref->{ 'code' } = $6;
$ref->{ 'bytes' } = $7;
$ref->{ 'agent' } = $9;
$ref->{ 'refer' } = $8;
my @Dsplit = split( /\s+/, $ref->{ date } );
$ref->{ diffgmt } = $Dsplit[1];
my @Ds2 = split( /\:/, $Dsplit[0], 2 );
$ref->{ date } = $Ds2[0];
$ref->{ time } = $Ds2[1];
if ( $ref->{ 'file' } =~ /^([A-Z]+) (.*) HTTP\/([0-9.]+)$/ )
{
$ref->{ 'method' } = $1;
$ref->{ 'file' } = $2;
$ref->{ 'version' } = $3;
}
else
{
$ref->{ 'method' } = "UNKNOWN";
$ref->{ 'version' } = "0.0";
}
}
else
{
# failed to parse...
return undef;
}
return $ref;
}
#
# Print a newline or two on termination, just to make things prettier.
#
END
{
print "\n\n" unless ( $CONFIG{ 'execute' } );
}
=head1 AUTHOR
Steve
--
http://www.steve.org.uk/
=cut
=head1 LICENSE
Copyright (c) 2007-2011 by Steve Kemp. All rights reserved.
This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.
The LICENSE file contains the full text of the license.
=cut
asql-1.7/bin/make-cmds 0000755 0001750 0001750 00000002421 12024306562 013053 0 ustar skx skx #!/usr/bin/perl
#
# This is a quick hack which will read the specified asql file and
# output a complete list of all commands to STDOUT.
#
# It is designed to create the documentation for the shell automatically.
#
# Steve
# --
#
#
# We are called with a single argument - the path to 'asql'.
#
my $file = shift;
die "No file" unless ( defined($file) );
die "File not found - $file" unless ( -e $file );
#
# Read the text
#
my $text = '';
my $in = 0;
open( INPUT, "<", $file ) or
die "Failed to open $file -$!";
foreach my $line ()
{
next if ( !$line );
chomp($line);
next if ( !$line );
if ($in)
{
if ( $line =~ /END_COMMAND_TABLE/ )
{
$in = 0;
}
else
{
$text .= $line . "\n";
}
}
else
{
if ( $line =~ /START_COMMAND_TABLE/ )
{
$in = 1;
}
}
}
close(INPUT);
#
# Hack: declare our own dispatch table and make the read text
# refer to it.
#
my %dispatch;
$text =~ s/my \%dispatch/\%dispatch/g;
eval $text;
#
# Now output the text.
#
foreach my $key ( sort keys %dispatch )
{
my $cmd = $key;
my $under = "-" x length($key);
my $text = $dispatch{ $key }->{ 'help' };
print <