From: djk <djk>
Date: Fri, 31 Mar 2000 20:04:37 +0000 (+0000)
Subject: allow kill msg with range 1-n to kill from 1-n and not 1->n-1
X-Git-Tag: R_1_40~21
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=de987b900c04d852acec5e1af9a4326b16533253;p=spider.git

allow kill msg with range 1-n to kill from 1-n and not 1->n-1
added autosplit for msgs dumped into the import directory starting with
'split' as the filename.
---

diff --git a/Changes b/Changes
index 581d0660..8c844115 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+31Mar00=======================================================================
+1. fixed nnn-mmm in kill (erase/delete) msgs so that mmm is also deleted and
+not just nnn -> mmm-1.
+2. Added an autosplit to message importing so that messages are split
+automagically into bits if the filename used in the import directory starts
+with "split". This will add a [1/5] type string on the the end of the subject. 
 30Mar00=======================================================================
 1. altered client.pl connect code so that it doesn't falsely recognise 
 /spider/src/client as a 'client' instruction.
diff --git a/cmd/kill.pl b/cmd/kill.pl
index c2062ba4..dd476059 100644
--- a/cmd/kill.pl
+++ b/cmd/kill.pl
@@ -40,7 +40,7 @@ while (@f) {
 		my $from = $1;
 		my $to = $2;
 		@refs = grep { !($self->priv < 5 && $_->to ne $call && $_->from ne $call) } DXMsg::get_all() unless @refs;
-		@refs = grep { $_->msgno >= $from && $_->msgno < $to } @refs;
+		@refs = grep { $_->msgno >= $from && $_->msgno <= $to } @refs;
 	} elsif ($f =~ /^fr/io) {
 		$f = shift @f;
 		if ($f) {
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 168a9782..9e4893b2 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -33,7 +33,7 @@ use Carp;
 use strict;
 use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
 			@badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime
-		    $queueinterval $lastq $importfn);
+		    $queueinterval $lastq $importfn $minchunk $maxchunk);
 
 %work = ();						# outstanding jobs
 @msg = ();						# messages we have
@@ -49,6 +49,8 @@ $waittime = 30*60;              # time an aborted outgoing message waits before
 $queueinterval = 1*60;          # run the queue every 1 minute
 $lastq = 0;
 
+$minchunk = 4800;               # minimum chunk size for a split message
+$maxchunk = 6000;               # maximum chunk size
 
 $badmsgfn = "$msgdir/badmsg.pl";    # list of TO address we wont store
 $forwardfn = "$msgdir/forward.pl";  # the forwarding table
@@ -552,7 +554,7 @@ sub read_msg_body
 		print "Error reading $fn $!\n";
 		return undef;
 	}
-	chomp (@out = <$file>);
+	@out = map {chomp; $_} <$file>;
 	close($file);
 	
 	shift @out if $out[0] =~ /^=== /;
@@ -614,7 +616,7 @@ sub queue_msg
 				my $hnode =  $uref->homenode if $uref;
 				$clref = DXCluster->get_exact($hnode) if $hnode;
 			}
-			if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
+			if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all()) {
 				next if $clref->call eq $main::mycall;  # i.e. it lives here
 				$noderef = $clref->{dxchan};
 				$ref->start_msg($noderef) if !get_busy($noderef->call)  && $noderef->state eq 'normal';
@@ -1049,8 +1051,8 @@ sub import_msgs
 	# are there any to do in this directory?
 	return unless -d $importfn;
 	unless (opendir(DIR, $importfn)) {
-		dbg('msg', "can't open $importfn $!");
-		Log('msg', "can't open $importfn $!");
+		dbg('msg', "can\'t open $importfn $!");
+		Log('msg', "can\'t open $importfn $!");
 		return;
 	} 
 
@@ -1059,18 +1061,19 @@ sub import_msgs
 	my $name;
 	foreach $name (@names) {
 		next if $name =~ /^\./;
+		my $splitit = $name =~ /^split/;
 		my $fn = "$importfn/$name";
 		next unless -f $fn;
 		unless (open(MSG, $fn)) {
-			dbg('msg', "can't open import file $fn $!");
-			Log('msg', "can't open import file $fn $!");
+	 		dbg('msg', "can\'t open import file $fn $!");
+			Log('msg', "can\'t open import file $fn $!");
 			unlink($fn);
 			next;
 		}
 		my @msg = map { chomp; $_ } <MSG>;
 		close(MSG);
 		unlink($fn);
-		my @out = import_one($DXProt::me, \@msg);
+		my @out = import_one($DXProt::me, \@msg, $splitit);
 		Log('msg', @out);
 	}
 }
@@ -1081,6 +1084,7 @@ sub import_one
 {
 	my $dxchan = shift;
 	my $ref = shift;
+	my $splitit = shift;
 	my $private = '1';
 	my $rr = '0';
 	my $notincalls = 1;
@@ -1092,7 +1096,7 @@ sub import_one
 	# first line;
 	my $line = shift @$ref;
 	my @f = split /\s+/, $line;
-	unless ($f[0] =~ /^(:?S|SP|SB|SEND)$/ ) {
+ 	unless (@f && $f[0] =~ /^(:?S|SP|SB|SEND)$/ ) {
 		my $m = "invalid first line in import '$line'";
 		dbg('MSG', $m );
 		return (1, $m);
@@ -1140,52 +1144,81 @@ sub import_one
 					}
 				}
 			}
-
+			
 			if (grep $_ eq $f, @DXMsg::badmsg) {
 				push @out, $dxchan->msg('m3', $f);
 			} else {
-				push @to, $f;
+	 			push @to, $f;
 			}
 		}
 	}
