X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FQSL.pm;h=0de926888d48ae195c33bce72b1f1e3e4b20932f;hb=1172aa77de530206b0dbb648d8489922a518d502;hp=35117b1ba9bc5a1f7da9b06efca87121de2f0612;hpb=bcf2892aa7f3c9957ee61365a6e032dd93044834;p=spider.git

diff --git a/perl/QSL.pm b/perl/QSL.pm
index 35117b1b..0de92688 100644
--- a/perl/QSL.pm
+++ b/perl/QSL.pm
@@ -12,7 +12,6 @@ use DXVars;
 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+)/ );
@@ -28,7 +27,18 @@ sub init
 {
 	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 ($!)";
@@ -52,14 +62,21 @@ sub new
 # 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]++;
@@ -69,7 +86,7 @@ sub update
 			}
 		} else {
 			$r = [$man, 1, $t, $by];
-			push @{$self->[1]}, $r;
+			unshift @{$self->[1]}, $r;
 		}
 	}
 	$self->put;
@@ -77,8 +94,8 @@ sub update
 
 sub get
 {
-	my $key = uc shift;
 	return undef unless $dbm;
+	my $key = uc shift;
 	my $value;
 	
 	my $r = $dbm->get($key, $value);
@@ -88,10 +105,10 @@ sub get
 
 sub put
 {
+	return unless $dbm;
 	my $self = shift;
 	my $key = $self->[0];
 	my $value = nfreeze($self);
-	$dbm->del($key);
 	$dbm->put($key, $value);
 }