use DXUtil;
use DB_File;
use DXDebug;
-use Storable qw(nfreeze thaw);
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
{
my $mode = shift;
my $ufn = "$main::root/data/$qslfn.v1";
+
+ eval {
+ require Storable;
+ };
+ if ($@) {
+ dbg("Storable appears to be missing");
+ dbg("In order to use the QSL feature you must");
+ dbg("load Storable from CPAN");
+ return undef;
+ }
+ import Storable qw(nfreeze freeze thaw);
my %u;
if ($mode) {
$dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open qsl file: $qslfn ($!)";
# the format of each entry is [manager, times found, last time]
sub update
{
+ return unless $dbm;
my $self = shift;
my $line = shift;
my $t = shift;
my $by = shift;
- my @tok = map {/^BUR/ || is_callsign($_) ? $_ : ()} split(/\b/, uc $line);
+ my @tok = map {/^(?:HC|BUR|QRZ|HOME)/ || is_callsign($_) ? $_ : ()} split(/\b/, uc $line);
foreach my $man (@tok) {
- $man = 'BUREAU' if $man =~ /^BUR/;
+ if ($man =~ /^BUR/) {
+ $man = 'BUREAU';
+ } elsif ($man eq 'HC' || $man =~ /^HOM/) {
+ $man = 'HOME CALL';
+ } elsif ($man =~ /^QRZ/) {
+ $man = 'QRZ.com';
+ }
my ($r) = grep {$_->[0] eq $man} @{$self->[1]};
if ($r) {
$r->[1]++;
}
} else {
$r = [$man, 1, $t, $by];
- push @{$self->[1]}, $r;
+ unshift @{$self->[1]}, $r;
}
}
$self->put;
sub get
{
- my $key = uc shift;
return undef unless $dbm;
+ my $key = uc shift;
my $value;
my $r = $dbm->get($key, $value);
sub put
{
+ return unless $dbm;
my $self = shift;
my $key = $self->[0];
my $value = nfreeze($self);
- $dbm->del($key);
$dbm->put($key, $value);
}