#  $HeadURL$ $LastChangedRevision$

BEGIN {
#  This works, but it would be nicer to use a single
#  line with 'use' instead. But that will require that
#  either ade.pl calls the same thing, or that we
#  merge all those things into a single file.
use lib substr `ade-config ade_include_prefix`,0,-1;
require "ade.pl";
ADE->import(qw($ade_app_progname ade_gep_main ade_err_warning ade_err_internal ade_err_debug $ade_tmp_dir ade_tmp_deregisterfile ade_tmp_registerfile ade_err_registerdefderrs ade_smf_isvalidregexp));
}

require File::Find;
require URI::Escape;
require Data::Dumper;

my($subversion_string) = '# $HeadURL$ $LastChangedRevision$';

&ade_err_registerdefderrs({
    fad_err_misc  => { fmt => "%s" },
});

my($magic_number) = "FaDFiLe";
my($fad_version) = "4";
my($fad_sort_cmd) = substr `fad-config fad_sort_cmd`,0,-1;

#  File system object type descriptors
my($IT_FILE)    = "f";
my($IT_DIR)     = "d";
my($IT_PIPE)    = "p";
#  This one is not just used in this file, but also in fadfixperms.spp, and that
#  gets included fore this one, so it seems the use before the declaration.
$main::IT_SYMLINK = "l";
my($IT_BLOCK)   = "b";
my($IT_CHAR)    = "c";
my($IT_SOCKET)  = "s";

#  Change types. $main::CT_TYPE refers to a change in the items
#  type field as listed above.
$main::CT_DELETED = "d";
$main::CT_ADDED   = "a";
$main::CT_TYPE    = "t";
$main::CT_OWNER   = "u";
$main::CT_GROUP   = "g";
$main::CT_MODE    = "m";
$main::CT_LINKS   = "l";
my($CT_CONT)      = "c";		# this one isn't global

#  Psuedo-change types which allow calling functions not
#  to have to analyse what exactly a contents change
#  means for a particular object.
$main::CT_CONT_MAJMIN  = "s";  
$main::CT_CONT_CRC     = "C";
$main::CT_CONT_SYMLINK = "S";

#  This character is used as a separator in FAD files. It
#  should not be a character that is likely to appear in a 
#  file name. 
my($fs) = ":";
my($rs) = "\n";
my($header_fs) = " ";
my($header_rs) = "\n";

my($BY_REQUEST_NOT_CHECKED) = -1;	# won't clash with valid file contents
my($NOT_READABLE)           = -2;	# won't clash with valid file contents

my($sort_file, $unames, $newinodenumber);

#  Because File::Find does not support passing *through* arbitrary
#  data (such as into which FAD store I want '&wanted' to write
#  records), the FAD records table must be global. But we can make
#  a slight improvement, by making only references to it global
#  and keeping the FAD store itself private (to some function
#  somewhere). So, actually, since they are global there is
#  no need to put any code here :-)

##############################################################################
#
#  PUBLIC FUNCTIONS
#
##############################################################################

