;#
;# 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: Scan.pm,v 1.21 1998/10/10 11:31:10 ikuo Exp $
;#
;# For example, to list up all directories and files in
;# servers tree;
;#
;#	use Fan::FTP;
;#	use Fan::Scan;
;#
;#	$ftp = Fan::FTP->new(ftp_server = 'ftp.freebsd.org');
;#	$scan = Fan::Scan->new(
;#		scan_type => 'FTP',
;#		scan_ftp => $ftp,
;#		scan_dir => '/pub/FreeBSD' );
;#	while (defined($p = $scan->get)) {
;#		last if $p->type eq '.';
;#		print $p->path."\n" if $p->type ne 'U';
;#	}
;#
package Fan::Scan;

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

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

$VERSION = '0.04';
$LOG = 5 unless defined($LOG);

;#
$path_gzip = &findpath("gzip");
$path_compress = &findpath("compress");

;# A special marker for AutoSplit.
1;
__END__

;#
sub findpath ($) {
	my $foo = shift;
	my @path = split(':', $ENV{'PATH'});

	# append some system specific directories...
	push(@path, qw(
		/usr/ucb
		/usr/ccs
		/usr/local/bin
		/usr/gnu/bin
		/usr/contrib/bin
		/opt/local/bin
		/opt/gnu/bin
		/opt/contrib/bin));

	# check existence of the executable.
	for my $d (@path) {
		return "$d/$foo" if -x "$d/$foo" && ! -d _;
	}

	# return itself if executables were not found.
	$foo;
}

;# Destroy Scan object...
;#
sub DESTROY ($) {
	my $self = shift;

	# Close any files first (if we have).
	$self->close;

	# Log message.
	carp("Scan DESTROYING $self") if $LOG > 5;
}

;#
;# search a directory information for the specified directory.
;# usage:
;#	scan_type :
;#		LOCAL ... scan_dir
;#		INDEX ... scan_index
;#		LSLR  ... scan_lslR
;#		FTP   ... scan_ftp, scan_dir
;#		HTTP  ... scan_ftp, scan_dir
;#	$scan = Fan::Scan->new(
;#		scan_type => LSLR,
;#		scan_lslR => "ls-lR.gz" );
;#
sub new ($%) {
	my $this = shift;
	my $class = ref($this) || $this;
	my %params = @_;
	my $self = {};
	bless $self, $class;

	# copy any scan parameter.
	for my $tag (keys %params) {
		$self->{$tag} = $params{$tag} if $tag =~ /^scan_/;
	}

	# Find out scan type.
	my $t = $self->{scan_type};

	# Check types...
	if (!defined($t)) { # not found.
		carp("No scan_type defined"), return undef;
	} elsif ($t eq 'LOCAL') { # scan local directory
		$self->{scan_dir} ne '' && -d $self->{scan_dir}
			or carp("No local directory"), return undef;
	} elsif ($t eq 'FTP') {
		ref($self->{scan_ftp}) # must be some module
			or carp("No scan_ftp"), return undef;
		$self->{scan_dir} ne ''
			or carp("No scan_dir"), return undef;
	} elsif ($t eq 'INDEX') {
		$self->open($self->{scan_index})
			or carp("open(scan_index): $!"), return undef;
	} elsif ($t eq 'LSLR') {
		$self->open($self->{scan_lslR})
			or carp("open(scan_lslR): $!"), return undef;
	} else {
		carp("Scan does not know method"), return undef;
	}

	# cleanup
	delete($self->{endoffile});
	delete($self->{founderror});
	delete($self->{subst});
	delete($self->{hold});
	$self->{magic_array} = {};
	$self->{cur_info} = {};
	$self->{dirs} = [];
	$self->{lslR_curdir} = '.';
	$self->{scan_filter} = [];

	# Log message.
	carp("Scan CREATING $self") if $LOG > 5;

	# Return myself
	$self;
}

;#
;# To get the current working directory, use $p->where.
;# It tells where you are.
;#
sub where ($) {
	my $self = shift;

	exists($self->{walk_curdir}) ? $self->{walk_curdir} : undef;
}