-
+	
 	# subject is the next line
 	my $subject = shift @$ref;
 	
 	# strip off trailing lines 
-	pop @$ref while (@$ref && ($$ref[-1] eq '' || $$ref[-1] =~ /^\s+$/));
-
+	pop @$ref while (@$ref && $$ref[-1] =~ /^\s*$/);
+	
 	# strip off /EX or /ABORT
-	return ("aborted") if (@$ref && $$ref[-1] =~ m{^/ABORT$}i); 
+	return ("aborted") if @$ref && $$ref[-1] =~ m{^/ABORT$}i; 
 	pop @$ref if (@$ref && $$ref[-1] =~ m{^/EX$}i);									 
 
+	# sort out any splitting that needs to be done
+	my @chunk;
+	if ($splitit) {
+		my $lth = 0;
+		my $lines = [];
+		for (@$ref) {
+			if ($lth >= $maxchunk || ($lth > $minchunk && /^\s*$/)) {
+				push @chunk, $lines;
+				$lines = [];
+				$lth = 0;
+			} 
+			push @$lines, $_;
+			$lth += length; 
+		}
+		push @chunk, $lines if @$lines;
+	} else {
+		push @chunk, $ref;
+	}
+				  
     # write all the messages away
-	my $to;
-	foreach $to (@to) {
-		my $systime = $main::systime;
-		my $mycall = $main::mycall;
-		my $mref = DXMsg->alloc(DXMsg::next_transno('Msgno'),
-							$to,
-							$from, 
-							$systime,
-							$private, 
-							$subject, 
-							$origin,
-							'0',
-							$rr);
-		$mref->swop_it($main::mycall);
-		$mref->store($ref);
-		$mref->add_dir();
-		push @out, $dxchan->msg('m11', $mref->{msgno}, $to);
-		#push @out, "msgno $ref->{msgno} sent to $to";
-		my $todxchan = DXChannel->get(uc $to);
-		if ($todxchan) {
-			if ($todxchan->is_user()) {
-				$todxchan->send($todxchan->msg('m9'));
+	my $i;
+	for ( $i = 0;  $i < @chunk; $i++) {
+		my $chunk = $chunk[$i];
+		my $ch_subject;
+		if (@chunk > 1) {
+			my $num = " [" . ($i+1) . "/" . scalar @chunk . "]";
+			$ch_subject = substr($subject, 0, 27 - length $num) .  $num;
+		} else {
+			$ch_subject = $subject;
+		}
+		my $to;
+		foreach $to (@to) {
+			my $systime = $main::systime;
+			my $mycall = $main::mycall;
+			my $mref = DXMsg->alloc(DXMsg::next_transno('Msgno'),
+									$to,
+									$from, 
+									$systime,
+									$private, 
+									$ch_subject, 
+									$origin,
+									'0',
+									$rr);
+			$mref->swop_it($main::mycall);
+			$mref->store($chunk);
+			$mref->add_dir();
+			push @out, $dxchan->msg('m11', $mref->{msgno}, $to);
+			#push @out, "msgno $ref->{msgno} sent to $to";
+			my $todxchan = DXChannel->get(uc $to);
+			if ($todxchan) {
+				if ($todxchan->is_user()) {
+					$todxchan->send($todxchan->msg('m9'));
+				}
 			}
 		}
 	}
-
 	return @out;
 }
 
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 6a82cb16..3d3894d1 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -31,7 +31,7 @@ use Carp;
 
 use strict;
 use vars qw($me $pc11_max_age $pc23_max_age $pc11_dup_age $pc23_dup_age
-			%spotdup %wwvdup $last_hour %pings %rcmds
+			%spotdup %wwvdup $last_hour %pings %rcmds $pc11duptext
 			%nodehops @baddx $baddxfn $pc12_dup_age
 			%anndup $allowzero $pc12_dup_lth $decode_dk0wcy);
 
@@ -43,6 +43,8 @@ $pc11_dup_age = 3*3600;			# the maximum time to keep the spot dup list for
 $pc23_dup_age = 3*3600;			# the maximum time to keep the wwv dup list for
 $pc12_dup_age = 24*3600;		# the maximum time to keep the ann dup list for
 $pc12_dup_lth = 60;				# the length of ANN text to save for deduping 
+$pc11duptext = 27;				# maximum lth of the text field in PC11 to use for duduping
+
 %spotdup = ();				    # the pc11 and 26 dup hash 
 %wwvdup = ();				    # the pc23 and 27 dup hash
 %anndup = ();                               # the PC12 dup hash
@@ -79,7 +81,8 @@ sub init
 	# now prime the wwv duplicates file with just this month's data
 	my @wwv = Geomag::readfile(time);
 	for (@wwv) {
-		my $dupkey = "$_->[1].$_->[2]$_->[3]$_->[4]";
+		my $duptext = substr $_->[3], 0, $pc11duptext;
+		my $dupkey = "$_->[1].$_->[2]$duptext$_->[4]";
 		$wwvdup{$dupkey} = $_->[1];
 	}
 
@@ -238,7 +241,8 @@ sub normal
 			
 			# do some de-duping
 			my $freq = $field[1] - 0;
-			my $dupkey = "$freq$field[2]$d$text$spotter";
+			my $duptext = substr $text, 0, $pc11duptext;
+			my $dupkey = "$freq$field[2]$d$duptext$spotter";
 			if ($spotdup{$dupkey}) {
 				dbg('chan', "Duplicate Spot ignored\n");
 				return;
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 373e595c..3ea1d6a5 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -70,7 +70,7 @@ package main;
 
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
-$version = "1.39";				# the version no of the software
+$version = "1.40";				# the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
 $lockfn = "cluster.lock";       # lock file name
 @outstanding_connects = ();     # list of outstanding connects