sub fad_diff
{
    my($errstack_ref, $old_store_ref, $new_store_ref, $cb_fnc_ref, $cb_param) = @_;
    my($advance_old_index_offset_flag, $advance_new_index_offset_flag);
    my(%change);
    my($key, $filename);
    my($old_name, $new_name, $old_type, $new_type, $old_owner, $new_owner, $old_group, $new_group, $old_mode, $new_mode, $old_links, $new_links, $old_content, $new_content, @old_other_names, @new_other_names);

    &ade_err_debug($errstack_ref, 40, "fad_diff: sof");

    #  Generate indexes of the hash's dev/inode pair key, sorted by first name in entry's filename array.
    #@old_index = sort { ${$old_store_ref}{$a}{names}[0] cmp ${$old_store_ref}{$b}{names}[0] } keys %{$old_store_ref};
    #@new_index = sort { ${$new_store_ref}{$a}{names}[0] cmp ${$new_store_ref}{$b}{names}[0] } keys %{$new_store_ref};

    #  Make a hash of each filename for a particular file to they data record' dev/inode pair.
    foreach $key (keys %{$old_store_ref}) {
        foreach $filename (@{${$old_store_ref}{$key}{names}}) {
            $old_hash_by_filename{$filename} = $key;
        }
    }
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped hash is " . Dumper(\%old_hash_by_filename));
    #  Make an ordered list of *those* filenames.
    @old_index_by_filename = sort { $a cmp $b } keys %old_hash_by_filename;
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped index is " . Dumper(\@old_index_by_filename));
    
    #  Make a hash of each filename for a particular file to they data record' dev/inode pair.
    foreach $key (keys %{$new_store_ref}) {
        foreach $filename (@{${$new_store_ref}{$key}{names}}) {
            $new_hash_by_filename{$filename} = $key;
        }
    }
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped hash is " . Dumper(\%new_hash_by_filename));
    #  Make an ordered list of *those* filenames.
    @new_index_by_filename = sort { $a cmp $b } keys %new_hash_by_filename;
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped index is " . Dumper(\@new_index_by_filename));
    

    for ($old_index_offset = 0, $new_index_offset = 0; $old_index_offset < $#old_index_by_filename+1 || $new_index_offset < $#new_index_by_filename+1; $old_index_offset += $advance_old_index_offset_flag, $new_index_offset += $advance_new_index_offset_flag) {

        #  no changes for the current listings-pair detected yet ...
        undef(%change);

        #  Create some shortcuts only for readability
        $old_name = $old_index_by_filename[$old_index_offset];
        $new_name = $new_index_by_filename[$new_index_offset];
        @old_other_names = sort @{${$old_store_ref}{$old_hash_by_filename{$old_name}}{names}};
        @new_other_names = sort @{${$new_store_ref}{$new_hash_by_filename{$new_name}}{names}};
        $old_type = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{type};
        $new_type = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{type};
        $old_owner = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{owner};
        $new_owner = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{owner};
        $old_group = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{group};
        $new_group = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{group};
        $old_mode = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{mode};
        $new_mode = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{mode};
        $old_links = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{links};
        $new_links = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{links};
        $old_content = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{content};
        $new_content = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{content};
        &ade_err_debug($errstack_ref, 4, sprintf("fad_diff: old_name=$old_name, old_index_offset=$old_index_offset, #old_index_by_filename=%d, old_type=$old_type, old_owner=$old_owner, old_group=$old_group, old_links=$old_links, old_content=$old_content, new_index_offset=$new_index_offset, #new_index_by_filename=%d, new_name=$new_name, new_type=$new_type, new_owner=$new_owner, new_group=$new_group, new_links=$new_links, new_content=$new_content", $#old_index_by_filename+1, $#new_index_by_filename+1));

        &ade_err_debug($errstack_ref, 4, "fad_diff: checking for differences ...");

        #  We do this in a new block because we will want to jump forward when there is no
        #  point in checking other change types (e.g. filetype changes, file added, file deleted).
        #  Doing this with 'next' is not what we want because there is code to execute at
        #  after this block but before we loop round.
        CHECK_CHANGES: {

            #  if file is in the other but not in the first then we have an added file
            if ($new_index_offset == $#new_index_by_filename+1 || ($old_index_offset != $#old_index_by_filename+1 && $old_name lt $new_name)) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: deleted");
                $change{file} = $old_name;
                push  @{$change{changes}}, { type => $main::CT_DELETED };
                $advance_old_index_offset_flag = 1;
                $advance_new_index_offset_flag = 0;
                last CHECK_CHANGES;
            }

            #  if file is in one but not in other then we have a deleted file
            if ($old_index_offset == $#old_index_by_filename+1 || ($new_index_offset != $#new_index_by_filename+1 && $old_name gt $new_name)) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $new_name: added");
                $change{file} = $new_name;
                push @{$change{changes}}, { type => $main::CT_ADDED };
                $advance_old_index_offset_flag = 0;
                $advance_new_index_offset_flag = 1;
                last CHECK_CHANGES;
            }


            #  otherwise we have entries in each listing for the current file, but
            #  those listings may be different so here check
            if ($old_type ne $new_type) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: type changed");
                $change{file} = $old_name;
                push  @{$change{changes}}, { type => $main::CT_TYPE, old => $old_type, new => $new_type};
                $advance_old_index_offset_flag = 1;
                $advance_new_index_offset_flag = 1;
                last CHECK_CHANGES;
            }
    
            if ($old_owner ne $new_owner) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: owner changed");
                $change{file} = $old_name;
                push @{$change{changes}}, { type => $main::CT_OWNER, old => $old_owner, new => $new_owner };
            }

            if ($old_group ne $new_group) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: group changed");
                $change{file} = $old_name;
                push @{$change{changes}}, { type => $main::CT_GROUP, old => $old_group, new => $new_group };
            }

            if ($old_mode ne $new_mode) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: mode changed");
                $change{file} = $old_name;
                push @{$change{changes}}, { type => $main::CT_MODE, old => $old_mode, new => $new_mode };
            }

            &ade_err_debug($errstack_ref, 4, "fad_diff: old_links=$old_links, new_links=$new_links");
            if ($old_links != 1 || $new_links != 1) {
                &ade_err_debug($errstack_ref, 4, "fad_diff: investigating hard link lists ..");
                #  Scan sorted list of names looking for differences
                for ($old_other_names_index=0, $new_other_names_index=0; $old_other_names_index<$#old_other_names+1 && $new_other_names_index<$#new_other_names+1; $old_other_names_index++, $new_other_names_index++) {
                    last if ($old_other_names[$old_other_names_index] ne $new_other_names[$new_other_names_index]);
                }
                #  If we broke out of that loop early then it means a mismatch was found.
                if ($old_other_names_index<$#old_other_names+1 || $new_other_names_index<$#new_other_names+1) {
                    &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: links changed");
                    $change{file} = $old_name;
                    push @{$change{changes}}, { type => $main::CT_LINKS, old => join(",",@old_other_names), new => join(",",@new_other_names) };
                }
            }

            #  if either file was unreadable then error (5 of 9 cases)
            #  (note that if the whole record from 1st file is identical to
	    #  the second and they (both) contain $NOT_READABLE then we don't
	    #  get this far because identical records are skipped higher up.
            if ($old_content ne $new_content && ($old_content == $NOT_READABLE || $new_content == $NOT_READABLE)) {
            	&ade_err_error($errstack_ref, fad_err_misc, "$old_name or $new_name was unreadable when read");
                return($ade_err_fail);

            #  second case is that both files are marked $BY_REQUEST_NOT_CHECKED
	    #  which is fine, no action necessary.
            } elsif ($old_content ne $newcontent && ($old_content == $BY_REQUEST_NOT_CHECKED && $new_content == $BY_REQUEST_NOT_CHECKED)) {
                &ade_err_debug($errstack_ref, 40, "fad_diff: two not crc'd files");

            #  third case is one has $BY_REQUEST_NOT_CHECKED and the other
	    #  doesn't. This is an error.
            } elsif ($old_content ne $new_content && ($old_content == $BY_REQUEST_NOT_CHECKED || $new_content == $BY_REQUEST_NOT_CHECKED)) {
                &ade_err_error($errstack_ref, fad_err_misc, "only one of $old_name and $new_name was not CRC'ed");
                return($ade_err_fail);
	    
            } elsif ($old_content ne $new_content && $old_type eq $IT_FILE) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: content crc changed");
                $change{file} = $old_name;
                push @{$change{changes}}, { type => $main::CT_CONT_CRC, old => $old_content, new => $new_content};

            } elsif ($old_content ne $new_content && $old_type eq $IT_SYMLINK) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: symlink target changed");
                $change{file} = $old_name;
                push @{$change{changes}}, { type => $main::CT_CONT_SYMLINK, old => $old_content, new => $new_content };
    
            } elsif ($old_content ne $new_content && $old_type eq $IT_BLOCK || $old_type eq $IT_CHAR) {
                &ade_err_debug($errstack_ref, 30, "fad_diff: $old_name: major/minor changed changed");
                $change{file} = $old_name;
                push @{$change{changes}}, { type => $main::CT_CONT_MAJMIN, old => $old_content, new => $new_content};
            }

            #  All other sorts of differences will mean we advance to the next file on *both* lists.
            $advance_old_index_offset_flag = 1;
            $advance_new_index_offset_flag = 1;
        }

        #  report changes if any detected
        if (defined(%change) && ($rc=&$cb_fnc_ref($errstack_ref, $cb_param, \%change)) != $ade_err_ok) {
            &ade_err_debug($errstack_ref, 40, "fad_diff: cb_fnc_ref() failed, returning failure ...");
            return($rc);
        }
    }

    #  If we get this far then success
    &ade_err_debug($errstack_ref, 40, "fad_diff: returning success ...");
    return($ade_err_ok);
}

sub fad_dump
{
    my($errstack_ref, $out_handle, $data_store_ref) = @_;

    if (($rc=&_fad_header_write($errstack_ref, $out_handle)) != $ade_err_ok) {
        return($rc);
    }
    print $out_handle Dumper($data_store_ref);
    return($ade_err_ok);
}

sub fad_load
{
    my($errstack_ref, $in_handle, $data_store_ref, $regexp) = @_;
    my($code, $VAR1);

    if (($rc=&_fad_header_read($errstack_ref, $in_handle, undef)) != $ade_err_ok) {
        return($rc);
    }

    { local $/; undef $/; $code = scalar(<$in_handle>); }
    &ade_err_debug($errstack_ref, 40, "fad_load: code=[$code]");
 
    if (!defined($regexp)) {
        eval $code;
        #  This takes no account of what might already exist.
        %{$data_store_ref} = %{$VAR1};
    } else {
      	&ade_err_internal($errstack_ref, "fad_load: regexp support not coded yet");
    }

    return($ade_err_ok);
}

