asql-1.6/ 0000755 0001750 0001750 00000000000 11452433263 010517 5 ustar skx skx asql-1.6/COMMANDS 0000644 0001750 0001750 00000003712 11452433263 011646 0 ustar skx skx alias
-----
Define a persistent alias, or list those aliases currently defined.
If no arguments are given all current aliases, as loaded from the
alias file are displayed.
Aliases persist by default and may be created by running something
like this:
alias agents SELECT distinct(agent) FROM logs
Once this has been entered the new command 'agents' will run the given
query.
To remove the alias run:
alias agents
alter
-----
Run an ALTER query against the database.
create
------
Run a CREATE query against the database.
delete
------
Run a DELETE query against the database.
drop
----
Run a DROP query against the database.
exit
----
Exit the shell.
help
----
If a command is given then show help about that command.
If no command is specified give an overview of all available commands.
insert
------
Run an INSERT query against the database.
load
----
Load an Apache logfile into the currently open table.
You may either specify a single file, or a glob pattern.
Files with a .gz, or .bz2 suffix will be automtically decompressed and loaded.
To save time parsing the logfile(s) specified you may save the database once
it has been populated via 'save' and 'restore'.
quit
----
Exit this shell.
restore
-------
Load a SQLite database which was previously saved via 'save'.
This immediately makes any previously saved records available, without the need to reload the logile(s).
save
----
Save the temporary SQLite database which was create at startup time.
This means you won't need to wait for the relatively slow logfile parsing
at startup. Use the 'restore' command to reload this database in the future.
select
------
Run a SELECT query against the database.
Example queries
SELECT distinct(source) FROM logs
SELECT referer,COUNT(referer) AS number from logs GROUP BY referer ORDER BY number DESC,referer
etc.
show
----
Show the structure of the database.
update
------
Run an UPDATE query against the database.
asql-1.6/README 0000644 0001750 0001750 00000003001 11452433263 011371 0 ustar skx skx
asql
----
ASQL is a simple tool to allow you to query Apache common logfiles
via SQL. When it starts up it creates a temporary SQLite database
which later you may load Apache logfiles to.
Once you've loaded files you may then query against the temporary
database.
Why might you want to do this? Well it does allow you to make certain
queries very easily.
Aliases
-------
Using the 'alias' command you may record and replay previous
queries by name.
For example the following query will show the number of hits
against your server:
SELECT COUNT(id) FROM logs;
You could save this query via this:
ALIAS hits SELECT COUNT(id) FROM logs;
Now at any future point entering 'hits' would run the query.
(Aliases persist between sessions via the file ~/.asql.aliases.)
Example Queries
---------------
The following examples give an idea of the kind of power an SQL
query allows you:
Greediest downloaders:
SELECT source,SUM(size) AS Number FROM logs GROUP BY source ORDER BY Number DESC, source
A count of each distinct referers:
SELECT referer,COUNT(referer) AS number from logs WHERE referer NOT LIKE '%steve.org.uk%' GROUP BY referer ORDER BY number DESC,referer LIMIT 0,10
See which Debian packages were downloaded the most:
SELECT request,COUNT(request) AS Number FROM logs WHERE request LIKE '%.deb' GROUP BY request ORDER BY Number DESC, request;
See who has downloaded me:
select * FROM logs WHERE request='/etch/pool/main/a/asql/asql_0.6-1_all.deb';
Steve
--
asql-1.6/.version 0000644 0001750 0001750 00000000004 11452433263 012177 0 ustar skx skx 1.6
asql-1.6/.release 0000644 0001750 0001750 00000000653 11452433263 012144 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.6/bin/ 0000755 0001750 0001750 00000000000 11452433263 011267 5 ustar skx skx asql-1.6/bin/make-cmds 0000755 0001750 0001750 00000002421 11452433263 013055 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 < {
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 } )
{
#
# Call ourself to process the line.
#
processLine( $ALIASES{ $word } );
#
# 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);
#
# Get the results, if they are present.
#
my $host = $results->{ 'host' } || "";
my $size = $results->{ 'bytes' } || "";
my $version = $results->{ 'proto' } || "";
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 } = sprintf( "%d-%02d-%02d", $year, $mon, $day );
$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_ip_address = qr/(\d{1,3} \.
\d{1,3} \.
\d{1,3} \.
\d{1,3})/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/^ # 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 # 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";
}
}
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-2020 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.6/Makefile 0000644 0001750 0001750 00000003001 11452433263 012151 0 ustar skx skx #
# Makefile for 'asql'.
#
# Steve
# --
#
#
# Only used to build distribution tarballs.
#
DIST_PREFIX = ${TMP}
VERSION = 1.6
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.6/t/ 0000755 0001750 0001750 00000000000 11452433263 010762 5 ustar skx skx asql-1.6/t/perl-syntax.t 0000644 0001750 0001750 00000002514 11452433263 013437 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.6/t/pod.t 0000644 0001750 0001750 00000000451 11452433263 011731 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.6/t/no-tabs.t 0000644 0001750 0001750 00000003470 11452433263 012516 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.6/t/Makefile 0000644 0001750 0001750 00000000245 11452433263 012423 0 ustar skx skx
all:
@cd ..; prove --shuffle tests/
verbose:
@cd ..; prove --shuffle --verbose tests/
modules: .PHONY
./modules.sh > modules.t
.PHONY:
true
clean:
rm *~
asql-1.6/t/modules.sh 0000755 0001750 0001750 00000001064 11452433263 012772 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 <