;#
;# $p->start initialize all variables used by `where', `up',
;# and `down'. This routine must be called before you call
;# these routines.
;#
sub start ($) {
	my $self = shift;

	# DEBUG purpose only.
	confess("$self->{walk_curdir} exists in stack")
		if exists($self->{walk_curdir});

	# initial current walk directory is '.'.
	$self->{walk_curdir} = '.';

	# DEBUG mode only
	warn("Scan +DIR=. (start)\n") if $LOG > 7;

	# result is current directory
	$self->{walk_curdir};
}

;#
;# $p->end is useful for the aftercare and validation of
;# directory stack operations.
;# This routine should be called at last of your directory
;# stack operations.
;#
sub end ($) {
	my $self = shift;

	# DEBUG purpose only.
	confess("$self->{walk_curdir}: remains in stack")
		unless ($self->{walk_curdir} eq '.');

	# clean work directory entry
	delete($self->{walk_curdir});

	# DEBUG mode only
	warn("Scan -DIR=. (end)\n") if $LOG > 7;

	# result is current directory
	undef;
}

;#
;# You can go to DOWN stair with $p->down(you_want_to_go).
;# you_want_to_go must no contains a slash(== `/').
;# Additionally, it must not be a null string, `.' or `..'.
;#
sub down ($$) {
	my $self = shift;
	my $dir = shift; # you_want_to_go

	# DEBUG purpose only.
	confess("$dir: illegal directory name")
		if $dir eq '' || $dir eq '.' || $dir eq '..' || $dir =~ /\//;

	# go down one directory
	$self->{walk_curdir} .= '/'.$dir;

	# DEBUG mode only
	warn("Scan +DIR=$self->{walk_curdir}\n") if $LOG > 7;

	# result is current directory
	$self->{walk_curdir};
}

;#
;# You can go to UP stair with $p->up.
;#
sub up ($) {
	my $self = shift;

	# DEBUG purpose.
	confess("$self->{walk_curdir}: no upper directory")
		unless $self->{walk_curdir} =~ s|/[^/]+$||;

	# DEBUG mode only.
	warn("Scan -DIR=$self->{walk_curdir}\n") if $LOG > 7;

	# result is current directory
	$self->{walk_curdir};
}

;#
;# Scan::open
;# Open a file, which may be .gz or .Z compressed file.
;#
sub open ($$) {
	my $self = shift;
	my $file = shift;

	# close first
	$self->close;

	# check filter
	if (ref($file) ne 'GLOB') {
		my $a = $file =~ /\.gz$/ ? "$path_gzip -cd $file|" :
			$file =~ /\.Z$/ ? "$path_compress -cd $file|" :
			-f $file ? $file :
			-f "$file.gz" ? "$path_gzip -cd $file.gz|" :
			-f "$file.Z" ? "$path_compress -cd $file.Z|" :
			$file;

		# local file handle.
		local *FILE;

		# Now, try to open.
		unless (CORE::open(FILE, $a)) {
			carp("CORE::open($a): $!");
			return undef;
		}

# warn("open[".fileno(*FILE)."] $a: o.k.\n");

		# mark as OPENED file.
		$self->{needclose}++;

		# now store to $file.
		$file = *FILE;
	}

	# Register the file handle
	$self->{handle} = $file;

	# Increment # of objects
	$n_object++;

	# Success
	1;
}

;# close file handle if needed.
;#
sub close ($) {
	my $self = shift;

	if ($self->{needclose} && exists($self->{handle})) {
		CORE::close($self->{handle});
	}
	$self->{needclose} = 0;
	delete($self->{handle});
	1;
}

;#
;# Add a filter to Scan object.
;#
sub add_filter ($@) {
	my $self = shift;
	my @args = @_;
	my $c = $args[$[];

	if (ref($c) ne 'CODE') {
		carp("$self->add_filter: $c must be a CODE");
		return undef;
	}
	push(@{$self->{scan_filter}}, \@args);
}

;#
;# clear filter
;#
sub clr_filter ($) {
	my $self = shift;

	$self->{scan_filter} = [];
}

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

	# for DEBUG mode only.
	confess("$y must be Attrib")
		unless ref($y) && $y->isa('Fan::Attrib');

	# loop over all scan_filter or finding mismatch.
	for my $filter (@{$self->{scan_filter}}) {
		my($c, @args) = @{$filter};
		# for DEBUG mode only.
		confess("$c must be CODE") unless ref($c) eq 'CODE';
		# try to perform filter...
		&{$c}($y, @args) || return 0;
	}

	# all filter functions return ok
	1;
}

