package auto_install;
use strict;
use error;
use MD5;
return 1;

# NOTES:
# Duplicates may exist in .config.all
# - because duplicates exist in .config.new when renamed to .config.all
#
# Duplicates may exist in .config.new
# - due to aborted installs.
#
# Duplicates shouldn't hurt the processing in anyway (only the last
#   value is read from .config.all and .config.new combined). If
#   duplicate values take up too much space in then please let me
#   know.

# GLOBAL VARIABLES

# List of all options
my $OPTIONS;

# Has this file been installed?
my %filesnew;

# start copying files
sub start
{
	my $class = shift;
	my $SRC = shift;
	my $DST = shift;
	$OPTIONS = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	for (my $i=0; $i<=$#$DST; $i++)
	{
		my $ADST = $DST->[$i];
		$ADST->{"dir"} =~ s/\/?$/\//;
		dst_cleanup($ADST,$error)
			or return 0;
	}

	for (my $i=0; $i<=$#$SRC; $i++)
	{
		my $ASRC = $SRC->[$i];
		$ASRC->{"dir"} =~ s/\/?$/\//;
		if ($OPTIONS->{"debug"})
		{
			print "-----------------------------------------\n";
			print "source $i dir: ".$ASRC->{"dir"}."\n";
		}
		readrul($SRC->[$i],$error) or
			return 0;

		do_ignore($ASRC,$error) or
			return 0;

		if (-e $ASRC->{"dir"})
		{
			my $src_name_rel="/";
			do_file($src_name_rel,$ASRC,$DST,$error) or
				return 0;
		}
	}

	for (my $i=0; $i<=$#$DST; $i++)
	{
		my $ADST = $DST->[$i];
		dst_final_cleanup($ADST,$error) or
			return 0;
	}

	return 1;
}

# Read in .config.cur and .config.new into @$files_cur and %filescur
# (.config.new is read in case previous install was aborted).
sub dst_cleanup
{
	my $ADST = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;
	my $files_cur=[];
	my $file_det_cur_src={};
	my $file_det_new_src={};

	# TEMP Variables
	# List of all files under our control before start copying
	$ADST->{"tmp_files_cur"}=$files_cur;

	# List of details of all source files when last *copied*
	$ADST->{"tmp_file_det_cur_src"}=$file_det_cur_src;

	# List of details of all source files when last installed
	$ADST->{"tmp_file_det_new_src"}=$file_det_new_src;
	
	if ( -f $ADST->{"allcur"} )
	{
		$rc=readlist($ADST->{"allcur"},$files_cur,
			$file_det_cur_src, $file_det_new_src, $error);
		return 0 if (!$rc);
	}

	# File allnew takes priority, it has information from last install
	if ( -f $ADST->{"allnew"} )
	{
		$rc=readlist($ADST->{"allnew"},$files_cur,
			$file_det_cur_src, $file_det_new_src, $error);
		return 0 if (!$rc);
	}

	@$files_cur = sort { $b cmp $a } @$files_cur;

	return 1;
}

sub readlist
{
	my $file = shift;
	my $files_cur = shift;
	my $file_det_cur_src = shift;
	my $file_det_new_src = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc=open(FILE,"<".$file);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot open file ".$file." for reading: $!");
		return(0);
	}
	while (<FILE>)
	{
		chomp($_);
		my $details1; my $details2;
		my $thefile;
		($thefile,$details1, $details2) = split(/ /);

                # Truncate trailing / if one exists - work around bug
                # in previous version of auto_install.pm that sometimes
                # put trailing / on end of filename. If two filenames
                # are different they are considerd different files even
                # though they may refer to the same file.
		$thefile =~ s/\/$// if ($thefile ne "/");

		if (!defined($file_det_cur_src->{$thefile}))
		{
			my $i=$#$files_cur + 1;
			$files_cur->[$i] = $thefile;
		}

		if (defined($details1) and $details1 ne "*")
		{
			my @details1;
			(@details1) = split(/=/,$details1);
			$file_det_cur_src->{$thefile} = [ @details1 ];
		}
		else
		{
			$file_det_cur_src->{$thefile} = undef;
		}

		if (defined($details2) and $details2 ne "*")
		{
			my @details2;
			(@details2) = split(/=/,$details2);
			$file_det_new_src->{$thefile} = [ @details2 ];
		}
		else
		{
			$file_det_new_src->{$thefile} = undef;
		}
			
	}
	$rc=close(FILE);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot close file ".$file.": $!");
		return(0);
	}
	return(1);
}

# Delete all files that are in .config.all that haven't been copied this time.
# Move .config.new to .config.all
sub dst_final_cleanup
{
	my $ADST = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

	my $files_cur=$ADST->{"tmp_files_cur"};
	my $file_det_cur_src=$ADST->{"tmp_file_det_cur_src"};
	my $file_det_new_src=$ADST->{"tmp_file_det_new_src"};

	for (my $i=0; $i<=$#$files_cur; $i++)
	{
		my $dst_name_rel = $files_cur->[$i];
		my $dst_name_full = $ADST->{"dir"}.$dst_name_rel;

		# Don't delete unless source was deleted (ie if we didn't
		#    see it earlier)
		next if (defined($filesnew{$dst_name_rel}));

		# DON'T MARK AS DELETED HERE; THIS IS GLOBAL!
		# $filesnew{$dst_name_rel} = "DELETED";

		# However, don't bother if already marked as deleted
		next if (!defined($file_det_cur_src->{$dst_name_rel})
		     and !defined($file_det_new_src->{$dst_name_rel}) );

		# Source status is obviously deleted (or we shouldn't be
		#     here).
		my $src_status="deleted";

		# Find status of destination file
		my $ref_stat=$file_det_cur_src->{$dst_name_rel};
		my @dst_stat=mylstat($dst_name_full,$error); $$error=undef;
		my $dst_status=compare_stat(\@dst_stat,$ref_stat);

		my $doit;
		if ($dst_status ne "deleted")
		{
			# If destination exists, find out what we should
			#    do with it.
			$doit=doit("deleted",$dst_name_full,$src_status,$dst_status);
		}
		else
		{
			# Otherwise, just delete it again(!).
			$doit=2;
		}

		if ($OPTIONS->{"noaction"})
		{
			print "Would forget $dst_name_full\n" if ($doit==0 or $doit==1);
			print "Would delete $dst_name_full\n" if ($doit==2);
			print "Would rename $dst_name_full to $dst_name_full.ai-old\n" if ($doit==3);
			next;
		}
	
		if ($doit==0 or $doit==1)
		{
			print "Forget $dst_name_full\n";
		}
		elsif ($doit == 2)
		{
			print "Delete $dst_name_full\n";
			$rc=delete_file($dst_name_full,$error);
			if (!$rc)
			{
				return 0;
			}
		}
		elsif ($doit == 3)
		{
			print "Rename $dst_name_full to $dst_name_full.ai-old\n";
			my $rc=rename($dst_name_full,$dst_name_full.".ai-old");
			if (!$rc)
			{
				$$error="error"->new("error"->general,
					"Cannot rename $dst_name_full".
					" to $dst_name_full.ai-old: $!");
				return(0);
			}
		}
		else {die "Unknown doit for $dst_name_rel: $doit";}

		if (!$OPTIONS->{"noaction"})
		{ 
			record_file($dst_name_rel,$ADST,undef,undef,$error)
				or return(0);
		}

		$file_det_cur_src->{$dst_name_rel} = undef;
		$file_det_new_src->{$dst_name_rel} = undef;
	}

	return(1) if ($OPTIONS->{"noaction"});

	$rc=rename($ADST->{"allnew"},$ADST->{"allcur"});
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot rename ".$ADST->{"allnew"}.
			" to ".$ADST->{"allcur"}.": $!");
		return(0);
	}
	return 1;
}
#-----------------------------------------

