From: minima <minima>
Date: Wed, 12 Mar 2003 13:30:46 +0000 (+0000)
Subject: added HC and QRZ to QSL.pm
X-Git-Tag: PRE-1-52~18
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=1172aa77de530206b0dbb648d8489922a518d502;p=spider.git

added HC and QRZ to QSL.pm
---

diff --git a/Changes b/Changes
index 349df747..28a42c5b 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+12Mar03=======================================================================
+1. added HC and QRZ.com to possible QSL locations, if you want to pick up
+historical info (ie start again), run create_qsl.pl after update and restart
+the node (which you will need to do anyway).
 11Mar03=======================================================================
 1. Changed the name of show/qsl to show/dxqsl.
 2. Alter Commands_en.hlp to match new name and issue manual updates (g0vgs)
diff --git a/perl/LRU.pm b/perl/LRU.pm
index 30b264a5..29fd3c87 100644
--- a/perl/LRU.pm
+++ b/perl/LRU.pm
@@ -11,7 +11,7 @@
 #
 # The structure of the base is:-
 #
-#  [next, prev, max objects, count ]
+#  [next, prev, max objects, count, <coderef to function to call on deletion> ]
 #
 #
 
@@ -37,8 +37,9 @@ sub newbase
 	my $pkg = shift;
 	my $name = shift;
 	my $max = shift;
+	my $coderef = shift;
 	confess "LRU->newbase requires a name and maximal count" unless $name && $max;
-	return $pkg->SUPER::new({ }, $max, 0, $name);
+	return $pkg->SUPER::new({ }, $max, 0, $name, $coderef);
 }
 
 sub get
@@ -86,6 +87,7 @@ sub remove
 	my $q = $self->obj->{$call};
 	confess("$call is already removed") unless $q;
 	dbg("LRU $self->[5] cache remove $call now $self->[4]/$self->[3]") if isdbg('lru');
+	&{$self->[5]}($q->obj) if $self->[5];
 	$q->obj(1);
 	$q->SUPER::del;
 	delete $self->obj->{$call};
diff --git a/perl/QSL.pm b/perl/QSL.pm
index abb8b86c..0de92688 100644
--- a/perl/QSL.pm
+++ b/perl/QSL.pm
@@ -38,7 +38,7 @@ sub init
 		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 ($!)";
@@ -68,9 +68,15 @@ sub update
 	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]++;