;# Unget means, save current value to hold buffer.
;# Next get operation may returns this.
sub unget ($$) {
	my $self = shift;

	$self->{hold} = shift;
}

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

	# If there is an entry in hold buffer, we return it.
	delete($self->{hold}), return $y if defined($y = $self->{hold});

	# Get one!
	# When a directory object was marked as 'IGNORED' by filter,
	# we should ignore any additional files in that directory.
	my $ignore_nest = 0;
	while (defined($y = $self->getone)) {

		warn($y->to_line."\n") if $LOG >= 8; # in full debug mode

		# Check if we are in an ignored directory.
		if ($ignore_nest > 0) {
			$ignore_nest-- if $y->type eq 'U';
			$y->flag('!'); # and skip this entry.
		}

		# Shall we return this attrib object?
		if ($y->flag eq '!') {
			$self->{ignore_nest}++ if $y->type eq 'D';
		} else {
			last; # 
		}
	}

	# Check error.
	if (!defined($y)) {
		if ($self->{founderror}) {
			# This may be dangerous, so we should terminate
			# any processing.
			croak("Scan::get: error was detected");
		}
	}

	# The result
	$y;
}

;#
;# Get a single entry from index tree.
;#
sub getone ($) {
	my $self = shift;
	my $y;

	# Check end-of-file or error.
	return undef if $self->{endofdata} || $self->{founderror};

	# Check array reference. Error in next statement is critical.
	if (ref($self->{dirs}) ne 'ARRAY') {
		confess("\$self->{dirs} must be ARRAY");
	}

	# Try to parse and store to $y.
	$y = $self->{scan_index} ? $self->get_index : $self->get_misc;

	# Check result.
	unless (ref($y) && $y->isa('Fan::Attrib')) {
		carp("getone: can't get Fan::Attrib object");
		$self->{founderror}++;
		return undef;
	}

	# We prefer an abbrev for the type of this Attrib object.
	my $t = $y->type;

	# If last one is a directory, go down there.
	if (exists($self->{nextdir})) {
		push(@{$self->{dirs}}, $self->{nextdir});
		delete($self->{nextdir}); # clean next directory entry
	}

	# We assume the first entry is the `.' directory.
	if (@{$self->{dirs}} == 0) { # this is the first time
		if (!($t eq 'D' && $y->name eq '.')) {
			carp("First entry must be the \".\" directory.");
			$self->{founderror}++;
			return undef;
		}
		$self->{nextdir} = '.'; # save to hold buffer
		return $y;
	}

	# Type '.' means END-OF-DATA.
	if ($t eq '.') {
		if (@{$self->{dirs}} == 1) { # verify o.k.
			pop(@{$self->{dirs}});
			$self->{endofdata}++;
			return $y;
		}
		if (@{$self->{dirs}} > 1) {
			carp("remaining directories: \""
				.join('/', @{$self->{dirs}})."\"");
		} else {
			carp("No directory in stack");
		}
		$self->{founderror}++;
		return undef;
	}

	# Type 'U' is `Go to the up stair'.
	if ($t eq 'U') { # one dir up
		if (@{$self->{dirs}} < 2) {
			carp("Too many dir UP");
			$self->{founderror}++;
			return undef;
		}
		$y->name(pop(@{$self->{dirs}})); # not return yet
	}

	# Remaining cases require `name' attribute. Check it.
	my $n = $y->name;
	if (!defined($n)) {
		confess("$y: no name found.");
	} elsif ($n =~ m%[\001\377]%) {
		confess("$y: name contains illegal charactor.");
	} elsif ($n =~ m%/([^/]+)$%) { # contains slash(es)
		confess("$y: name contains slash(es).");
	} elsif ($n eq '.' || $n eq '..') {
		confess("$y: \"$n\" is invalid.");
	} else {
		; # o.k.
	}

	# DEBUG mode only.
	# Calculate pathname from directory array.
	my $path = join('/', @{$self->{dirs}}, $n);
	confess($y->path." != $path") unless $y->path eq $path;

	# Type 'U' was already processed.
	if ($t eq 'U') {
		return $y;
	}

	# Type 'D' is a directory. Copy to the nextdir hold buffer.
	if ($t eq 'D') {
		$self->{nextdir} = $n;
		return $y;
	}

	# Type 'L' is a symlink.
	if ($t eq 'L') { # symlink
		if (!defined($y->linkto)) { # linkto is required
			carp("$y: no linkto for symlink");
			$self->{founderror}++;
			return undef;
		}
		return $y;
	}

	# Type 'F' is a normal file.
	if ($t eq 'F') { # normal file
		return $y;
	}

	# Or, unknown type is specified.
	carp("$t: illegal type");
	return undef;
}

