Add gruntmaster-opener

diff --git a/MANIFEST b/MANIFEST
index 0d3b2f2da93d7e130d4b64ce41de519bba5e941b..6a285eb7668df3ef44f387aa6c657c2cdd3aefe8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,6 +1,7 @@
 Changes
 db.sql
 gm
+gruntmaster-opener
 lib/Gruntmaster/App.pm
 lib/Gruntmaster/App/Command/Add.pm
 lib/Gruntmaster/App/Command/Get.pm
@@ -10,6 +11,7 @@ lib/Gruntmaster/App/Command/Rm.pm
 lib/Gruntmaster/App/Command/Set.pm
 lib/Gruntmaster/App/Command/Show.pm
 lib/Gruntmaster/Data.pm
+lib/Gruntmaster/Opener.pm
 Makefile.PL
 make_test_db.sh
 MANIFEST
@@ -17,6 +19,7 @@ README
 testdata.sql
 t/00-compile.t
 t/Gruntmaster-Data.t
+t/Gruntmaster-Opener.t
 t/tools.t
 t/perlcritic.t
 t/perlcriticrc

diff --git a/gruntmaster-opener b/gruntmaster-opener
new file mode 100755 (executable)
index 0000000..723a77b
--- /dev/null
+++ b/gruntmaster-opener
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use 5.014;
+use warnings;
+
+use Gruntmaster::Data;
+use Gruntmaster::Opener;
+
+dbinit $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:';
+handle_line $_ while <>;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+gruntmaster-opener - Populate opens table from NCSA access logs
+
+=head1 SYNOPSIS
+
+  gruntmaster-opener /var/log/apache2/access.log
+  varnishncsa | gruntmaster-opener
+
+=head1 DESCRIPTION
+
+gruntmaster-opener reads a NCSA access log supplied via arguments or
+(if there are no arguments) stdin, finds lines that represent
+successful requests to problems during contests, extracts data from
+them and inserts it into the database.
+
+=head1 SEE ALSO
+
+L<Gruntmaster::Opener>
+
+=head1 AUTHOR
+
+Marius Gavrilescu E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2015 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.18.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut

