use DXUtil;
use DB_File;
use DXDebug;
-
-use vars qw($VERSION $BRANCH);
-$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
-$main::build += $VERSION;
-$main::branch += $BRANCH;
+use Prefix;
use vars qw($qslfn $dbm);
$qslfn = 'qsl';
my $mode = shift;
my $ufn = "$main::root/data/$qslfn.v1";
+ Prefix::load() unless Prefix::loaded();
+
eval {
require Storable;
};
dbg("load Storable from CPAN");
return undef;
}
- import Storable qw(nfreeze thaw);
+ 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 ($!)";
my $line = shift;
my $t = shift;
my $by = shift;
+ my $changed;
+
+ foreach my $man (split /\b/, uc $line) {
+ my $tok;
- my @tok = map {/^BUR/ || is_callsign($_) ? $_ : ()} split(/\b/, uc $line);
- foreach my $man (@tok) {
- $man = 'BUREAU' if $man =~ /^BUR/;
- my ($r) = grep {$_->[0] eq $man} @{$self->[1]};
- if ($r) {
- $r->[1]++;
- if ($t > $r->[2]) {
- $r->[2] = $t;
- $r->[3] = $by;
+ if (is_callsign($man)) {
+ my @pre = Prefix::extract($man);
+ $tok = $man if @pre && $pre[0] ne 'Q';
+ } elsif ($man =~ /^BUR/) {
+ $tok = 'BUREAU';
+ } elsif ($man eq 'HC' || $man =~ /^HOM/ || $man =~ /^DIR/) {
+ $tok = 'HOME CALL';
+ } elsif ($man =~ /^QRZ/) {
+ $tok = 'QRZ.com';
+ }
+ if ($tok) {
+ my ($r) = grep {$_->[0] eq $tok} @{$self->[1]};
+ if ($r) {
+ $r->[1]++;
+ if ($t > $r->[2]) {
+ $r->[2] = $t;
+ $r->[3] = $by;
+ }
+ $changed++;
+ } else {
+ $r = [$tok, 1, $t, $by];
+ unshift @{$self->[1]}, $r;
+ $changed++;
}
- } else {
- $r = [$man, 1, $t, $by];
- push @{$self->[1]}, $r;
}
}
- $self->put;
+ $self->put if $changed;
}
sub get
{
- my $key = uc shift;
return undef unless $dbm;
+ my $key = uc shift;
my $value;
my $r = $dbm->get($key, $value);