;#
sub get_index ($) {
	my $self = shift;
	my $fh = $self->{handle};

	# Check end-of-file or error.
	return undef if $self->{endofdata} || $self->{founderror};

	# DEBUG mode only.
	confess("\$fh must be defined") unless defined($fh);

	# Try to read from the file handle.
	local $_;
	while (defined($_ = <$fh>)) {
		# skip trailing spaces, and ignore comment lines.
		s/\s+$//;
		/^$/ || /^#/ || last;
warn("READ($.): $_\n");
	}

	# Check end-of-file.
	if (!defined($_)) {
		carp("file [".fileno($fh)."] unexpected END-OF-FILE at $.");
		$self->{founderror}++;
		return undef;
	}

	# Let's parse it.
	my $y = Fan::Attrib->new(attr_line => $_);

	# Check result.
	ref($y) && $y->isa('Fan::Attrib')
		or carp("Can't create Attrib from $_"), return undef;

	# where am I?
	my $d;
	if (!defined($d = $self->where)) {
		$y->path('.');
		$self->start;
	} else {
		if ($y->type eq '.') {
			$self->end;
		} elsif ($y->type eq 'U') {
			$y->path($d);
			$self->up;
		} else {
			$y->path($d.'/'.$y->name);
			if ($y->type eq 'D') {
				$self->down($y->name);
			}
		}
	}

	# try filter
	$y->flag('!') unless $self->perform_filter($y);

	# result is Attrib or undef.
	$y;
}

;#
;# Scan with directory structure.
;# We should get directory entries per directory, sort them,
;# and hold until they will be used. A special reference of
;# $self->{magic_array} is used to hold directory entires.
;#
sub get_misc ($) {
	my $self = shift;
	my $y;

	# Try to get the current working directory...
	my $dir;
	if (!defined($dir = $self->where)) {
		$self->start;
		$y = $self->{scan_type} eq 'LOCAL'
		   ? Fan::Attrib->new(attr_path => "$self->{scan_dir}/.")
		   : Fan::Attrib->new(y_type => 'D', y_name => '.');
		if (defined($y)) {
			$y->path('.');
			$y->flag('!') unless $self->perform_filter($y);
		} else {
			carp("Attrib: Can't create object");
		}
		return $y;
	}

	# Delete skipped directories.
	my $cur = $dir;
	my $cur_n = ($cur =~ y|/|\001|);
	my $d;
	for $d (keys %{$self->{magic_array}}) {
		my $tmp = $d;
		my $tmp_n = ($tmp =~ y|/|\001|);
		if ($tmp_n >= $cur_n && $tmp lt $cur) {
			warn("Scan: ($d lt $dir) is true... skipped.\n")
				if $LOG > 5;
			delete($self->{magic_array}->{$d});
		}
	}

	# Check magic_array first.
	my $p = $self->{magic_array}->{$dir};

	# Try to get magic array for this directory
	if (!defined($p)) {
		$p = $self->{scan_type} eq 'LOCAL' ? $self->dir_local($dir)
		   : $self->{scan_type} eq 'LSLR'  ? $self->dir_lslR($dir)
		   : $self->{scan_type} eq 'FTP'   ? $self->dir_ftp($dir)
		   : undef;
		unless (defined($p)) {
			carp("get_misc: can't get array");
			return undef;
		}
	}

	# Now, ($p == $self->{magic_array}->{$dir}) is true.
	if (defined($y = shift(@{$p}))) { # something remains
		$y->path($dir.'/'.$y->name);
		if ($y->type eq 'D') {
			$self->down($y->name);
		}
		unless ($self->perform_filter($y)) {
			$y->flag('!');
			if ($y->type eq 'D') { # setup dummy array
				$self->{magic_array}->{$self->where} = [];
			}
		}
	} else { # or terminate this directory
		delete($self->{magic_array}->{$dir}); # clean
		if ($dir eq '.') {
			$self->end;
			$y = Fan::Attrib->new(y_type => '.');
		} else {
			my $tail = $dir =~ m|([^/]+)$| ? $1 : '.';
			$self->up;
			$y = Fan::Attrib->new(
				y_type => 'U',
				y_name => $tail,
				y_path => $dir );
		}
		if (defined($y)) {
			$y->flag('!') unless $self->perform_filter($y);
		} else {
			confess("Attrib: Can't create object")
		}
	}

	# return Attrib object.
	$y;
}

