;#
;# Copyright (c) 1995-1997
;#	Ikuo Nakagawa. All rights reserved.
;#
;# Redistribution and use in source and binary forms, with or without
;# modification, are permitted provided that the following conditions
;# are met:
;#
;# 1. Redistributions of source code must retain the above copyright
;#    notice unmodified, this list of conditions, and the following
;#    disclaimer.
;# 2. Redistributions in binary form must reproduce the above copyright
;#    notice, this list of conditions and the following disclaimer in the
;#    documentation and/or other materials provided with the distribution.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS
;# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
;# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;#
;# $Id: DIR.pm,v 1.12 1997/09/09 22:04:58 ikuo Exp $
;#
package Fan::DIR;

use strict;
use vars qw($VERSION $LOG %required %typemap %typerev);


use Fan::Attrib;
use Fan::Cool;
use AutoLoader 'AUTOLOAD';

$VERSION = '0.01';
$LOG = 5;

;#
@typemap{qw(directory symlink file)} = qw(D L F);
@typerev{qw(D L F)} = qw(directory symlink file);
@required{qw(D L F)} = (
	[ qw(mode owner group begin-update end-update) ],
	[ qw(mode owner group linkto) ],
	[ qw(mode owner group modified size md5checksum) ] );


;# A special marker for AutoSplit.
1;
__END__

;#
;# create a DIR object.
;#	$dir = DIR->new(directory => "/ftp/pub/utils");
;#
sub new ($%) {
	my $this = shift;
	my $class = ref($this) || $this;
	my %params = @_;
	my $self = \%params;
	bless $self, $class;
	carp("DIR CREATING $self") if $LOG > 5;
	$self->{dir_hash} = {}; # empty hash
	$self->{dir_array} = []; # empty array
	$self;
}

;#
sub DESTROY ($) {
	my $self = shift;
	my $name;
	for $name (keys %{$self->{entires}}) {
		delete($self->{dir_hash}->{$name}); # delete Attribs
	}
	carp("DIR DESTROYING $self") if $LOG > 5;
}

;#
sub get ($$) {
	my $self = shift;
	my $name = shift;

	exists($self->{dir_hash}->{$name}) &&
		ref($self->{dir_hash}->{$name}) eq 'Fan::Attrib' ?
		$self->{dir_hash}->{$name} : undef;
}

;#
sub add ($$) {
	my $self = shift;
	my $y = shift;

	$self->{dir_hash}->{$y->name} = $y if ref($y) eq 'Fan::Attrib';
	$y;
}

;#
sub delete ($$) {
	my $self = shift;
	my $name = shift;

	delete($self->{dir_hash}->{$name});
}

;#
sub index ($) {
	my $self = shift;

	@{$self->{dir_array}};
}

