# perl script

=head1 DESCRIPTION

This script was used after entering data for the 2008 fisher hair snares
on the Helena National Forest.  The script reads tab-separated
data, and copies some columns to later rows, when the later rows have nothing
in those columns.

Takes a text file with columns separated by tabs.
For each row (line), if certain columns are blank,
the data for the columns is copied from a previous row.

The column numbers are hard-coded.  Modify the script to change them.

In this version, data is copied to **any** of the destination cells
that are blank.  (In other versions, no data is copied unless **all**
the selected destination cells in the row are blank.)

=head1 NEW IN THIS VERSION 

It allows you to specify a single column as "[col]"
(e.g "[7]" equivalent to "[7,7]").

It has a post-processing feature, a function to modify
the data for a row after copying columns from previous rows.

It leaves blank lines unchanged.

=head1 STATUS

Tested.

=cut

## duplicate these columns (first column has index 0)
@dup = ([0,5],[7],[9,10]);

sub is_empty {
	my $thing = shift;
	return (defined($thing) && $thing =~ /\S/) ? 0 : 1;
}

## special processing, given the array of columns for one line
##
sub forget_prev {
	@prev = ();
}

# Function to run before copying data, for 2008
#
$special_1 = sub {};

# Function to run after copying data, for 2008
$special_2 = sub {
	my @line = @_;
	my ($site_idx, $pid_idx, $date_idx) = (2,3,5);
	my ($waypoint_idx, $sitename_idx) = (17,0);

	# The point is identified by a site identifier and point number
	my $pid = $line[$pid_idx];
	my $site = $line[$site_idx];
	my $sitename = $line[$sitename_idx];

		
	

				
	# Set/modify the GPS waypoint name if not already
	#
	if (1) { # true in 2008
		$waypoint = $line[$waypoint_idx];
		if ( &is_empty( $waypoint ) && !&is_empty( $site )) {
			if ($pid eq 'N/A') {
				die "bad site in line $." if ($site !~ /^[A-Z]/);
				$waypoint = $site;
			} else {
				$create_waypoint = 1;
				if ($create_waypoint) {
					$waypoint = 'F' . $site . '-' . $pid;
				} else {
				print STDERR
				 "waypoint_idx='$waypoint_idx'"
				 ,", waypoint name '$waypoint'"
				 ,", site='$site',pid='$pid'\n";
				die "no waypoint name in line $.:" . join(',',@line);
				}
			}
		}
		# Modify the waypoint name if numeric
		if (!&is_empty( $waypoint ) && $waypoint =~ /^[\d][\d]*/) {
			$waypoint = '#' . $waypoint;
		}
		$line[$waypoint_idx] = $waypoint;
	}


	#
	# set standard values for some fields, if empty
	#
	#...

	return @line;
};


@prev = ();


LOOP: while (<>) {
#print STDERR $., ':', $_, ':';

# Skip the first line
#
if ($. == 1) {
	print $_;
	next LOOP;	
}

# Skip blank lines
#
if (/^\s*$/) {
	print $_;
	next LOOP;	
}

#last LOOP if /^__END__/;

chomp;
@f = split "\t";
@f = &$special_1(@f);
for ($j=0; $j<@dup; $j++) {
	$section = $dup[$j];
	($s,$e) = @$section[0,1];
	$e = $s if ! defined($e);
	# print $s," - ", $e, "\n";
	
	die "bad interval $s,$e" if $s>$e;
	$copy_it = 1;
	$all_or_none = 0;
	if ($all_or_none) {
		CHECK: for ($k=$s; $k<=$e; $k++) {
			
			if ( ! &is_empty($f[$k]) ) {
				$copy_it = 0;
				last CHECK;
			}
		}
		#print STDERR "line $.: cols=",@f+0,"  :", @f, "\n";
		#print "slice [$s,$e]: ",join(',',@f[$s,$e]), "\n";
		if ($copy_it) {
			@f[$s .. $e] = @prev[$s .. $e];
		}
	} else {
		COPY: for ($k=$s; $k<=$e; $k++) {
			
			if ( &is_empty($f[$k]) ) {
				$f[$k] = $prev[$k];
			}
		}
	}
}
@f = &$special_2(@f);
@f = map { defined($_) ? $_ : '' } @f;
@prev = @f;
print join "\t",@f, "\n";

}