;#
;# Usage:
;#	array_ref = $scan->dir_local(directory);
;#
sub dir_local ($$) {
	my $self = shift;
	my $dir = shift;
	my $d = "$self->{scan_dir}/$dir";
	my $p = [];

	local(*D);
	opendir(D, $d) or carp("opendir($d): $!"), return undef;
	my @entry = readdir(D);
	closedir(D);

	# for all entries
	my $e;
	for $e (sort @entry) {
		next if $e eq '' || $e eq '.' || $e eq '..';
		my $x = Fan::Attrib->new(
			attr_path => "$d/$e",
			attr_no_checksum => $self->{scan_no_checksum}
		);
		if (defined($x)) {
			# $x->realpath("$d/$e");
			push(@{$p}, $x);
		}
	}

	# return a reference to array.
	$self->{magic_array}->{$dir} = $p;
}

;#
;# Usage:
;#	array_ref = $scan->dir_ftp(directory);
;#
sub dir_ftp ($$) {
	my $self = shift;
	my $dir = shift;
	my $d = "$self->{scan_dir}/$dir";
	my $ftp = $self->{scan_ftp};
	my $hash = undef;

	# try to get magic array for this directory
	if ($self->{scan_dirinfo}) {
		use Fan::DIR;

		my $tmp = "/tmp/dirinfo.$$";
		my $info = Fan::DIR->new();
		if ($ftp->get("$d/.dirinfo", $tmp) && $info->load($tmp)) {
			my $f;
			for $f ($info->index) {
				$hash->{$f} = $info->get($f);
			}
		} elsif ($ftp->fatal) {
			carp("Scan: can't get dirinfo, fatal") if $LOG > 5;
			return undef;
		} else {
			carp("Scan: can't get dirinfo, try nest") if $LOG > 5;
		}
		unlink($tmp);
	}

	# no scan_dirinfo, or fail to load dirinfo.
	if (!defined($hash)) {
		local $_ = $ftp->list($d);

		unless (defined($_)) {
			warn("Scan: can't get list of $d\n") if $LOG > 5;
			return undef;
		}

		$hash = {};
		my $x;
		for $x (split(/\n/)) {
			my $y;
			if (!defined($y = Fan::Attrib->new(attr_list => $x))) {
				warn("$x: could not parse, ignored.\n")
					if $LOG > 6;
			} else {
				$hash->{$y->name} = $y;
			}
		}
	}

	my $x;
	my $p = [];
	for $x (sort keys %{$hash}) {
		if ($x ne '' && $x ne '.' && $x ne '..') {
			$hash->{$x}->realpath("$d/$x");
			push(@{$p}, $hash->{$x});
		}
	}
	$self->{magic_array}->{$dir} = $p;
}

;#
;# Usage:
;#	array_ref = $scan->dir_lslR(directory);
;#
sub dir_lslR ($$) {
	my $self = shift;
	my $dir = shift;
	my $p;

	while (!defined($p = $self->{magic_array}->{$dir})) {
		$self->getline_lslR || return undef;
	}
	$p;
}