;#
;# Load entries from a file, and fill %{$self->{dir_hash}}.
;# $dir = DIR->new(dir_path => $directory);
;# $dir->load;
;#
;# You can specify a filename rather than a directory name.
;# $dir->load("$temp/tmp_dirinfo");
;#
sub load ($$) {
	my $self = shift;
	my $dir = @_ ? shift : $self->{dir_path};
	my $dirinfo = -d $dir ? "$dir/.dirinfo" : $dir;
	my %assoc = ();
	local(*FILE, $_);

	# get directory info if exists
	-f $dirinfo or warn("$dirinfo is not a plain file."), return undef;
	open(FILE, $dirinfo) or warn("open($dirinfo): $!"), return undef;

	#
	my $pp = undef;
	while (<FILE>) {
		s/^\s+//; s/\s+$//; next if /^$/ || /^#/;
		/\s*=\s*/ || next;
		my($key, $val) = ($`, $');
		if (defined($typemap{$key})) {
			$pp = \%{$assoc{$val}};
			$pp->{y_type} = $typemap{$key};
			$pp->{y_name} = $val;
		} elsif ($key eq 'modified') {
			$pp->{y_mtime} = $val;
		} elsif ($key eq 'mode') {
			$pp->{y_perm} = oct($val);
		} elsif ($key eq 'owner') {
			my $u = getpwnam($val) if $val !~ /^\d+$/;
			$val = $u if $u ne '';
			$pp->{y_owner} = $val;
		} elsif ($key eq 'group') {
			my $g = getgrnam($val) if $val !~ /^\d+$/;
			$val = $g if $g ne '';
			$pp->{y_group} = $val;
		} elsif ($key eq 'md5checksum') {
			$pp->{y_checksum} = $val if $val =~ /^[a-f0-9]{32}$/;
		} else { # others...
			$key =~ tr/-/_/;
			$pp->{"y_$key"} = $val;
		}
	}
	close(FILE);

	# DO NOT clear hash, but clean array
	# $self->{dir_hash} = {};
	$self->{dir_array} = [];

	# register all entires..
	my $name;
	for $name (sort keys %assoc) {
		next if $name eq '' || $name eq '.' || $name eq '..';
		next if $name /\//;
		my $y = Fan::Attrib->new(%{$assoc{$name}});
		if (defined($y) && ref($y) eq 'Fan::Attrib') {
			$self->add($y);
# warn("load: $name... added\n") if $LOG > 7;
			push(@{$self->{dir_array}}, $name);
		} else {
			warn("Can't create Fan::Attrib object.");
		}
	}

	# success value
	1;
}

;#
;# fill directory information to $self->{dir_hash}.
;# make_dirinfo sets values of begin-update / end-update for directories
;# if and only if old dirinfo contains them.
;# Other values are re-generated by make_dirinfo.
;#
sub fill ($$) {
	my $self = shift;
	my $dir = shift;

	# Calculating MD5 checksum is very slow...
	# We can choose calculate it or not.
	my $no_md5 = $self->{ignore_md5checksum};

	local(*DIR, $[, $_);

	# check directory
	$dir ne '' && -d $dir
		or warn("dir is not a directory"), return undef;

	# get directory entries
	opendir(DIR, $dir)
		or carp("opendir($dir): $!"), return undef;
	my @list = sort readdir(DIR);
	closedir(DIR);

	# DO NOT clear my entries...
	# $self->{dir_hash} = {};
	$self->{dir_array} = [];

	# checking all entries
	my $file;
	for $file (@list) {
		next if $file eq '' || $file eq '.' || $file eq '..';
		next if $file =~ /^\.dirinfo/;
		next if $file =~ /\//;
		my $z = $self->get($file);
		my $y = Fan::Attrib->new(attr_path => "$dir/$file");
		unless (defined($y) && ref($y) eq 'Fan::Attrib') {
			warn("Can't create attrib object."), next;
		}
		$y->fill_checksum;
		if ($z) {
			$z->copyfrom($y); # in overwrite mode.
		} else {
			$self->add($y);
		}
# warn("fill: $file... added\n") if $LOG > 7;
		push(@{$self->{dir_array}}, $file); # register file name
	} # end of for $file (@list) { ... }

	#
	1;
}

;# Write directory information(in %{$self->{dir_hash}})
;# to the file.
;# $dir = DIR->new($directory);
;# $dir->fill;
;# $dir->store;
;#
;# This routine will return zero if nothing has been modified,
;# or non-zero value will be returned.
sub store ($;$) {
	my $self = shift;
	my $dir = @_ ? shift : $self->{dir_path};
	my $dirinfo = -d $dir ? "$dir/.dirinfo" : $dir;
	my $temp = "$dirinfo.$$";
	local(*FILE, *TEMP, $_);

	# next, we open the file with write mode
	open(TEMP, ">$temp")
		or carp("open($temp): $!"), return undef;

	# current directory information
	my $y;
	if (defined($y = $self->get('.'))) {
		&putdata($y, \*TEMP);
	}

	#
	my $name;
	for $name (@{$self->{dir_array}}) {
		$y = $self->get($name);

		# check filename
		# we hate illegal filenames, but '.' is a special filename
		# which contains current directory information.
		# shall we store information for '.' first?
		next if $name eq '' || $name eq '.' || $name eq '..';
		next if $name =~ /^\.dirinfo/;
		next if $name =~ /\//;

# warn("store: ".$y->name."...\n") if $LOG > 7;
		&putdata($y, \*TEMP);
	}

	# close temporary info file once.
	close(TEMP);

	# comapre old and new files.
	if (open(FILE, $dirinfo) && open(TEMP, $temp)) {
		my $comp = 0;
		my $cont = 1;
		while ($cont) {
			$cont = 0;
			my $x = <FILE>;
			my $y = <TEMP>;
			if (defined($x) && defined($y)) {
				$x =~ s/\s+$//;
				$y =~ s/\s+$//;
				$cont++ if !($comp = $x cmp $y);
			} else {
				$comp = defined($x) || defined($y);
			}
		}
		close(FILE); close(TEMP);
		if (!$comp) {
			warn("$dir: no change\n") if $LOG > 6;
			unlink($temp), return 0; ## NO CHANGE
		}
	}

	# Now, we try to rename from temporary file to the real one.
	if (!rename($temp, $dirinfo)) {
		unlink($temp);
		warn("rename($temp, $dirinfo): $!\n") if $LOG > 4;
		return undef;
	}

	# We have changed!
	warn("store: $dir was updated") if $LOG > 6;
	return 1; # CHANGED
}

;#
;# update dirinfo recursively
;# update_dirinfo returns 1 iff any change was found.
;#
sub update {
	my $self = shift;
	my $dir = @_ ? shift : $self->{dir_path};
	local(*DIR, $[, $_);
	my($old, $new, @stat, @list);
	my $dirinfo = "$dir/.dirinfo";

	# check directory
	$dir ne '' && -d $dir
		or warn("dir is not a directory"), return undef;

	# generate entires.
	$self->load($dir); # load old values...
	$self->fill($dir); # and merge new values.

	# entries...
	my $file;
	for $file (@{$self->{dir_array}}) {
		next if $file eq '' || $file eq '.' || $file eq '..';
		next if $file =~ /^\.dirinfo/;
		next if $file =~ /\//;	# must not contain '/'

		my $y = $self->get($file);
		next if $y->type ne 'D';

		my $t = time; # current time.
		my $kid = $self->new;

		if ($kid->update("$dir/$file") ||
			!defined($y->{y_begin_update}) ||
			!defined($y->{y_end_update})) {
			$y->{y_begin_update} = $t;
			$y->{y_end_update} = time;
		}
	} # end of for $file (@list) { ... }

	# return value is that of store.
	$self->store($dir);
}

;#
sub putdata {
	my $y = shift; # is Fan::Attrib object.
	my $out = shift; # must be a file handle.

	printf $out "%s = %s\n", $typerev{$y->type}, $y->name;

	my $key;
	for $key (@{$required{$y->type}}) {
		my $tmp = $key;
		$tmp =~ tr/-/_/;
		$tmp = "checksum" if $key eq 'md5checksum';
		$tmp = "y_$tmp";
		if ($key eq 'mode') {
			printf $out " $key = %04o\n", $y->{y_perm};
		} elsif ($key eq 'modified') {
			printf $out " $key = %d\n", $y->{y_mtime};
		} else {
			printf $out " %s = %s\n", $key, $y->{$tmp};
		}
	}
}

;# end of Fan::DIR module


syntax highlighted by Code2HTML, v. 0.9.1