# read rules from rule file for a particular source
sub readrul
{
	my $ASRC = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;
	my $rul = $ASRC->{"rules_file"};

	open(RUL,$rul) or return(1);
	while (<RUL>)
	{
		# Remove comments (anything on line after #)
		s/#.*$//;
		# Removing trailing white space
		s/\s*$//;

		next if ($_ eq "");

		process_hash($ASRC,$_,$error) or
			return(0);
	}
	$rc=close RUL;
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot close file ".$ASRC->{"rules_file"}.": $!");
		return(0);
	}
	return 1;
}

sub process_hash
{
	my $ASRC = shift;
	my $line = shift;
	my $error = shift;

	my $hash;
	my $value;

	($hash,$value) = ($line =~ /^@(\S+)\s*(.*)$/);
	if (!defined($hash))
	{
		return process_rul($ASRC,$_,$error);
	}

	if ($hash eq "ignore")
	{
		my $file=$value;
		my $i = $#{$ASRC->{"ignore"}} + 1;
		$ASRC->{"ignore"}[$i]{"file"} = $file;
	}
	elsif ($hash eq "rename")
	{
		my $null;
		my $from;
		my $to;

		($null,$from,$to) = split(/=/,$value);
		my $i = $#{$ASRC->{"rename"}} + 1;
		$ASRC->{"rename"}[$i]{"to"} = '"'.$to.'"';
		$ASRC->{"rename"}[$i]{"from"} = $from;
		return(1);
	}
	else
	{
		process_rul($ASRC,$_,$error) or
			return(0);
	}

}