;#
;# read a line from ls-lR format file, and parse it.
;# if full entries for a directory $d was found,
;# you can access directory info for that directory from
;# $self->{magic_array}->{$d}.
;#
sub getline_lslR ($){
	my $self = shift;
	my $fh = $self->{handle};
	local $_;

	# check previouse error or end-of-file
	return undef if $self->{endoffile} || $self->{founderror};

	# validate file handle
	confess("Can't find file handle") unless defined($fh);

	# y structure, separator
	my $delim = 0;

	# read a line
	if (!(defined($_ = <$fh>))) {
		$self->{endoffile}++, $delim++;
	} elsif (/^$/) { # null line
		$delim++; # end-of-directory
	} elsif (/^total (\d+)/) { # maybe start of a directory.
		# we simply ignore this.
	} elsif (/^.[-r][-w][-xsS][-r][-w][-xsS][-r][-w][-xtT]\s*/) {
		# normal entry - check this format before directory pattern
		# tested in next statement, because we hate a filename which
		# ends with ':'.
		my $y;
		if (!defined($y = Fan::Attrib->new(attr_list => $_))) {
			warn("$_: could not parse, ignored\n") if $LOG >= 7;
		} else {
			my $n = $y->name;
			if ($n ne '' && $n ne '.' && $n ne '..') {
				$self->{cur_info}->{$n} = $y; # registered.
			}
		}
	} elsif (/:$/) { # new directory
		my $d = $`;
		if (!defined($self->{subst})) {
			my $s = quotemeta($d =~ m%[^/]+$% ? $` : '');
			$self->{subst} = sub {
				local($_) = @_; s|^$s|./|; $_; };
		}
		$self->{lslR_curdir} = &{$self->{subst}}($d);
	} else { # other case?
		warn("$_ unknown format, ignored\n") if $LOG >= 7;
		$self->{founderror}++;
		return undef;
	}

	# directory delimiter
	if ($delim) {
		my $d = $self->{lslR_curdir};
		delete($self->{lslR_curdir});
		my $p = $self->{cur_info};
		$self->{cur_info} = {};
		my $q = $self->{magic_array}->{$d} = [];
### DEBUG BEGIN (for debug only)
		if ($d ne '.' && $d !~ /^\.\//) {
			confess("directory name must begin with '.'\n");
		}
### DEBUG END
		my $n;
		for $n (sort keys %{$p}) {
			push(@{$q}, $p->{$n});
		}
	}

	# success return
	1;
}

;#
;#
sub dump ($) {
	my $self = shift;
	my $count = 0;
	my $d;
	for $d (sort keys %{$self->{magic_array}}) {
		my $p = $self->{magic_array}->{$d};
		my $y;
		for $y (@{$p}) {
			print "dump: ".$y->path."\n";
		}
		$count += @{$p};
	}
	print "dump: total $count entries.\n";
}

;#
;#
sub summary ($) {
	my $self = shift;
	my $count = 0;
	my $d;
	for $d (sort keys %{$self->{magic_array}}) {
		$count += scalar(@{$self->{magic_array}->{$d}});
	}
	print "summary: total $count entries.\n";
}

;#
;# Get an array of ``smallest'' attributes from
;# a list of Scan objects.
;#
sub getcmp ($@) {
	my @array = @_;
	my $end = 0;
	my $z = undef; # the smallest attribute
	my $pp;

	# Search smallest entry, first
	for $pp (@array) {
		my $p;
		if (defined($p = $pp->get)) {
			$pp->unget($p);
			$z = $p if !defined($z) || $p->compare($z) < 0;
		} else {
			$end++;
		}
	}

	# Check end-of-data
	if ($end == @array) {
		return wantarray ? () : undef;
	} elsif ($end > 0) {
		confess("Some unexpected case occured");
	}

	# OK, $z is the smallest one, try to generate result.
	my @result = ();

	# Get an item if smallest values can be found.
	for $pp (@array) {
		my $p = $pp->get;
		if ($z->compare($p)) {
			$pp->unget($p);
			push(@result, undef);
		} else {
			push(@result, $p);
		}
	}

	# Result is an list of attributes.
	@result;
}

;# guessing..., return the Scan object.
;#
sub guess ($$) {
	my $this = shift;
	my $foo = shift;

	# if we already have scanner, return it.
	return $foo if ref($foo) && $foo->isa('Fan::Scan');

	# directory?
	if (-d $foo) {
		return $this->new(scan_type => 'LOCAL', scan_dir => $foo);
	}

	# regular file? if so, it must be an index file.
	if (-f $foo) {
		return $this->new(scan_type => 'INDEX', scan_index => $foo);
	}

	# file glob?
	if (ref($foo) eq 'GLOB') {
		return $this->new(scan_type => 'INDEX', scan_index => $foo);
	}

	# file handle?
	if (defined(fileno($foo))) {
		return $this->new(scan_type => 'INDEX', scan_index => \*{$foo});
	}

	# what is this?
	undef;
}

