projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
add #9000 as a default group and tidy up send_chats calls
[spider.git]
/
perl
/
QSL.pm
diff --git
a/perl/QSL.pm
b/perl/QSL.pm
index 0de926888d48ae195c33bce72b1f1e3e4b20932f..9ed00f30d1c37ec2049d89d63d662db1fac7dffa 100644
(file)
--- a/
perl/QSL.pm
+++ b/
perl/QSL.pm
@@
-12,12
+12,7
@@
use DXVars;
use DXUtil;
use DB_File;
use DXDebug;
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';
use vars qw($qslfn $dbm);
$qslfn = 'qsl';
@@
-28,6
+23,8
@@
sub init
my $mode = shift;
my $ufn = "$main::root/data/$qslfn.v1";
my $mode = shift;
my $ufn = "$main::root/data/$qslfn.v1";
+ Prefix::load() unless Prefix::loaded();
+
eval {
require Storable;
};
eval {
require Storable;
};
@@
-67,29
+64,38
@@
sub update
my $line = shift;
my $t = shift;
my $by = shift;
my $line = shift;
my $t = shift;
my $by = shift;
+ my $changed;
+
+ foreach my $man (split /\b/, uc $line) {
+ my $tok;
- my @tok = map {/^(?:HC|BUR|QRZ|HOME)/ || is_callsign($_) ? $_ : ()} split(/\b/, uc $line);
- foreach my $man (@tok) {
- if ($man =~ /^BUR/) {
- $man = 'BUREAU';
- } elsif ($man eq 'HC' || $man =~ /^HOM/) {
- $man = 'HOME CALL';
+ 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/) {
} elsif ($man =~ /^QRZ/) {
- $
man
= 'QRZ.com';
+ $
tok
= 'QRZ.com';
}
}
- my ($r) = grep {$_->[0] eq $man} @{$self->[1]};
- if ($r) {
- $r->[1]++;
- if ($t > $r->[2]) {
- $r->[2] = $t;
- $r->[3] = $by;
+ 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];
- unshift @{$self->[1]}, $r;
}
}
}
}
- $self->put;
+ $self->put
if $changed
;
}
sub get
}
sub get