sub process_rul
{
	my $ASRC = shift;
	my $line = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $action;
	my %actions;
	my $type;
	my $pattern;
	my $package_name;

	($action,$type,$pattern) = ($line =~ /^(\S+)\s*(?:\[(\S+)\])?\s*(.*)$/);
	($pattern,$package_name) = split ("@",$pattern)
		if (defined($pattern));

	if (!defined($action))
	{
		$$error="error"->new("error"->general,
			"Invalid line $_");
		return(0);
	}

	$action =~ s/-//g;
	if ($action =~ s/d//)
	{
		$actions{"descend"} = 1;
	}
	if ($action =~ s/c//)
	{
		$actions{"copy"} = 1;
	}
	if ($action =~ s/C//)
	{
		$actions{"convert"} = 1;
	}
#	if ($action =~ s/g//)
#	{
#		$actions{"global"} = 1;
#	}
	if ($action ne "")
	{
		$$error="error"->new("error"->general,
			"Invalid action $action");
		return(0);
	}

	if (!defined($type) or $type eq "")
	{
		$type = undef;
	}

	my $i = $#{$ASRC->{"rules"}} + 1;
	$ASRC->{"rules"}[$i]{"action"} = \%actions;
	$ASRC->{"rules"}[$i]{"type"} = $type;
	if (defined($pattern) and $pattern ne "")
	{
		$ASRC->{"rules"}[$i]{"pattern"} = $pattern;
	}
	else
	{
		$ASRC->{"rules"}[$i]{"pattern"} = undef;
	}

	if ($OPTIONS->{"getpackage"} and
		defined($package_name) and $package_name ne "")
	{
		my $package=&{$OPTIONS->{"getpackage"}}($package_name,$error);
		$ASRC->{"rules"}[$i]{"package"} = $package;
		return(0) if (!defined($package));
	}
	else
	{
		$ASRC->{"rules"}[$i]{"package"} = undef;
	}
	return 1;
}

# get action to be taken (from rules) for this particular file
sub get_action
{
	my $filetype=shift;
	my $src_name_rel=shift;
	my $ASRC=shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $src_name_full=$ASRC->{"dir"}.$src_name_rel;

	my $rules=$ASRC->{"rules"};
	for (my $i=0; $i<=$#$rules; $i++)
	{
		my $match_type = 0;
		my $match_package = 0;
		my $match = 0;

		my $rule=$rules->[$i];
		if (!defined($rule->{"type"}) or $rule->{"type"} eq $filetype)
		{
			$match_type = 1;
		}
	
		if ($match_type && defined($rule->{"package"}))
		{
			if (defined($rule->{"package"}{$src_name_rel}))
			{
				$match_package = 1;
			}
		}
		elsif ($match_type)
		{
			$match_package = 1;
		}

		if ($match_package && defined($rule->{"pattern"}))
		{
			if ("=".$src_name_rel eq $rule->{"pattern"})
			{
				$match = 1;
			}
			elsif ($src_name_rel =~ /$rule->{"pattern"}/)
			{
				$match  = 1;
			}
		}
		elsif ($match_package)
		{
			$match = 1;
		}

		if ($match && $OPTIONS->{"debug"})
		{
			print "$src_name_rel ".
				"(rule $i, ".
				"action ",join("-",%{$rule->{"action"}}),", ".
				"type ",$rule->{"type"},", ".
				"pattern ",$rule->{"pattern"},")\n";
		}
		if ($match)
		{
			return $rule->{"action"};
		}

	}
	if ($OPTIONS->{"debug"})
	{
		print "$src_name_rel DENY (NO ENTRY)\n";
	}
	return { "default" => 1 } ;
}

# Get renamed version of file name
sub do_rename
{
	my $src_name_rel=shift;
	my $ASRC=shift;
	my $error=shift;

	die if (!ref($error) or defined ($$error));

	my $rename=$ASRC->{"rename"};
	for (my $i=0; $i<=$#$rename; $i++)
	{
		my $to=$rename->[$i]{"to"};
		my $from=$rename->[$i]{"from"};
		$src_name_rel =~ s/$from/eval "$to"/e;
		if ($@)  # Is this correct??
		{
			$$error="error"->new("error"->general,
				"Invalid rename: $@");
			return(undef);
		}
	}

	# Remove groups of multiple //
	$src_name_rel =~ s/\/\//\//g;

	# Remove trailing /, this is very important for renaming /
	# as otherwise / might become /root/, which would be considered
	# a different file to /root.
	$src_name_rel =~ s/\/$// if ($src_name_rel ne "/");

	# Any filename not starting with "/" is illegal
	if (!($src_name_rel =~ /^\//))
	{
		$$error="error"->new("error"->general,
			"Renamed file $src_name_rel doesn't start with /");
		return(0);
	}

	# Any filename with embedded .. or . is also illegal
	if ($src_name_rel =~ /\/\.+\// or $src_name_rel =~ /\/\.+$/)
	{
		$$error="error"->new("error"->general,
			"Renamed file $src_name_rel contains illegal dots");
		return(0);
	}
	return($src_name_rel);
}

#Process list of files that are to be ignored (unless already copied
#by higher priority source directory.
#NOTE: These files will never be marked in .config.all as copied, hence
#if a file has already been copied in previous install operation,
#it will be removed, regardless of its attributes, etc. I consider
#this a bug, as the file may have been altered in the destination.
sub do_ignore
{
	my $ASRC=shift;
	my $error=shift;

	die if (!ref($error) or defined ($$error));

	my $ignore=$ASRC->{"ignore"};
	for (my $i=0; $i<=$#$ignore; $i++)
	{
		my $src_name_rel=$ignore->[$i]{"file"};
		my $dst_name_rel=do_rename($src_name_rel,$ASRC,$error);
		return 0 if (defined($$error));

		$filesnew{$dst_name_rel} = 1
			if (!defined($filesnew{$dst_name_rel}));
	}
	return(1);
}

# Process an individual file/dir/etc
sub do_file
{
	my $src_name_rel=shift;
	my $ASRC=shift;
	my $DST=shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $src_name_full=$ASRC->{"dir"}.$src_name_rel;

	my $dst_name_rel=do_rename($src_name_rel,$ASRC,$error);
	return 0 if (defined($$error));

#	hacked version of above, to be removed after confirmed OK
#	$dst_name_rel="/".$ASRC->{"offset"}.$src_name_rel if
#			(defined($ASRC->{"offset"}));
	
	my @src_stat = mylstat($src_name_full,$error);
	return 0 if (defined($$error));
	my $filetype = mylstat_getfiletype(\@src_stat);

	if (defined($filesnew{$dst_name_rel}))
	{
		if ( $filetype eq "dir" )
		{
			my $action = get_action($filetype,$src_name_rel,$ASRC,$error);
			return(0) if (defined($$error));

			if ($action->{"descend"})
			{
				do_dir($src_name_rel,$dst_name_rel,$ASRC,$DST,$error)
					or return(0);
			}
		}
		return 1;
	}
	my $action = get_action($filetype,$src_name_rel,$ASRC,$error);
	return(0) if (defined($$error));

	if ($action->{"convert"} and $filetype eq "file")
	{
		do_all_dst(\@src_stat,$src_name_rel,$dst_name_rel,$ASRC,$DST,"convert",$error)
			or return(0);
	}
	elsif ($action->{"copy"})
	{
		do_all_dst(\@src_stat,$src_name_rel,$dst_name_rel,$ASRC,$DST,"copy",$error)
			or return(0);
	}
	if ($action->{"descend"} and $filetype eq "dir")
	{
		do_dir($src_name_rel,$dst_name_rel,$ASRC,$DST,$error)
			or return(0);
	}
	return 1;
}

sub record_file
{
	my $dst_name_rel=shift;
	my $ADST=shift;
	my $src_stat_cur = shift;
	my $src_stat_new = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

	if (!$OPTIONS->{"noaction"})
	{
		$rc=open(FILE,">>".$ADST->{"allnew"});
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot open ".$ADST->{"allnew"}." for writing: $!");
			return(0);
		}

		$rc=print(FILE $dst_name_rel);
		if ($rc and defined($src_stat_cur))
		{
			my $tmp=join("=",@$src_stat_cur);
			$rc=print(FILE " ",$tmp);
		}
		else { print(FILE " *"); }

		if ($rc and defined($src_stat_new))
		{
			my $tmp=join("=",@$src_stat_new);
			$rc=print(FILE " ",$tmp);
		}
		else { print(FILE " *"); }

		if ($rc)
		{
			$rc=print(FILE "\n")
		}
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot write to ".$ADST->{"allnew"}.": $!");
			return(0);
		}
		$rc=close FILE;
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot close ".$ADST->{"allnew"}.": $!");
			return(0);
		}
	}
	return 1;
}

# Process all files/dirs/etc in a source directory
sub do_dir
{
	my $src_dir_rel=shift;
	my $dst_dir_rel=shift;
	my $ASRC=shift;
	my $DST=shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

	$src_dir_rel =~ s/\/?$/\//;

	my $src_dir_full=$ASRC->{"dir"}.$src_dir_rel;
	opendir(DIR,$src_dir_full) or return;
	my @names = readdir(DIR);
	$rc=closedir(DIR);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot close directory: $!");
		return(0);
	}

	for (my $i=0; $i<=$#names; $i++)
	{
		my $name = $names[$i];
		my $src_name_rel = $src_dir_rel.$name;

		if ($name eq "." or $name eq "..")
		{
			# ignore
		}
		else
		{
			do_file($src_name_rel,$ASRC,$DST,$error)
				or return(0);
		}
	}
	return 1;
}

# Copy a file/dir/etc to all destinations, as required, using the
# $action routine
sub do_all_dst
{
	my $src_stat = shift;
	my $src_name_rel = shift;
	my $dst_name_rel = shift;
	my $ASRC = shift;
	my $DST = shift;
	my $action = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	if (defined($filesnew{$dst_name_rel}))
	{
		return 1;
	}
	$filesnew{$dst_name_rel} = 1;

	my $src_name_full=$ASRC->{"dir"}.$src_name_rel;

	for (my $i=0; $i<=$#$DST; $i++)
	{
		my $ADST = $DST->[$i];
		my $file_det_cur_src=$ADST->{"tmp_file_det_cur_src"};
		my $file_det_new_src=$ADST->{"tmp_file_det_new_src"};

		# Compare $dst_name_full with reference
		my $dst_name_full=$ADST->{"dir"}.$dst_name_rel;
		my $ref_stat_cur = $file_det_cur_src->{$dst_name_rel};
		my $ref_stat_new = $file_det_new_src->{$dst_name_rel};
		$ref_stat_new = $ref_stat_cur if (!defined($ref_stat_new));
		my $dst_stat = [ mylstat($dst_name_full,$error) ]; $$error=undef;
		my $dst_status=compare_stat($dst_stat,$ref_stat_cur);

		# If file is to be converted, compare AFTER conversion, not
		# before, when there will be differences
		my $doit=undef;
		my $donothing=0;
		if ($action ne "convert")
		{
			# Compare $src_name_tmp with reference
			my $src_status=compare_stat($src_stat,$ref_stat_new);
			$doit=doit($src_name_full,$dst_name_full,
				$src_status,$dst_status);
			$donothing=1 if ($doit == 0);
		}

		my @src_stat_tmp=undef;
		my $src_name_tmp=$dst_name_full.".ai-new";
		if (!$donothing)
		{
			# Copy $src_name_full to $src_name_tmp
			copy_anything($action,$src_name_full,$src_name_tmp,
				$ASRC,$ADST,
				$src_stat,$error) or return(0);

			@src_stat_tmp = mylstat($src_name_tmp,$error);
			return 0 if (defined($$error));
		}

		if (!defined($doit))
		{
			# Get lstat of new source file
			# Compare $src_name_tmp with reference
			my $src_status=compare_stat(\@src_stat_tmp,$ref_stat_new);

			# Find out what we should do with temp file
			$doit=doit($src_name_tmp,$dst_name_full,$src_status,$dst_status);
		}
		if ($donothing)
		{
			#nothing to do;

			# Nothing more to be done; keep reference the same
			#$ref_stat_cur = $ref_stat_cur;
			$ref_stat_new = [ @$src_stat ];
		}
		elsif ($doit==0)
		{
			# We should simply delete the temp file, it is not
			# wanted
			delete_file($src_name_tmp,$error)
				or return(0);

			# Nothing more to be done; keep reference the same
			#$ref_stat_cur = $ref_stat_cur;
			$ref_stat_new = [ @src_stat_tmp ];
		}
		elsif ($doit==1)
		{
			# Keep $src_name_tmp

			# Nothing more to be done; keep reference the same
			#$ref_stat_cur = $ref_stat_cur;
			$ref_stat_new = [ @src_stat_tmp ];
		}
		elsif ($doit==2)
		{
			# Rename $src_name_tmp to $dst_name_full
			rename_anything($src_name_tmp,
				$dst_name_full, \@src_stat_tmp,
				$error) or return(0);

			# change reference
			$ref_stat_cur = [ @src_stat_tmp ];
			$ref_stat_new = $ref_stat_cur;
			$dst_stat = $ref_stat_cur;
		}
		elsif ($doit==3)
		{
			if ($#$dst_stat != -1)
			{
				# Rename $dst_name_full to $dst_name_old
				my $dst_name_old=$dst_name_full.".ai-old";
				rename_anything($dst_name_full,
					$dst_name_old,$dst_stat,
					$error) or return(0);
			}

			# Rename $src_name_tmp to $dst_name_full
			rename_anything($src_name_tmp,
				$dst_name_full,\@src_stat_tmp,
				$error) or return(0);

			# change reference
			$ref_stat_cur = [ @src_stat_tmp ];
			$ref_stat_new = $ref_stat_cur;
			$dst_stat = $ref_stat_cur;
		}
		else { die "Unknown doit for $src_name_rel: $doit"; };

		if (!$OPTIONS->{"noaction"})
		{ 
			record_file($dst_name_rel,$ADST,
				$ref_stat_cur,$ref_stat_new,
				$error)
				or return(0);
		}

		$file_det_cur_src->{$dst_name_rel} = $ref_stat_cur;
		$file_det_new_src->{$dst_name_rel} = $ref_stat_new;
	}
	return(1);
}

sub getfiletype
{
	my $file = shift;
	return "symlink" if (-l $file);
	return "file" if (-f $file);
	return "device" if (-p $file or -b $file or -c $file or -S $file);
	return "dir" if (-d $file);
	return "deleted" if ( ! -e $file);

	# Should NEVER get here
	die "File $file is of unknown file type";
}

sub mylstat
{
	my $file=shift;
	my $error=shift;
	my @stat;
	my @emptylist = ();
	my $filetype = getfiletype($file);

	die if (!ref($error) or defined ($$error));

	@stat = lstat($file);
	if ($#stat == -1)
	{
		$$error="error"->new("error"->general,
			"Cannot lstat $file: $!");
		return(@emptylist);
	}

	if ($filetype eq "symlink")
	{
		my $link=readlink($file);
		if (!defined($link))
		{
			$$error="error"->new("error"->general,
				"Cannot read symlink $file: $!");
			return(@emptylist);
		}
		$stat[13]=$link;
	}
	elsif ($filetype eq "file")
	{
		my $rc=open(FILE,"<".$file);
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot open file ".$file." for reading: $!");
			return(0);
		}

		my $md5 = new MD5;
		$md5->reset;
		$md5->addfile(\*FILE);
		$stat[13] = $md5->hexdigest;

		$rc=close(FILE);
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot close file ".$file.": $!");
				return(0);
		}
	}
	$stat[14]=$filetype;

	for (my $i=0; $i<=14; $i++)
	{
		$stat[$i] = "" if (!defined($stat[$i]));
	}

	return(@stat);
}

sub mylstat_getfiletype
{
	my $stat = shift;
	return($stat->[14]);
}

# Compares status information of two files generated my mylstat
sub compare_stat
{
	my $dst_stat = shift;
	my $ref_stat = shift;

#	0 dev      device number of filesystem
#	1 ino      inode number
#	2 mode     file mode  (type and permissions)
#	3 nlink    number of (hard) links to the file
#	4 uid      numeric user ID of file's owner
#	5 gid      numeric group ID of file's owner
#	6 rdev     the device identifier (special files only)
#	7 size     total size of file, in bytes
#	8 atime    last access time since the epoch
#	9 mtime    last modify time since the epoch
#	10 ctime    inode change time (NOT creation time!) since the epoch
#	11 blksize  preferred block size for file system I/O
#	12 blocks   actual number of blocks allocated
#	13 myfield

	return "deleted" if (!defined($dst_stat));
	return "deleted" if ($#{$dst_stat} eq -1);
	return "created" if (!defined($ref_stat));
	return "created" if ($#{$ref_stat} eq -1);

	return "changed" if (defined($ref_stat->[14]) and $dst_stat->[14] ne $ref_stat->[14]);
	my $type = $ref_stat->[14];
	$type = $dst_stat->[14] if (!defined($type));
	die "Cannot determine file type" if (!defined($type));

	# assume devices never change. This isn't good, but same device
	# permisions change all the time anyway under normal use. (eg tty*)
	# NOTE: should we somehow check the device ID is the same? Is
	# this one of the values already in ref_stat and dst_stat returned
	# from mylstat???
	return "same" if ($type eq "device");

	# Remove date and time comparision - this is no longer required
	# and breaks when source is under CVS.
	# return "newer"   if ($dst_stat->[9] >  $ref_stat->[9] and $type ne "dir" and $type ne "symlink");
	# return "older"   if ($dst_stat->[9] <  $ref_stat->[9] and $type ne "dir" and $type ne "symlink");

	return "changed" if ($dst_stat->[7] != $ref_stat->[7] and $type ne "dir" and $type ne "symlink");
	return "changed" if ($dst_stat->[2] != $ref_stat->[2]);
	return "changed" if ($dst_stat->[4] != $ref_stat->[4]);
	return "changed" if ($dst_stat->[5] != $ref_stat->[5]);
	return "changed" if (defined($ref_stat->[13]) and $ref_stat->[13] ne "" and $dst_stat->[13] ne $ref_stat->[13]);
	return "same";
}

# 0 = Don't do it - leave unchanged; delete file.ai-new
# 1 = Don't do it but save new; Leave file.ai-new file
# 2 = Do it don't save old; Rename file to file.ai-old and file.ai-new to file
# 3 = Do it but save old; Rename file to file.ai-old and file.ai-new to file
sub doit
{
	my $src_name_full = shift;
	my $dst_name_full = shift;
	my $src_status = shift;
	my $dst_status = shift;

	print "$src_name_full: $src_status; $dst_name_full: $dst_status\n"
		if ($src_status ne "same" or $dst_status ne "same");

	if ($src_status eq "created" and $dst_status eq "created")
	{
		return(askreplacenewer($src_name_full,$dst_name_full,$src_status,$dst_status));
	}
	elsif ($src_status eq "created" and $dst_status eq "deleted")
	{
		return($OPTIONS->{"force_create"} || 2);
	}
	elsif ($src_status eq "same")
	{
		return($OPTIONS->{"force_src_same"} || 0);
	}
# WHAT WAS THIS HERE FOR????
#	elsif ($dst_status eq "deleted")
#	{
#		return($OPTIONS->{"force_recreate"} || 0);
#	}
	elsif ($dst_status eq "same")
	{
		return 2;
	}
	elsif ($src_status eq "newer")
	{
		return(askreplacenewer($src_name_full,$dst_name_full,$src_status,$dst_status));
	}
	elsif ($src_status eq "older")
	{
		return(askreplacenewer($src_name_full,$dst_name_full,$src_status,$dst_status));
	}
	elsif ($src_status eq "changed")
	{
		return(askreplacenewer($src_name_full,$dst_name_full,$src_status,$dst_status));
	}
	elsif ($src_status eq "deleted")
	{
		return(askreplacenewer($src_name_full,$dst_name_full,$src_status,$dst_status));
	}
	return(0);
}
	
sub askreplacenewer
{
	my $src_name_full = shift;
	my $dst_name_full = shift;
	my $src_status = shift;
	my $dst_status = shift;

	return($OPTIONS->{"force_src_".$src_status}) 
		if (defined($OPTIONS->{"force_src_".$src_status}));

	my $reply;
	while (1)
	{
		print "\n";
		print "File $dst_name_full has changed.\n"
				if ($dst_status ne "deleted");
		print "File $dst_name_full has been deleted.\n"
				if ($dst_status eq "deleted");
		print "Is it ok to replace it with the $src_status version $src_name_full?\n"
				if ($src_status ne "deleted");
		print "Is it ok to delete it?\n"
				if ($src_status eq "deleted");
		print "The old file will be saved as $dst_name_full.ai-old.\n"
				if ($dst_status ne "deleted");
		print "Answer with (Yes/Always yes/No/always nO): ";
		$reply=<STDIN>; chop($reply);
		$reply=lc($reply);

		if ($reply eq "a")
		{
			$OPTIONS->{"force_src_".$src_status}=3;
		}
		elsif ($reply eq "o")
		{
			$OPTIONS->{"force_src_".$src_status}=1;
		}
		return (3) if ($reply eq "y" or $reply eq "a");
		return (1) if ($reply eq "n" or $reply eq "o");
		print "Invalid response; try again.\n";
	}
}

# Copy file attributes
sub copy_attrib
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $umask=shift || 0;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

#	0 dev      device number of filesystem
#	1 ino      inode number
#	2 mode     file mode  (type and permissions)
#	3 nlink    number of (hard) links to the file
#	4 uid      numeric user ID of file's owner
#	5 gid      numeric group ID of file's owner
#	6 rdev     the device identifier (special files only)
#	7 size     total size of file, in bytes
#	8 atime    last access time since the epoch
#	9 mtime    last modify time since the epoch
#	10 ctime    inode change time (NOT creation time!) since the epoch
#	11 blksize  preferred block size for file system I/O

	$src_stat->[2] = $src_stat->[2] & ~$umask;
	my $safe_mode = $src_stat->[2] & oct(1777);
	$rc=chmod($safe_mode,$dst_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot chmod $dst_name_full (safe): $!");
		return(0);
	}
	if (chown($src_stat->[4],$src_stat->[5],$dst_name_full))
	{
		# If can set owner, turn on SetUID as required
		$rc=chmod($src_stat->[2],$dst_name_full);
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot chmod $dst_name_full: $!");
			return(0);
		}
	}
	$rc=utime($src_stat->[8],$src_stat->[9],$dst_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot set time of $dst_name_full: $!");
		return(0);
	}
	return 1;
}

# Copy/convert anytype of file depending on $action
sub copy_anything
{
	my $action=shift;
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $ASRC=shift;
	my $ADST=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $filetype = mylstat_getfiletype($src_stat);
	if ($action eq "convert")
        {
		return convert_file($src_name_full,$dst_name_full,$ASRC,$ADST,
			$src_stat,$error);
	}
	elsif ($action ne "copy")
	{
		die "Unknown action for $src_name_full: $action";
	}
	elsif ($filetype eq "file")
        {
		return copy_file($src_name_full,$dst_name_full,
			$src_stat,$error);
	}
	elsif($filetype eq "symlink")
        {
		return copy_slink($src_name_full,$dst_name_full,
			$src_stat,0,$error);
	}
	elsif($filetype eq "dir")
        {
		return copy_dir($src_name_full,$dst_name_full,
			$src_stat,0,$error);
	}
	elsif($filetype eq "device")
        {
		return copy_device($src_name_full,$dst_name_full,
			$src_stat,$error);
	}
	elsif($filetype eq "deleted")
	{
		die "Request to copy deleted file $src_name_full to $dst_name_full";
	}
	else {die "Unknown filetype for $src_name_full: $filetype"; }
}

# Convert file using user defined conversion routine
sub convert_file
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $ASRC=shift;
	my $ADST=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;
	
	if ($OPTIONS->{"noaction"})
	{ 
		print "would convert file $src_name_full --> $dst_name_full\n";
		return(1);
	}

	print "convert file $src_name_full --> $dst_name_full\n";
	delete_file($dst_name_full,$error) or return(0);

	$rc = &{$OPTIONS->{"convert"}}($src_name_full,
			$dst_name_full,$ASRC,$ADST,$error);
	if (!$rc)
	{
		my $tmperror;
		delete_file($dst_name_full,\$tmperror);
		return(0);
	}
	
	copy_attrib($src_name_full,$dst_name_full,$src_stat,
			0,$error)
		 or return(0);

	return(1);
}

# Copy a file
sub copy_file
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

	if ($OPTIONS->{"noaction"})
	{ 
		print "would copy file $src_name_full --> $dst_name_full\n";
		return(1);
	}

	print "copy file $src_name_full --> $dst_name_full\n";
	delete_file($dst_name_full,$error) or return(0);

	$rc=open(SRC,"<".$src_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot open $src_name_full for reading: $!");
		return(0);
	}
	$rc=open(DST,">".$dst_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot open $dst_name_full for writing: $!");
		return(0);
	}
	binmode(SRC);
	binmode(DST);
	
	while(1)
	{
		my $data;
		$rc = read(SRC,$data,10240);
		if (!defined($rc))
		{
			$$error="error"->new("error"->general,
				"Cannot read from $src_name_full: $!");
			return(0);
		}
		last if ($rc <= 0);
		$rc=print(DST $data);
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot write to $dst_name_full: $!");
			return(0);
		}
	}
	
	$rc=close(SRC);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot close $src_name_full: $!");
		return(0);
	}
	$rc=close(DST);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot close $dst_name_full: $!");
		return(0);
	}
	copy_attrib($src_name_full,$dst_name_full,$src_stat,
			0,$error)
		 or return(0);

	return(1);
}

# Copy symlink
sub copy_slink
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $rename = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

	if ($OPTIONS->{"noaction"})
	{ 
		print "would copy symlink $src_name_full --> $dst_name_full\n"
			if (!$rename);
		print "would move symlink $src_name_full --> $dst_name_full\n"
			if ($rename);
	}

	print "copy symlink $src_name_full --> $dst_name_full\n"
		if (!$rename);
	print "move symlink $src_name_full --> $dst_name_full\n"
		if ($rename);

	delete_file($dst_name_full,$error) or return(0);
	my $link=readlink($src_name_full);
	if (!defined($link))
	{
		$$error="error"->new("error"->general,
			"Cannot read symlink $src_name_full: $!");
		return(0);
	}
	$rc=symlink($link,$dst_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot write symlink $dst_name_full: $!");
		return(0);
	}
	chown($src_stat->[4],$src_stat->[5],$dst_name_full);

	if ($rename)
	{
		# simulate rename by copy and delete
		$rc=unlink($src_name_full);
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot delete $src_name_full: $!");
			return(0);
		}
	}

	return(1);
}