;# convert file name to a file glob.
;#
sub fileglob ($;$) {
	my $file = shift;
	my $m = @_ ? shift : ''; # mode...

	# do nothing if $file is a file glob.
	return $file if ref($file) eq 'GLOB';

	# check modes.
	$m = '<' if $m eq 'r';
	$m = '>' if $m eq 'w';
	$m = '>>' if $m eq 'a';

	# check modes...
	unless ($m eq '' || $m eq '<' || $m eq '>' || $m eq '>>') {
		carp("fileglob: wrong mode to open operation") if $LOG >= 5;
		return undef;
	}

	# check special filename.
	if ($file eq '' || $file eq '-') { 
		if ($m eq '' || $m eq '<') {
			return \*STDIN;
		} else {
			return \*STDOUT;
		}
	}

	# try to open the target file.
	local *TEMP;
	unless (CORE::open(TEMP, $m.$file)) {
		carp("fileglob: open($m.$file): $!") if $LOG >= 5;
		return undef;
	}

	# debug log...
	warn("fileglob: open[".fileno(*TEMP)."] $file: o.k.\n") if $LOG > 5;

	# result
	*TEMP;
}

;#
;# scan_mklist(output, directory);
;#
;# Return codes:
;#	undef	error was detected.
;#	1	success, the newest list was created.
;#
sub scan_mklist ($$) {
	my $file = shift;
	my $dir = shift;

	my $op = &fileglob($file, 'w');
	my $no = fileno($op);

	if (!defined($no)) {
		carp("scan_mklist: fileglog($file): failure.") if $LOG > 5;
		return undef;
	}

	# debug log
	if (ref($op) eq 'GLOB') { # normal file.
		warn("scan_mklist: use[$no] $file: o.k.\n") if $LOG > 5;
	} else {
		warn("scan_mklist: open[$no] $file: o.k.\n") if $LOG > 5;
	}

	# Try to open local directory tree.
	my $scan = Fan::Scan->guess($dir);

	unless (ref($scan) && $scan->isa('Fan::Scan')) {
		carp("scan_mklist: can't create scanner($dir)");
		return undef;
	}

	# generate lists.
	my $a;
	while (defined($a = $scan->get)) {
		$a->fill_checksum; # checksum is optional.
		print $op $a->to_line."\n";
	}

	# close if needed.
	if (ref($op) eq 'GLOB') {
		warn("scan_mklist: unuse[$no] $file...\n") if $LOG > 5;
	} else {
		warn("scan_mklist: close[$no] $file...\n") if $LOG > 5;
	}

	# this causes the target file be closed automatically.
	undef $op;

	# success.
	1;
}