sub fad_collect_info
{
    my($errstack_ref, $filename, $suppress_crcs, $info_hash_ref_ref) = @_;
    my($linktext, $type, $dev, $inode, $nlink, $uid, $gid, $rdev);
    my($size, $atime, $mtime, $ctime, $blksize, $blocks, $oldslash);
    my ($i, $j, $buf, $contents, $mode, $fad_record, $smode, $pname, $pcontents);

    &ade_err_debug($errstack_ref, 40, "fad_collect_info: processing $filename ...");

    #  For all fs entities we identify their type. How do you spot a 
    #  symbolic link? Assume it is one and try seeing where it points.
    if ($linktext = readlink($filename)) {
        $type = $main::IT_SYMLINK;
        ($dev,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = lstat($filename);

    #  If we can't see where it goes then I guess it's not a symbolic link.
    } elsif (!stat($filename)) {
        &ade_err_error($errstack_ref, fad_err_misc, "can't access $filename");
        return($ade_err_fail);

    } else {
        ($dev,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
        $type = $IT_FILE   if -f _;
        $type = $IT_DIR    if -d _;
        $type = $IT_PIPE   if -p _;
        $type = $IT_SOCKET if -S _;
        $type = $IT_BLOCK  if -b _;
        $type = $IT_CHAR   if -c _;
    }

    #  Now based on what it was, certain bits of information
    #  are ignored, and certain extra information is ascertained. For
    #  a symlink, we note the destination it points to.
    if ($type eq $main::IT_SYMLINK) {
        #  Can symbolic links by hard linked ? 
        $nlink = 1;
        $contents = $linktext;
        $uid = 0;
        $gid = 0;

    #  For a directory there is nothing else to note.
    } elsif ($type eq $IT_DIR) {
        #  Can directories by hard linked ?
        $nlink = 1;
        $contents = 0;

    #  For a file we get the CRC, if we can, unless instructed not to.
    } elsif ($type eq $IT_FILE && $suppress_crcs) {
        $contents = $BY_REQUEST_NOT_CHECKED;
   
    #  Openable file
    #  \0 to protect against trailing spaces (or leading '>') which open() will 
    #  ignore (see perlfaq5(1) man page).
    } elsif ($type eq $IT_FILE && open(CRCFP, "$filename\0")) {
        #  $oldslash = $/;
        #  undef $/;
        $contents = 0;
        while (read(CRCFP, $buf, 262144)) {
            $contents += unpack("%32C*", $buf);
            $contents = $contents % 32767;
        }
        #  $/ = $oldslash;
        close(CRCFP);
        
    #  Unopenable file
    } elsif ($type eq $IT_FILE) {
        &ade_err_warning($errstack_ref, ade_err_access, $filename, "open", $!);
        $contents = $NOT_READABLE;

    #  For device files we save the major and minode numbers
    } elsif ($type eq $IT_BLOCK) {
        $contents = $rdev;

    } elsif ($type eq $IT_CHAR) {
        $contents = $rdev;

    #  For a socket there's nothing.
    } elsif ($type eq $IT_SOCKET) {
        $contents = 0;

    #  For a pipe there's nothing.
    } elsif ($type eq $IT_PIPE) {
        $contents = 0;
    }

    #  Additionally the mode contains some junk at the high order
    #  bits so we mask them off.
    $mode &= 07777;

    ${$info_hash_ref_ref} = {
               names => [ $filename ],
               data  => { type => $type, owner => $uid, group => $gid, mode => $mode, content => $contents, links => $nlink, dev => $dev, inode => $inode }
           };

    return($ade_err_ok);
}

sub fad_insert_info
{
    my($errstack_ref, $data_store_ref, $info_ref) = @_;
    my($dev, $inode);

    $dev = ${$info_ref}{data}{dev};
    $inode = ${$info_ref}{data}{inode};

    if (!defined(${$data_store_ref}{$dev,$inode})) {
        ${$data_store_ref}{$dev,$inode} = $info_ref;
    } else {
        push(@{${$data_store_ref}{$dev,$inode}{names}}, ${$info_ref}{names}[0]);
    }

    &ade_err_debug($errstack_ref, 10, "fad_insert_info: abort: currently known names are now: " . join(", ", @{${$data_store_ref}{$dev,$inode}{names}}));

    return($ade_err_ok);
}

##############################################################################
#
#  PRIVATE FUNCTIONS
#
##############################################################################

sub _fad_header_write
{
    my($errstack_ref, $out_handle) = @_;
    my ($fs_escaped, $rs_escaped);

    if (($rc=&escape($errstack_ref, $fs, \$fs_escaped)) != $ade_err_ok) {
        return($rc);
    }
    if (($rc=&escape($errstack_ref, $rs, \$rs_escaped)) != $ade_err_ok) {
        return($rc);
    }

    #  Statutory headers
    print $out_handle $magic_number . $header_rs;
    print $out_handle "FAD-Version" . $header_fs . $fad_version . $rs;
    print $out_handle "Field-Separator" . $header_fs . $fs_escaped . $header_rs;
    print $out_handle "Record-Separator" . $header_fs . $rs_escaped . $header_rs;

    #  Version-specific headers
    print $out_handle "Unix-Time" . $header_fs . time . $header_rs;

    #  End of headers marker
    print $out_handle "EOH" . $header_rs;

    return($ade_err_ok);
}

sub _fad_header_read
{
    my($errstack_ref, $fad_handle, $read_header_ref) = @_;
    my($key, $val, %read_header);
    my($read_header_magic_number);
    my($read_header_line);

    &ade_err_debug($errstack_ref, 40, "_fad_header_read: reading magic number");
    #  This already assumes that the record separator in the header ($rs_header)
    #  is a newline :-(
    if (!($read_header_magic_number = <$fad_handle>)) {
        &ade_err_error($errstack_ref, fad_err_misc, "can't read magic number");
        return($ade_err_fail);
    }
    chomp($read_header_magic_number);
    
    #  Read in remaining header lines - up to 'EOH', and validate
    while (!eof($fad_handle)) {
        &ade_err_debug($errstack_ref, 40, "_fad_header_read: about to read a line");
        $read_header_line = <$fad_handle>;
        chomp($read_header_line);
        ($key, $val) = split($header_fs, $read_header_line, 2);
        (defined($key) && !defined($val)) && ($val = 0);
        $read_header{$key} = $val;
        &ade_err_debug($errstack_ref, 40, "_fad_header_read: read header (key=$key, val=$val)");
        ($key eq "EOH") && last;
    }

    #  Validate headers
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating magic number");
    if ($read_header_magic_number ne $magic_number) {
        &ade_err_error($errstack_ref, fad_err_misc, "mismatching magic number");
        return($ade_err_fail);
    }
    #  currently we don't have any users to support multiple FAD versions 
    #  for! :-)
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating fad version (file contains $read_header{'FAD-Version'})");
    if (($read_header{'FAD-Version'} ne $fad_version)) {
        &ade_err_error($errstack_ref, fad_err_misc, "mismatching FAD version");
        return($ade_err_fail);
    }
    #  record separator *MUST* be new line currently
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating record separator");
    if (($rc=&unescape($errstack_ref, $read_header{'Record-Separator'}, \$rs_unescaped)) != $ade_err_ok) {
        return($rc);
    }
    if ($rs_unescaped ne $rs) {
        &ade_err_error($errstack_ref, fad_err_misc, "mismatching record separator");
        return($ade_err_fail);
    }
    #  currently we don't act upon alternative field separators
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating field separator");
    if (($rc=&unescape($errstack_ref, $read_header{'Field-Separator'}, \$fs_unescaped)) != $ade_err_ok) {
        return($rc);
    }
    if ($fs_unescaped ne $fs) {
        &ade_err_error($errstack_ref, fad_err_misc, "mismatching field separator");
        return($ade_err_fail);
    }
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating end of header marker");
    if (!defined($read_header{'EOH'})) {
        return($ade_err_fail);
    }

    #  the remaining headers are simply ignored
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating free fields");

    #  delete the headers which are not the concern of other programs
    delete $read_header{'FAD-Version'};
    delete $read_header{'Record-Separator'};
    delete $read_header{'Field-Separator'};
    delete $read_header{'EOH'};

    #  The rest are for things higher up (e.g. fadscan uses Unix-Time in
    #  the report headers.
    if (defined($read_header_ref)) {
        %{$read_header_ref} = %read_header;
    }

    return($ade_err_ok);
}

##############################################################################
#
#  OBSOLETE FUNCTIONS
#
##############################################################################

sub fadstream_to_fadstore
{
    my($errstack_ref, $fadstream_handle, $attribs_ref, $names_ref, $madeupdevinodes_ref, $regexp) = @_;

    while (<$fadstream_handle>) {
        chomp;
        #  The regexp provides grep capability
        &insert_fadrecord_in_fadstore($errstack_ref, $_, $attribs_ref, $names_ref, $madeupdevinodes_ref) if (!defined($regexp) || /$regexp/);
    }

    return($ade_err_ok);
}

sub fadstore_to_fadstream
{
    my($errstack_ref, $out_handle, $attribs_ref, $names_ref, $madeupdevinodes_ref) = @_;
    my($key,$dev,$inode,$i,$j, $old_lc_all, $outputline);
    my($rc, @othernames);
    my($temporary_file_handle);
    my($suppressed_dev, $suppressed_inode);

    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: sof");
    $rc = 0;

    #  Write a magic number at the top of the FAD file
    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: writing FAD header to stream ...");
    if (($rc=&_fad_header_write($errstack_ref, $out_handle)) != $ade_err_ok) {
        return($rc);
    }
    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: after writing header");

    #  Dump the FAD store - unsorted - to a temporary file
    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: writing unsorted FAD store onto $sort_file ...");
    &ade_tmp_registerfile($errstack_ref, $sort_file);
    if (!open(TMP1_HANDLE, ">$sort_file")) {
        &ade_err_error($errstack_ref, fad_err_misc, "can't open $sort_file");
        return($ade_err_fail);
    }
    foreach $key (sort {${$names_ref}{$a} cmp ${$names_ref}{$b}} (keys %{$names_ref})) {
        ($dev, $inode, $i) = split($;, $key);
        #  output all interesting information except list of other links.
        #  (In order to make the internally passed around fadrecord the same as the external
        #  one, that requires that the external one has dev and inode info too. But this
        #  is irrelevent in the outside world, so we just put blank ones in; this is clearer
        #  that putting the numbers there and then not using them, I think.)
        $suppressed_dev = "";
        $suppressed_inode = "";
        #printf TMP1_HANDLE join($fs, qw( %s %s %s %s %d %d %o %d %s )), ${$names_ref}{$key}, $suppressed_dev, $suppressed_inode, @{${$attribs_ref}{$dev, $inode}}{ qw( type uid gid mode nlink contents )};
        &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: the key as it appears in the fadstore is ${$names_ref}{$key}, the contents is ${${$attribs_ref}{$dev, $inode}}{contents}");
        $outputline = sprintf(join($fs, qw( %s %s %s %s %d %d %o %d %s )), ${$names_ref}{$key}, $suppressed_dev, $suppressed_inode, @{${$attribs_ref}{$dev, $inode}}{ qw( type uid gid mode nlink contents )});
        #  If there are other links then also list them all except the
        #  one by which we're listing it of course!
        if (${$attribs_ref}{$dev,$inode}->{namecnt} != 1) {
            undef @othernames;
            for ($j=0; $j<${$attribs_ref}{$dev,$inode}->{namecnt}; $j++) {
                #  Don't print the name of the item itself in the list of other names!
                #  Actually, don't print it here at all, just collect the names we
		#  do want to print, and then we'll outpuit the list, but sorted, in
		#  a moment.
                push(@othernames, ${$names_ref}{$dev, $inode, $j}) if ($j != $i);
            }
            #print TMP1_HANDLE $fs . join($fs, sort(@othernames));
            $outputline .= $fs . join($fs, sort(@othernames));
        }
        $outputline .= $rs;
        #print TMP1_HANDLE $rs;
        print TMP1_HANDLE $outputline;
        &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: wrote line [$outputline]");
    }
    close TMP1_HANDLE;
    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: done writing unsorted FAD store to $sort_file");

    #  now get unix's sort command to sort that temporary file and write the 
    #  sorted version to the passed handle.

    #  Sun Feb 20 17:40:09 MET 2000 - Alexis
    #  GNU sort is fussy (as should all sorts I guess) about locale.
    #  Without setting it to 'C', 'b' comes between '/a' and '/c'!
    $old_lc_all = $ENV{'LC_ALL'};
    $ENV{'LC_ALL'} = "C";
    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: slurping from pipe '$fad_sort_cmd < $sort_file |' ...");
    if (!open(FROMSORT_HANDLE, "$fad_sort_cmd < $sort_file |")) {
        &ade_err_error($errstack_ref, fad_err_misc, "can't call sort to sort $sort_file");
        return($ade_err_fail);
    }
    $ENV{'LC_ALL'} = $old_lc_all;
    print $out_handle <FROMSORT_HANDLE>;
    close FROMSORT_HANDLE;
    unlink $sort_file;
    &ade_tmp_deregisterfile($errstack_ref, $sort_file);
    &ade_err_debug($errstack_ref, 40, "fadstore_to_fadstream: done");

    #  sensible return code
    return($ade_err_ok);
}

#  Take a filename and write all info about the filename (including the actual name) to the
#  passed array.
sub collect_info
{
    my($errstack_ref, $name, $suppress_crcs, $collected_info_array_ref_ref) = @_;

    my($linktext, $type, $dev, $inode, $nlink, $uid, $gid, $rdev);
    my($size, $atime, $mtime, $ctime, $blksize, $blocks, $oldslash);
    my ($i, $j, $buf, $contents, $mode, $fad_record, $smode, $pname, $pcontents);

    &ade_err_debug($errstack_ref, 40, "collect_info: processing $_ ...");

    #  For all fs entities we identify their type. How do you spot a 
    #  symbolic link? Assume it is one and try seeing where it points.
    if ($linktext = readlink($name)) {
        $type = $main::IT_SYMLINK;
        ($dev,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);

    #  If we can't see where it goes then I guess it's not a symbolic link.
    } elsif (!stat($name)) {
        return($ade_err_fail);
    } else {
        ($dev,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
        $type = $IT_FILE   if -f _;
        $type = $IT_DIR    if -d _;
        $type = $IT_PIPE   if -p _;
        $type = $IT_SOCKET if -S _;
        $type = $IT_BLOCK  if -b _;
        $type = $IT_CHAR   if -c _;
    }

    #  Now based on what it was, certain bits of information
    #  are ignored, and certain extra information is ascertained. For
    #  a symlink, we note the destination it points to.
    if ($type eq $main::IT_SYMLINK) {
        #  Can symbolic links by hard linked ? 
        $nlink = 1;
        $contents = $linktext;
        $uid = 0;
        $gid = 0;

    #  For a directory there is nothing else to note.
    } elsif ($type eq $IT_DIR) {
        #  Can directories by hard linked ?
        $nlink = 1;
        $contents = 0;

    #  For a file we get the CRC, if we can, unless instructed not to.
    } elsif ($type eq $IT_FILE && $suppress_crcs) {
        $contents = $BY_REQUEST_NOT_CHECKED;
   
    } elsif ($type eq $IT_FILE) {
        #  \0 to protect against trailing spaces (or leading '>') which open() will 
 	#  ignore (see perlfaq5(1) man page).
        if (open(CRCFP, "$name\0")) {
            #  $oldslash = $/;
            #  undef $/;
            $contents = 0;
            while (read(CRCFP, $buf, 262144)) {
                $contents += unpack("%32C*", $buf);
                $contents = $contents % 32767;
            }
            #  $/ = $oldslash;
            close(CRCFP);
        } else {
            &ade_err_warning($errstack_ref, ade_err_access, $name, "open", $!);
            $contents = $NOT_READABLE;
        }

    #  For device files we save the major and minode numbers
    } elsif ($type eq $IT_BLOCK) {
        $contents = $rdev;

    } elsif ($type eq $IT_CHAR) {
        $contents = $rdev;

    
    #  For a socket there's nothing.
    } elsif ($type eq $IT_SOCKET) {
        $contents = 0;

    #  For a pipe there's nothing.
    } elsif ($type eq $IT_PIPE) {
        $contents = 0;
    }

    #  Additionally the mode contains some junk at the high order
    #  bits so we mask them off.
    $mode &= 07777;

    ${$collected_info_array_ref_ref} = [$name, $dev, $inode, $type, $uid, $gid, $mode, $nlink, $contents];

    return($ade_err_ok);
}

sub modify_fadrecord_from_fadstore_by_name
{
    my($errstack_ref, $name, $attribs_ref, $names_ref, $madeupdevinodes_ref, $fad_record) = @_;
    my($rc);

    if (($rc = &delete_fadrecord_from_fadstore_by_name($errstack_ref, $name, $attribs_ref, $names_ref, $madeupdevinodes_ref)) != $ade_err_ok) {
        return($rc);
    } elsif (($rc = &insert_fadrecord_in_fadstore($errstack_ref, $fad_record, $attribs_ref, $names_ref, $madeupdevinodes_ref)) != $ade_err_ok) {
        return($rc);
    }

    return($ade_err_ok);
}

sub delete_fadrecord_from_fadstore_by_name
{
    my($errstack_ref, $name, $attribs_ref, $names_ref, $madeupdevinodes_ref) = @_;
    my($dev, $inode, $deleted_index, $i, $key, $names_dev, $names_inode);

    #  Get the dev and inode (which uniquely identifies the filesystem item itself)
    if (($rc=&escape($errstack_ref, $name, \$escaped_name)) != $ade_err_ok) {
        return($rc);
    }
    ($dev, $inode) = @{${$madeupdevinodes_ref}{$escaped_name}}{ qw( dev inode ) };
    &ade_err_debug($errstack_ref, 40, sprintf("delete_fadrecord_from_fadstore_by_name: dev/inode=%d/%d (name=%s), count=%d", $dev, $inode, $name, ${$attribs_ref}{$dev, $inode}->{namecnt}));

    #  What happens next depends whether there are multiple names for this item or
    #  not. This we can determine by looking at the 'namecnt' field in %attribs.
    if (${$attribs_ref}{$dev,$inode}->{namecnt} == 1) {

        #  If there is only one name, then we can delete all the records from
        #  the three passed hashes which refer to the passed name.
        delete ${$attribs_ref}{$dev,$inode};
        delete ${$madeupdevinodes_ref}{$escaped_name};
	#  The '0' is the index of the first - and in this case *only* - name for
	#  the filesystem item specified by the (dev,inode) pair.
        delete ${$names_ref}{$dev,$inode,0};

    } elsif (${$attribs_ref}{$dev,$inode}->{namecnt} > 1) {

        #  If there is more than one name then things are a little more complicated.
        #  First, we can simply delete the 'name to (dev,inode) lookup table.'
        delete ${$madeupdevinodes_ref}{$escaped_name};
        
        #  Second, and this is the complicated one, *somewhere* in the names hash,
        #  is stored the record which says that the nth name of the filesystem
        #  item identified by the (dev,inode) pair. Unfortunately, we don't know
        #  where it it. So we have to scan the table. We have something like 
        #  this:
        #
        #  $names(123,456,0) == "/some/file/or/other"
        #  $names(789,111,0) == "/bin/ed"
        #  $names(789,111,1) == "/bin/edit"
        #  $names(789,111,2) == "/bin/ex"
        #  $names(987,333,0) == "/some/other/stuff"
        #
        #  So when we delete the record (e.g. for "/bin/edit" in the example) we
        #  may be left with a missing name index (i.e. 0,2 in the example above),
        #  so we need to shuffle everything up, by modifying the indexes (i.e.
        #  to 0,1). Actually shuffling up is a bit difficult, 'cos either we
        #  need some temporary storage to move (not copy) the records we want to
        #  keep into, before we move those which we moved out (and didn't just
        #  delete) back in ... Hmm .... simple is to scan all the names for the
        #  fs item, delete the one we want to delete, but not its index, and
        #  then move the last item into that noted index's slot. (We undef 
        #  the index of the noted deleted item first, so that after we can 
        #  make a sanity test.)
        undef $deleted_index;
        foreach $key (keys %{$names_ref}) {
            ($names_dev, $names_inode, $i) = split($;, $key);
            next if ($names_dev != $dev || $names_inode != $inode);
            next if ${$names_ref}{$dev,$inode,$i} ne $escaped_name;
            $deleted_index = $i;
            #  We can make an optimisation here: if we have just deleted the
            #  name, then there is no point continuing the scan to the end of
            #  the hash, since we've already found what we were looking for.
            last;
        }
      	#  Ok, so now we move the last name for this item into the 
      	#  freed slot (assuming it wasn't the *last* name that we actually
      	#  deleted!) First we just make a sanity check that we didn't
      	#  try to delete an undefined item - but this should never be the
      	#  case.
      	&ade_err_internal($errstack_ref,"tried to delete unknown name ($name)!") if (!defined($deleted_index));
        if ($deleted_index != ${$attribs_ref}{$dev,$inode}->{namecnt} - 1) {
            ${$names_ref}{$dev,$inode,$deleted_index} = ${$names_ref}{$dev,$inode,${$attribs_ref}{$dev,$inode}->{namecnt}-1};
        }
        
        #  And finally, we decrement the name count in the attribs hash. (i.e.
        #  we say that there is one less name referring to this fs item).
        ${$attribs_ref}{$dev,$inode}->{namecnt}--;

    } else {
        &ade_err_internal($errstack_ref, sprintf("invalid name count %d for item '%s'", ${$attribs_ref}{$dev,$inode}->{namecnt}, $name));
    }

    return($ade_err_ok);
}

#
#  Remember: FAD records contain *already* escaped names.
#

sub insert_fadrecord_in_fadstore
{
    my($errstack_ref, $fad_record, $attribs_ref, $names_ref, $madeupdevinodes_ref) = @_;
    my($name, $type, $uid, $gid, $mode, $nlink, $contents, @othernames, $smode, $dev, $inode);
    my($i, $j, $escaped_contents, $unescaped_name);

    #&ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: sof: FAD store contains " . scalar(keys(%{$attribs_ref})) . " record(s)");

    #  The 'store' is actually three associate arrays. 
    #
    #  The first is %attribs which is indexed by device and inode, 
    #  and contains the type, uid, gid, mode, number of hard links, contents.
    #  Actually it also contains the dev and inode, but these are only used internally;
    #  as soon as a fadrecord is written to file these are stripped since they
    #  are not transportable (from host to host or point in time to point in time).
    #
    #  The second is %names which is indexed by device, inode number *and*
    #  name index number. It contains the name of the file.
    #
    #  The third is %madeupdevinodes. This maps file names to dev/inode pairs.
    #  It is used at printout time, to put the *other* names by which a file
    #  is known.
    #
    #  Certain calls to insert_fadrecord_in_fadstore()
    #  are immediately after calls to filename_to_fadrecord() - in which case the
    #  device and inode number can be passed. But in other situations a
    #  record is passed without actually examining the file explicitly and
    #  so the device and inode number are unknown.
    #
    #  To get round this we simply *make up* device and inode references,
    #  but use the information about hard linked items to re-serve previously
    #  made up device/inode pairs where appropriate. So for this function's
    #  reference only, we have another array which maps names to inode/device
    #  pairs.
   
    #  Although the record has winged its way around as a packed (join'ed) scalar,
    #  the FAD store stores the attributes in a more detailed and accessible manner
    #  though this is not meant for direct access by applications. So we start
    #  by chopping the record back up ...

    #  IMPORTANT NOTE: *EITHER* the record we split here contains some othernames
    #  (if the record was read from a file) *OR* the dev and inode are set because
    #  we're passing around data about a recently (i.e. in the same process) scanned
    #  file. *BOTH IS IMPOSSIBLE*.

    &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: fad_record=$fad_record");

    if (($rc=&unpack_fadrec($errstack_ref, $fad_record, \$unpacked_fadrec_array_ref)) != $ade_err_ok) {
        return($rc);
    }
    ($name, $dev, $inode, $type, $uid, $gid, $smode, $nlink, $contents, @othernames) = @{$unpacked_fadrec_array_ref};
    &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: smode=$smode");

    #  For historic reasons we turn the mode from an '0...'-style string back into a
    #  number here, but really if we do that then we ought also to de-uriescape the
    #  file name (and contents if is symlink). Perhaps this should be moved inside
    #  &unpack_fadrec().
    #$mode = oct($smode);
    $mode = $smode;
    &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: mode=$mode");

    #  determine dev and inode number for name - and record hardlinks if new
    if (defined($dev) && $dev && defined($inode) && $inode) {
        &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: name=$name, using passed dev and inode (dev=$dev, inode=$inode) ...");
    } elsif (defined(${$madeupdevinodes_ref}{$name})) {
        &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: using previously gen'd dev and inode");
        $dev = ${$madeupdevinodes_ref}{$escaped_name}->{dev};
        $inode = ${$madeupdevinodes_ref}{$escaped_name}->{inode};
    } else {
        &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: gen'ing dev and inode ...");
        $dev = 123;
        $inode = ++$newinodenumber;
    }

    #  Previously we only recorded the dev and inode of the name if the dev and inode
    #  were made up (e.g. by fadcat). But delete_fadrecord_from_fadstore() uses the
    #  madeupdevinodes hash as its first port of call, so we must now unconditionally
    #  insert it. (Ok, this is redundant if the entry already exists, but it does no
    #  harm and it simplifies the code.
    ${$madeupdevinodes_ref}{$name} = { dev => $dev, inode => $inode };
        
    #  Even in the low memory version we push the info into the structures
    #  But in the low memory version, we immediately print it and delete it
    #  if we have encounted all hardlinks (or there were no other hardlinks).
    if (!defined(${$attribs_ref}{$dev, $inode}->{namecnt})) {
        ${$attribs_ref}{$dev, $inode}->{type}     = $type;
        ${$attribs_ref}{$dev, $inode}->{uid}      = $uid;
        ${$attribs_ref}{$dev, $inode}->{gid}      = $gid;
        ${$attribs_ref}{$dev, $inode}->{mode}     = $mode;
        ${$attribs_ref}{$dev, $inode}->{nlink}    = $nlink;
        ${$attribs_ref}{$dev, $inode}->{contents} = $contents;
        #  we must initialise this to zero since it gets used as a key in
        #  a hash, which is scanned *numerically*. (Failure to set it to 
        #  zero results in looking for an entry with key '0' which doesn't
        #  exist.
        ${$attribs_ref}{$dev, $inode}->{namecnt}  = 0;
    } 
    ${$names_ref}{$dev, $inode, ${$attribs_ref}{$dev, $inode}->{namecnt}} = $name;
    
    ${$attribs_ref}{$dev, $inode}->{namecnt}++;
    &ade_err_debug($errstack_ref, 40, sprintf("insert_fadrecord_in_fadstore: dev/inode=%d/%d (name=%s), count=%d", $dev, $inode, $name, ${$attribs_ref}{$dev, $inode}->{namecnt}));
    
    #  This little bit of code is used by 'fadcat' only. If othernames 
    #  were in the record then note that these names are references to 
    #  the same disk item for future reference.
    foreach (@othernames) {
        &ade_err_debug($errstack_ref, 40, "insert_fadrecord_in_fadstore: noting $_ has same dev/inode as $name");
        ${$madeupdevinodes_ref}{$_} = ${$madeupdevinodes_ref}{$name};
    }

    &ade_err_debug($errstack_ref, 40, sprintf("insert_fadrecord_in_fadstore: name=%s: after insertion: attribs-count=%d, names-count=%d, madeupdevinodes-count=%d", $name, scalar(keys(%{$attribs_ref})), scalar(keys(%{$names_ref})), scalar(keys(%{$madeupdevinodes_ref}))));
}

sub load_config_file
{
    my($errstack_ref, $config_file, $find_filters_ref, $find_roots_ref, $other_tuples_ref) = @_;
    my($lineno);

    if (!open(CONFIG_HANDLE, $config_file)) {
        &ade_err_error($errstack_ref, fad_err_misc, "can't open $config_file");
        return($ade_err_fail);
    }
    while (<CONFIG_HANDLE>) {
        chomp;
        $lineno++;
  
        #  Ignore blank lines and hash-led comments
        (/^\s*$/ || /^\s*\#.*$/) && next;

        #  If the line starts with a "r" then its a root definition line
        if (/^r\s+(\S+)\s*$/) {
            if ($1 =~ /^[^\/]/) {
                &ade_err_error($errstack_ref, fad_err_misc, "$config_file:$lineno: non-absolute root");
                return($ade_err_fail);
            }
            if (-e $1) {
                push(@{$find_roots_ref}, $1);
            } else {
                &ade_err_debug($errstack_ref, 50, "load_config_file: $1: root does not exist; warning ...");
                &ade_err_warning($errstack_ref, ade_err_access, $1, "access", $!);
                &ade_err_debug($errstack_ref, 50, "load_config_file: warning done");
            }

        #  If the line starts with a "i" or "e" then its a filter
        } elsif (/([ie])\s+(.*?)\s*$/) {
            if (($rc=&ade_smf_isvalidregexp($errstack_ref, $2)) != $ade_err_ok) {
                return($ade_err_fail);
            }
            push(@{$find_filters_ref}, {
                 type    => $1,
                 pattern => $2,
            });
        } else {
            #  If no array for other config pars supplied then error
            &ade_err_internal($errstack_ref,"$config_file:$lineno: entry") if ($other_tuples_ref == undef);
            #  'split' without params splits $_ on whitespace - exactly what we want!
            push(@{$other_tuples_ref}, [ split ]);
        }
    }
    close CONFIG_HANDLE;

    #  It is an error not to have any valid roots.
    if ($#{$find_roots_ref} == -1) {
        &ade_err_error($errstack_ref, fad_err_misc, "$config_file: no valid roots found");
        return($ade_err_fail);
    }

    return($ade_err_ok);
}

sub findhier_to_fadstore
{
    my($errstack_ref, $find_filters_ref, $find_roots_ref, $attribs_ref, $names_ref, $madeupdevinodes_ref, $suppress_crcs) = @_;

    &ade_err_debug($errstack_ref, 50, "findhier_to_fadstore: sof");
    #  File::Find will call &wanted and that will need to list of filters
    #  and the FAD store. Since we can't pass arbitrary variables through
    #  File::Find's interface, we put refs to the stuff into globals.
    $main::attribs_ref = $attribs_ref;
    $main::names_ref = $names_ref;
    $main::madeupdevinodes_ref = $madeupdevinodes_ref;
    $main::find_filters_ref = $find_filters_ref;
    $main::suppress_crcs = $suppress_crcs;

    &ade_err_debug($errstack_ref, 50, "findhier_to_fadstore: calling File::Find::find; roots are: " . join(", ", @{$find_roots_ref}));
    &File::Find::find(\&wanted, @{$find_roots_ref});

    return($ade_err_ok);
}

#  This function needs improving - 54% of execution time is spent in this
#  function (not calls).

sub wanted
{
    my($errstack_ref, $passed, $i, $j, $dev);
    local($_);
    my($find_filters_ref, $suppress_crcs, $attribs_ref, $names_ref, $madeupdevinodes_ref) = ($main::find_filters_ref, $main::suppress_crcs, $main::attribs_ref, $main::names_ref, $main::madeupdevinodes_ref);

    #  Check all the filters for something that matches $name (the name of
    #  the file passed by &find.
    for ($i=0, $passed=1; $i <= $#{$find_filters_ref}; $i++) {

        #  If we have a matching file, set $passed accordingly.
        if ($File::Find::name =~ /^${$find_filters_ref}[$i]{pattern}$/) {
            $passed = (${$find_filters_ref}[$i]{type} eq "i") ? 1 : 0;
        }

        #  The above is actually enough! But we can make a substatantial
        #  optimization: if the pattern is for excluding $name/.* then we
        #  can prune this branch, *providing* there are no subsequent 
	#  inclusions which would mean that this exclused directory could
	#  contain something we need to include.

        #  So if the *exclusion* itself (not the thing excluded) is of
	#  the form '.../.*' and the current name matches the bit without
	#  the '/.*' and the thing is a directory, (and the pattern is
	#  an exclusion, not an inclusion) ...
        if (${$find_filters_ref}[$i]{pattern} =~ m!^(.*)/\.\*$! && $File::Find::name =~ /^$1$/ && -d $File::Find::name && ${$find_filters_ref}[$i]{type} eq "e") {
            #  ... search all remaining patterns ...
            for ($j=$i+1; $j<=$#{$find_filters_ref}; $j++) {
                #  ... and if there is an inclusion of the form $name/something then
                #  $name cannot be pruned
                (${$find_filters_ref}[$j]{type} eq "i" && ${$find_filters_ref}[$j]{pattern} =~ /^\Q$File::Find::name\E\/.+$/) && last;
                #  If there is an inclusion of the form .*something then 
                #  $name cannot be pruned
                (${$find_filters_ref}[$j]{type} eq "i" && ${$find_filters_ref}[$j]{pattern} =~ /^\.\*/) && last;
            }
            #  If we got to the end of that search loop (without 'last'ing out
	    #  on an inclusion) then we may prune
            $File::Find::prune |= 1 if ($j > $#{$find_filters_ref});
        }
    }

    #  If after all the filtering, $name is not to be included then return before
    #  sticking it in store.
    return ($ade_err_ok) if (!$passed);

    #  Stick it in the store.
    if (($rc=&collect_info($errstack_ref, $File::Find::name, $suppress_crcs, \$collected_info_array_ref)) != $ade_err_ok) {
        return($rc);
    }
    if (($rc=&pack_fadrec($errstack_ref, $collected_info_array_ref, \$packed_fadrec)) != $ade_err_ok) {
        return($rc);
    }
    if (($rc=&insert_fadrecord_in_fadstore($errstack_ref, $packed_fadrec, $attribs_ref, $names_ref, $madeupdevinodes_ref)) != $ade_err_ok) {
        return($rc);
    }

    #  Return code not used by caller, which is a perl module.
}

sub select_name_from_fadstore
{
    #  Of the three variables which identify the FAD store, only $names_ref
    #  is actually used here. The remaining two are supplied simply in order to 
    #  have a consistent interface.
    my($errstack_ref, $attribs_ref, $names_ref, $madeupdevinodes_ref, $namearray_ref) = @_;

    @{$namearray_ref} = (map { &unescape($_) } values %{$names_ref});

    return($ade_err_ok);
}

sub escape
{
    my ($errstack_ref, $what, $what_escaped_ref) = @_;
    ${$what_escaped_ref} = &URI::Escape::uri_escape($what, "%$fs$rs");

    return($ade_err_ok);
}

sub unescape
{
    my ($errstack_ref, $what, $what_unescaped_ref) = @_;
    ${$what_unescaped_ref} = &URI::Escape::uri_unescape($what);

    return($ade_err_ok);
}

sub pack_fadrec
{
    #my ($errstack_ref, $name, $dev, $inode, $type, $uid, $gid, $mode, $nlink, $contents) = @_;
    my ($errstack_ref, $collected_info_array_ref, $packed_fadrec_ref) = @_;
    my ($escaped_name);

    ($name, $dev, $inode, $type, $uid, $gid, $mode, $nlink, $contents) = @{$collected_info_array_ref};
    &ade_err_debug($errstack_ref, 40, "pack_fadrec: name=$name, dev=$dev, inode=$inode ...");

    if (($rc=&escape($errstack_ref, $name, \$escaped_name)) != $ade_err_ok) {
        return($rc);
    }

    ${$packed_fadrec_ref} = join($fs, 
        #  The item name can contain dangerous characters, so escape them
        $escaped_name,
        $dev, 
        $inode, 
        $type, 
        $uid, 
        $gid, 
        #  In the fadstore and in files, the mode is in octal
        sprintf("%o", $mode),
        $nlink, 
        #  Symlinks destinations can contain dangerous characters, so escape them, note 
    	#  that '%' must also be escaped otherwise filenames which include URI escape
        #  *already* will be unURI'd when unpacked, and that will result in mismatching
	#  filenames.
        ($type eq $main::IT_SYMLINK) ? &escape($contents) : $contents);

    return($ade_err_ok);
}

sub select_fadrecord_from_fadstore_by_name
{
    #  Of the three variables which identify the FAD store, only $names_ref and 
    #  $attribs_ref are actually used here. The remaining one is supplied simply in
    #  order to have a consistent interface.
    my($errstack_ref, $name, $attribs_ref, $names_ref, $madeupdevinodes_ref, $packed_fadrec_ref) = @_;
    #&ade_err_debug($errstack_ref, 40, sprintf("select_fadrecord_from_fadstore_by_name: name=%s, attribs-count=%d, names-count=%d, madeupdevinodes-count=%d", $name, scalar(keys(%{$attribs_ref})), scalar(keys(%{$names_ref})), scalar(keys(%{$madeupdevinodes_ref})))); 
    my($dev, $inode, $type, $uid, $gid, $mode, $nlink, $contents);

    #  From the name, get the dev and inode.
    ($dev, $inode) = @{${$madeupdevinodes_ref}{&escape($name)}}{ qw( dev inode ) };

    #&ade_err_debug($errstack_ref, 40, "select_fadrecord_from_fadstore_by_name: for $name, retrieved dev=$dev,inode=$inode");

    #  Why do I bother reassembling the whole record? Why just pass the record?
    $type = ${$attribs_ref}{$dev, $inode}{type};
    $uid = ${$attribs_ref}{$dev, $inode}{uid};
    $gid = ${$attribs_ref}{$dev, $inode}{gid};
    $mode = ${$attribs_ref}{$dev, $inode}{mode};
    $nlink = ${$attribs_ref}{$dev, $inode}{nlink};
    $contents = ${$attribs_ref}{$dev, $inode}{contents};
    $contents = ($type eq $main::IT_SYMLINK) ? &unescape($contents) : $contents;
    if (($rc=&pack_fadrec($errstack_ref, [$name, $dev, $inode, $type, $uid, $gid, $mode, $nlink, $contents], $packed_fadrec_ref)) != $ade_err_ok) {
        return($rc);
    }

    return($ade_err_ok);
}

sub unpack_fadrec
{
    my ($errstack_ref, $fadrecord, $unpacked_fadrec_array_ref_ref) = @_;
    my ($name, $dev, $inode, $type, $uid, $gid, $mode, $nlink, $contents);
    my (@escaped_othernames, $escaped_name, $escaped_contents, @othernames);

    ($escaped_name, $dev, $inode, $type, $uid, $gid, $mode, $nlink, $escaped_contents, @escaped_othernames) = split($fs, $fadrecord);

    if ($type eq $main::IT_SYMLINK) {
        if (($rc=&unescape($errstack, $escaped_contents, \$contents)) != $ade_err_ok) {
            return($rc);
        }
    } else {
        $contents = $escaped_contents;
    }

    if (($rc=&unescape($errstack, $escaped_name, \$name)) != $ade_err_ok) {
        return($rc);
    }

    @othernames = map { 
        if (($rc=&unescape($errstack_ref, $_, \$unescaped_underscore_ref)) != $ade_err_ok) {
            return($rc);
        }
        $unescaped_underscore_ref;
    } @escaped_othernames;

    ${$unpacked_fadrec_array_ref_ref} = [$name, $dev, $inode, $type, $uid, $gid, oct($mode), $nlink, $contents, @othernames];

    return($ade_err_ok);
}

sub version_fad
{
    my ($errstack_ref) = @_; shift;

    printf "FAD format version: $fad_version\n";
    printf "FAD sort method:    %s\n", $fad_sort_cmd ? "external" : "internal"; 
    printf "FAD record sorter:  $fad_sort_cmd\n" if ($fad_sort_cmd);
}

sub _fad_loadtimechecks
{
    my ($errstack_ref) = @_; shift;

    chop($unames = `uname -s`);
    if ($ENV{'FAD_SORT_CMD'}) {
        $fad_sort_cmd = $ENV{'FAD_SORT_CMD'};
    } elsif ($unames eq 'HP-UX') {
        $fad_sort_cmd = "/usr/bin/sort -t%s -k1,1";
    } elsif ($unames eq 'SunOS') {
        $fad_sort_cmd = "/usr/bin/sort -t%s +0 -1";
    } elsif ($unames ne 'Linux') {
        &ade_err_error($errstack_ref, fad_err_misc, "don't know how to sort under $unames; set FAD_SORT_CMD");
        return($ade_err_fail);
    } elsif (-f "/etc/debian_version") {
        $fad_sort_cmd = "/usr/bin/sort -t%s -k 1,1";
    } elsif (-f "/etc/redhat-release") {
        $fad_sort_cmd = "/bin/sort -t%s +0 -1";
    } else {
        &ade_err_error($errstack_ref, fad_err_misc, "don't know how to sort under this distribution of Linux; set FAD_SORT_CMD");
        return($ade_err_fail);
    }
    
    #  check sort command defined
    if (!$fad_sort_cmd) {
        &ade_err_error($errstack_ref, fad_err_misc, "sorting command not defined!");
	return($ade_err_fail);
    }
    
    #  check it's absolute
    if ($fad_sort_cmd !~ /^\//) {
        &ade_err_internal($errstack_ref, "FAD_SORT_CMD ($fad_sort_cmd) not absolute");
    }
    
    #  check it's executable
    if (! -x ($fad_sort_cmd =~ /^([^\s]+)/)[0]) {
        &ade_err_error($errstack_ref, fad_err_misc, "can't execute $fad_sort_cmd");
	return($ade_err_fail);
    }
    #  Change the field separator in the sort command if it's defined
    $fad_sort_cmd = sprintf($fad_sort_cmd, $fs);
    
    #  Name of a temporary scratch file created when &mkfad is called in
    #  low memory mode.
    $sort_file = "$ade_tmp_dir/$ade_app_progname.$$.sort";
}

&_fad_loadtimechecks(undef);