# Copy directory
sub copy_dir
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $rename = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc;

	if ($OPTIONS->{"noaction"})
	{ 
		print "would copy dir $src_name_full --> $dst_name_full\n"
			if (!$rename);
		print "would move dir $src_name_full --> $dst_name_full\n"
			if ($rename);
		return(1);
	}

	print "copy dir $src_name_full --> $dst_name_full\n"
		if (!$rename);
	print "move dir $src_name_full --> $dst_name_full\n"
		if ($rename);

	if ( getfiletype($dst_name_full) ne "dir" )
	{
		delete_file($dst_name_full,$error) or
			return(0);
		$rc=mkdir($dst_name_full,oct(700));
		if (!$rc)
		{
			$$error="error"->new("error"->general,
				"Cannot mkdir $dst_name_full: $!");
			return(0);
		}
	}

	copy_attrib($src_name_full,$dst_name_full,$src_stat,
			0,$error)
		 or return(0);

	if ($rename)
	{
		# simulate rename by copy and delete
		$rc=rmdir($src_name_full);

		# ignore errors if directory is not empty, in this
		# case we probably didn't want to remove it anyway.
		#if (!$rc)
		#{
		#	$$error="error"->new("error"->general,
		#		"Cannot delete $src_name_full: $!");
		#	return(0);
		#}
	}

	return(1);
}

