diff options
| -rwxr-xr-x | bin/spamcat | 65 | ||||
| -rw-r--r-- | lib/SpamCat.pm | 29 | ||||
| -rw-r--r-- | t/bin.t | 14 | ||||
| -rwxr-xr-x | t/delivert | 2 | ||||
| -rw-r--r-- | t/lib.t | 15 |
5 files changed, 90 insertions, 35 deletions
diff --git a/bin/spamcat b/bin/spamcat index 2986382..fd37f76 100755 --- a/bin/spamcat +++ b/bin/spamcat @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env perl =head1 NAME @@ -6,27 +6,33 @@ spamcat - Filter spam by number of messages sent. =head1 SYNOPSIS -spamcat [options] +spamcat [--help] [-c config-file] [dumpconfig|dump] + +=head1 DESCRIPTION + +B<spamcat> allows you to have disposable email addresses. + +=head1 OPTIONS =over 8 -=item B<--help> +=item --help Print a brief help message and exit. -=item B<-c> C<file> +=item -c C<file> Load configuration from C<file> -=item B<--dumpconfig> +=item dumpconfig Dump the current configuration. -=back +=item dump -=head1 DESCRIPTION +Dumps the spamcat database in tab-delimited format. -B<spamcat> allows you to have disposable email addresses. +=back =head1 AUTHOR @@ -47,26 +53,39 @@ use warnings; my $DEFAULT_CONFIGFILE = '/usr/local/etc/spamcat.conf'; -my ($help, $configfile, $dumpconfig); +my ($help, $configfile); GetOptions('help|h' => \$help, - 'c=s' => \$configfile, - 'dumpconfig' => \$dumpconfig) || pod2usage(2); + 'c=s' => \$configfile) || pod2usage(2); pod2usage(1) if $help; $configfile = $configfile || $DEFAULT_CONFIGFILE; my %conf = SpamCat::Conf::read($configfile); -if ($dumpconfig) { - foreach my $k (keys %conf) { - my $v = $conf{$k}; - if ($k eq 'domains') { - $v = join ', ', @{$v}; +my $sch = SpamCat->new(%conf) || + die "Couldn't start spamcat: $!\n"; +if ($#ARGV >= 0) { + my $cmd = shift @ARGV; + if ($cmd eq 'dump') { + my @keys = qw(sender count created modified); + print join("\t", @keys) . "\n"; + foreach my $row (@{$sch->get_table}) { + my @vals; + foreach my $k (@keys) { + push @vals, $row->{$k}; + } + print join("\t", @vals) . "\n"; + } + } elsif ($cmd eq 'dumpconfig') { + foreach my $k (keys %conf) { + my $v = $conf{$k}; + if ($k eq 'domains') { + $v = join ', ', @{$v}; + } + print uc($k) . " = " . $v . "\n"; + } + } else { + pod2usage(1); } - print uc($k) . " = " . $v . "\n"; - } - exit; +} else { + $sch->deliver; } - -my $sch = SpamCat->new(%conf) || - die "Couldn't start spamcat: $!\n"; -$sch->deliver; diff --git a/lib/SpamCat.pm b/lib/SpamCat.pm index 5c6db51..d470520 100644 --- a/lib/SpamCat.pm +++ b/lib/SpamCat.pm @@ -75,6 +75,12 @@ sub parse_to { } @tovals; } +sub get_table { + my ($self) = @_; + + $self->in_transaction(sub { $self->get_table_t() }); +} + sub get_count { my ($self, $sender) = @_; @@ -97,6 +103,26 @@ sub decrement_count { # The _t functions are meant to be run inside transacitons. # +sub get_table_t { + my ($self) = @_; + + my @rows; + my $q = 'SELECT * FROM emails'; + my $sth = $self->{dbh}->prepare($q); + $sth->execute(); + while (my $row = $sth->fetchrow_hashref) { + push @rows, $row + } + if ($sth->err) { + $sth->finish; + carp $sth->errstr; + return; + } + $sth->finish; + + \@rows; +} + sub get_count_t { my ($self, $sender) = @_; @@ -154,8 +180,7 @@ sub in_transaction { my $rc = eval { &$sub($self); }; if ($@) { $self->{dbh}->rollback; - warn "ERROR: Transaction failed: $@\n"; - exit 1; + carp "Transaction failed: $@\n"; } else { $self->{dbh}->commit; } @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env perl use Test::More tests => 1; @@ -7,14 +7,12 @@ use IO::File; use strict; use warnings; -system "/usr/bin/env > /tmp/fpp"; - my $spamcat = 'bin/spamcat'; my $conffile = 't/fixtures/sample.conf'; # Add testlib which has createdb and possibly population of said db. -my @dumpconfig = `$spamcat -c t/fixtures/sample.conf --dumpconfig`; +my @dumpconfig = `$spamcat -c t/fixtures/sample.conf dumpconfig`; my %got = parse_configdump(@dumpconfig); my %expected = (DBPATH => '/tmp/spamcat.sqlite3', DEFAULT_COUNT => 10, @@ -22,10 +20,10 @@ my %expected = (DBPATH => '/tmp/spamcat.sqlite3', DOMAINS => "spamcat.example.com, spamcat2.example.com, spamcat3"); is_deeply(\%got, \%expected); -# Test for proper delivery. -my $fh = IO::File->new("|$spamcat -c $conffile") || - die "Couldn't open pipe to $spamcat: $!\n"; -$fh->close; +# TODO: Test for proper exit codes. +#my $fh = IO::File->new("|$spamcat -c $conffile") || +# die "Couldn't open pipe to $spamcat: $!\n"; +#$fh->close; sub parse_configdump { my %rc; @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env perl use Email::Simple; use IO::File; @@ -1,6 +1,6 @@ # -*- Mode: cperl -*- -use Test::More tests => 31; +use Test::More tests => 41; use strict; use warnings; @@ -63,6 +63,19 @@ test_file('wrongdomain', 1); test_file('nosubj', 1); test_file('bar', 0); +ok(SpamCat->can('get_table')); +my @rows = @{$sch->get_table()}; +is($#rows, 3); +@rows = sort { $a->{sender} cmp $b->{sender} } @rows; +is($rows[0]->{sender}, 'bar'); +is($rows[0]->{count}, 0); +is($rows[1]->{sender}, 'foo'); +is($rows[1]->{count}, 16); +is($rows[2]->{sender}, 'name1'); +is($rows[2]->{count}, 20); +is($rows[3]->{sender}, 'nosubj'); +is($rows[3]->{count}, 20); + sub test_file { my ($filen, $should_exist) = @_; |