diff --git a/lib/Gruntmaster/Opener.pm b/lib/Gruntmaster/Opener.pm
new file mode 100644 (file)
index 0000000..d55b767
--- /dev/null
+++ b/lib/Gruntmaster/Opener.pm
@@ -0,0 +1,110 @@
+package Gruntmaster::Opener;
+use 5.014;
+use warnings;
+
+use parent qw/Exporter/;
+use re '/s';
+
+our @EXPORT = qw/handle_line/;
+our @EXPORT_OK = @EXPORT;
+our $VERSION = '5999.000_013';
+
+use Date::Parse qw/str2time/;
+use Gruntmaster::Data;
+
+sub _analyze_request {
+       s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for @_; # From URI::Escape POD
+       my ($req, $parms) = @_;
+       return unless $parms =~ /contest=(\w+)/;
+       my $ct = $1;
+       return $req =~ m,/pb/(\w+), ? ($1, $ct) : ();
+}
+
+sub handle_line {
+       my ($owner, $datetime, $request, $parms) = $_[0] =~
+         /(\w+)\s       # user
+          \[([^]]+)\]\s # date
+          "\w+\s        # request method
+          ([^" ?]+)     # URL (without query string)
+          [?]
+          ([^" ]+)\s    # query string
+          [^"]+"\s      # HTTP version
+          2             # response code starts with 2
+         /x or return;
+       my ($pb, $ct) = _analyze_request $request, $parms or return;
+       my $time = str2time $datetime;
+       open_problem $ct, $pb, $owner, $time;
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Gruntmaster::Opener - Populate opens table from NCSA access logs
+
+=head1 SYNOPSIS
+
+  use Gruntmaster::Opener;
+
+  open my $fh, '<', '/var/log/apache2/access.log';
+  handle_line $_ while <$fh>;
+
+=head1 DESCRIPTION
+
+Gruntmaster::Opener is the backend of the L<gruntmaster-opener> script
+that reads NCSA-style access logs, finds lines that represent
+successful requests to problems during contests, extracts data from
+them and inserts it into the database.
+
+B<handle_line>($line)
+
+The only function in this module. Exported by default. Takes a single
+parameter, a line from a logfile in NCSA common/combined format.
+
+If the request described in the given line:
+
+=over
+
+=item *
+
+Is successful (response code is 2xx)
+
+=item *
+
+Targets a problem (C</pb/something>)
+
+=item *
+
+Has a query parameter named C<contest>
+
+=item *
+
+Happened during the contest named in the C<contest> query parameter
+(this restriction is enforced by the B<open_problem> function).
+
+=back
+
+an entry is added to the C<opens> table, using the B<open_problem>
+function from L<Gruntmaster::Data>.
+
+=head1 SEE ALSO
+
+L<gruntmaster-opener>
+
+=head1 AUTHOR
+
+Marius Gavrilescu E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2014 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.18.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut

diff --git a/t/00-compile.t b/t/00-compile.t
index 3772699ed76728e7527e6e3e9287879b3f18e6ba..18ad507d283b73618e86e586107c6a3f7f474617 100644 (file)
--- a/t/00-compile.t
+++ b/t/00-compile.t
@@ -2,6 +2,7 @@
 use v5.14;
 use warnings;
 
-use Test::More tests => 1;
+use Test::More tests => 2;
 
 BEGIN { use_ok('Gruntmaster::Data') };
+BEGIN { use_ok('Gruntmaster::Opener') };

diff --git a/t/Gruntmaster-Opener.t b/t/Gruntmaster-Opener.t
new file mode 100644 (file)
index 0000000..403ed97
--- /dev/null
+++ b/t/Gruntmaster-Opener.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use v5.14;
+use warnings;
+
+use Test::More tests => 8;
+use Gruntmaster::Opener;
+
+my $opened;
+BEGIN {
+       no warnings 'redefine';
+       *Gruntmaster::Opener::open_problem = sub { $opened = 1 };
+}
+
+sub _test {
+       my ($line, $should_open, $name) = @_;
+       $line =~ s,DATE,[01/Jan/2015:00:00:00 +0200],;
+       $opened = '';
+       handle_line $line;
+       is $opened, $should_open, $name
+}
+
+_test '192.0.2.41 - mgv DATE "GET /pb/problem1?contest=test HTTP/1.1" 200 1234', 1, 'normal case';
+_test '192.0.2.41 - mgv DATE "HEAD http://gruntmaster.example.org/pb/problem1?contest=test HTTP/1.0" 200 1234', 1, 'absolute url';
+_test '2001:db8:abcd::1234 - mgv DATE "GET /pb/%61%62%63%64?%63ontes%74=%62%61%64 SPDY/3" 200 1234', 1, 'superfluous percent encoding';
+
+_test '192.0.2.41 - mgv DATE "GET /pb/problem1?contest=test HTTP/1.1" 500 1234', '', 'internal server error';
+_test '192.0.2.41 - - DATE "GET /pb/problem1?contest=test HTTP/1.1" 401 1234', '', 'not logged in';
+_test '192.0.2.41 - mgv DATE "GET /pb/?contest=test HTTP/1.0" 200 1234', '', 'problem list';
+_test '2001:db8:abcd::1234 - mgv DATE "GET /pb/asd SPDY/3" 200 1234', '', 'not in contest';
+_test 'junk', '', 'junk';

diff --git a/t/perlcriticrc b/t/perlcriticrc
index c80009ca5225797b8507f23ae636910ff702e662..eea00bdbe1d16cc151dd515ff3a39bdc5c207a8a 100644 (file)
--- a/t/perlcriticrc
+++ b/t/perlcriticrc
@@ -7,19 +7,25 @@ severity = 1
 [-Documentation::PodSpelling]
 [-Documentation::RequirePodLinksIncludeText]
 [-InputOutput::RequireBracedFileHandleWithPrint]
+[-Modules::ProhibitAutomaticExportation]
 [-Modules::RequireExplicitPackage]
 [-References::ProhibitDoubleSigils]
 [-RegularExpressions::ProhibitEnumeratedClasses]
+[-RegularExpressions::ProhibitUnusualDelimiters]
 [-RegularExpressions::RequireLineBoundaryMatching]
 [-Subroutines::RequireFinalReturn]
 [-ValuesAndExpressions::ProhibitConstantPragma]
 [-ValuesAndExpressions::ProhibitEmptyQuotes]
+[-ValuesAndExpressions::ProhibitLeadingZeros]
 [-ValuesAndExpressions::ProhibitMagicNumbers]
 [-ValuesAndExpressions::ProhibitNoisyQuotes]
 [-Variables::ProhibitLocalVars]
 [-Variables::ProhibitPackageVars]
 [-Variables::ProhibitPunctuationVars]
 
+[BuiltinFunctions::ProhibitStringyEval]
+allow_includes = 1
+
 [RegularExpressions::RequireExtendedFormatting]
 minimum_regex_length_to_complain_about = 20