# Inefficient device copying
# NOTE: This should be improved to remove need to call external
#	cp program.
sub copy_device
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	if ($OPTIONS->{"noaction"})
	{ 
		print "would copy device $src_name_full --> $dst_name_full\n";
		return(1);
	}

	print "copy device $src_name_full --> $dst_name_full\n";
	delete_file($dst_name_full,$error) or
		return(0);

	my $rc = system("cp","-a",$src_name_full,$dst_name_full);
	if ($rc != 0)
	{
		$$error="error"->process("Copying device with cp failed",$?);
		return(0);
	}
#	copy_attrib($src_name_full,$dst_name_full,$src_stat,
#			$OPTIONS->{"copy_device:umask"},$error)
#		 or return(0);

	return(1);
}

# "Rename" any type of file
sub rename_anything
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $filetype = mylstat_getfiletype($src_stat);
	if ($filetype eq "file")
        {
		return rename_file($src_name_full,$dst_name_full,
			$src_stat,$error);
	}
	elsif($filetype eq "symlink")
        {
		return copy_slink($src_name_full,$dst_name_full,
			$src_stat,1,$error);
	}
	elsif($filetype eq "dir")
        {
		return copy_dir($src_name_full,$dst_name_full,
			$src_stat,1,$error);
	}
	elsif($filetype eq "device")
        {
		return rename_device($src_name_full,$dst_name_full,
			$src_stat,$error);
	}
	elsif($filetype eq "deleted")
	{
		die "Request to rename deleted file $src_name_full to $dst_name_full";
	}
	else {die "Unknown filetype for $src_name_full: $filetype"; }
}