;#
;# Generate diffs for given two index files.
;# scan_mkdiff(output, old, new)
;#
;# Return codes:
;#	undef	error was detected.
;#	0	diff file was generated, but no change exists.
;#	other	# of changes. diff file was generated.
;#
sub scan_mkdiff ($$$) {
	my $file = shift;
	my $old = shift;
	my $new = shift;

	my $op = &fileglob($file, 'w');
	my $no = fileno($op);

	if (!defined($no)) {
		carp("scan_mkdiff: fileglog($file): failure.") if $LOG > 5;
		return undef;
	}

	# debug log
	if (ref($op) eq 'GLOB') { # normal file.
		warn("scan_mkdiff: use[$no] $file: o.k.\n") if $LOG > 5;
	} else {
		warn("scan_mkdiff: open[$no] $file: o.k.\n") if $LOG > 5;
	}

	my $oldscan = Fan::Scan->guess($old);

	unless(ref($oldscan) && $oldscan->isa('Fan::Scan')) {
		carp("scan_mkdiff: can't create scanner($old)");
		return undef;
	}

	my $newscan = Fan::Scan->guess($new);

	unless(ref($newscan) && $newscan->isa('Fan::Scan')) {
		carp("scan_mkdiff: can't create scanner($new)");
		return undef;
	}

	my @dir = ();	# directry stack
	my $modify = 0;	# modification flag
	my $a;
	my $b;
	while (($a, $b) = $oldscan->getcmp($newscan)) {

		# check difference first.
		if (!defined($a) && !defined($b)) {
			confess("scan_mkdiff: UNEXPECTED CASE");
		} elsif (!defined($a)) {
			$b->flag('+');
		} elsif (!defined($b)) {
			$b = $a; $b->flag('-');
		} elsif (attr_cmp($a, $b)) { # differs
			$b->flag('+');
		} else {
			$b->flag('');
		}

		# print difference if required.
		if ($b->type eq '.') {
			print $op ".\n"; # END-OF-DATA.
		} elsif ($b->type eq 'D' && $b->name eq '.') {
			print $op $b->to_line."\n";
		} elsif ($b->flag ne '') {
			while (@dir) {
				print $op shift(@dir)->to_line."\n";
			}
			print $op $b->to_line."\n";
			$modify++;
		} elsif ($b->type eq 'D') {
			push(@dir, $b);
		} elsif ($b->type eq 'U') {
			if (@dir) {
				pop(@dir);
			} else {
				print $op "U\n";
			}
		} else { # (flag == '' && type !~ /[DU.]/)
			; # ignored
		}
	}

	# close if needed.
	if (ref($op) eq 'GLOB') {
		warn("scan_mkdiff: unuse[$no] $file...\n") if $LOG > 5;
	} else {
		warn("scan_mkdiff: close[$no] $file...\n") if $LOG > 5;
	}

	# this causes the target file be closed automatically.
	undef $op;

	# return # of differences.
	$modify;
}

;#
;# scan_update(output, base, diff [, diff...]);
;#
;# Return codes:
;#	undef	error was detected.
;#	1	success, the newest list was created.
;#
sub scan_update ($$@) {
	my $file = shift;
	my $base = shift;
	my @diff = @_;

	my $op = &fileglob($file, 'w');
	my $no = fileno($op);

	if (!defined($no)) {
		carp("scan_update: fileglog($file): failure.") if $LOG > 5;
		return undef;
	}

	# debug log
	if (ref($op) eq 'GLOB') { # normal file.
		warn("scan_update: use[$no] $file: o.k.\n") if $LOG > 5;
	} else {
		warn("scan_update: open[$no] $file: o.k.\n") if $LOG > 5;
	}

	# Open the index who has maximum number.
	my $basescan = Fan::Scan->guess($base);

	unless(ref($basescan) && $basescan->isa('Fan::Scan')) {
		carp("update: can't create scanner($base)");
		return undef;
	}
	warn("scan_update: base $base: o.k.\n") if $LOG > 5;

	# Initialize array.
	my @array = ();

	# Open step files...
	for my $file (@diff) {
		my $q = Fan::Scan->guess($file);

		unless(ref($q) && $q->isa('Fan::Scan')) {
			carp("update: can't create scanner($file)");
			return undef;
		}
		push(@array, $q);
		warn("scan_update: add $file: o.k.\n") if $LOG > 5;
	}

	# Try merge
	my @a;
	while (@a = $basescan->getcmp(@array)) {
		my $a;
		my $x = undef;

		while (@a) {
			my $a = shift(@a);
			$x = $a if ref($a) && $a->isa('Fan::Attrib');
		}
		if (!defined($x)) {
			confess("scan_update: UNEXPECTED CASE");
		} elsif ($x->flag ne '-') {
			$x->flag('');
			print $op $x->to_line."\n";
		}
	}

	# close if needed.
	if (ref($op) eq 'GLOB') {
		warn("scan_update: unuse[$no] $file...\n") if $LOG > 5;
	} else {
		warn("scan_update: close[$no] $file...\n") if $LOG > 5;
	}

	# this causes the target file be closed automatically.
	undef $op;

	# Success return.
	1;
}

;# Compare two Attrib objects.
;#
sub attr_cmp ($$) {
	my $a = shift;
	my $b = shift;
	my $tag;
	my $val;

	# check each items...
	while (($tag, $val) = each %{$a}) {
		next if $tag !~ /^y_/;
		return -1 if $b->{$tag} ne $val;
	}

	# or same
	0;
}

;# end of Fan::Scan module