# Copy a file
sub rename_file
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	if ($OPTIONS->{"noaction"})
	{ 
		print "would rename file $src_name_full --> $dst_name_full\n";
		return(1);
	}

	print "rename file $src_name_full --> $dst_name_full\n";
	delete_file($dst_name_full,$error) or return(0);
	my $rc=rename($src_name_full,$dst_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot rename $src_name_full".
			" to $dst_name_full: $!");
		return(0);
	}
	return(1);
}

sub rename_device
{
	my $src_name_full=shift;
	my $dst_name_full=shift;
	my $src_stat = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	if ($OPTIONS->{"noaction"})
	{ 
		print "would rename device $src_name_full --> $dst_name_full\n";
		return(1);
	}

	print "rename device $src_name_full --> $dst_name_full\n";
	delete_file($dst_name_full,$error) or return(0);
	my $rc=rename($src_name_full,$dst_name_full);
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot rename $src_name_full".
			" to $dst_name_full: $!");
		return(0);
	}
	return(1);
}

# delete a file/dir/etc
sub delete_file
{
	my $dst = shift;
	my $error = shift;

	die if (!ref($error) or defined ($$error));

	my $rc=1;

	if ( -l $dst )
	{
		$rc=unlink($dst);
	}
	elsif ( -f $dst)
	{
		$rc=unlink($dst);
	}
	elsif ( -p $dst or -b $dst or -c $dst or -S $dst )
	{
		$rc=unlink($dst);
	}
	elsif ( -d $dst )
	{
		$rc=rmdir($dst);
	}
	if (!$rc)
	{
		$$error="error"->new("error"->general,
			"Cannot delete $dst: $!");
		return(0);
	}
	return 1;
}