#  $HeadURL$ $LastChangedRevision$
package FAD;  # assumes Some/Module.pm

use strict;
#  Allow bare words, so &ade_err_error() calls look nicer.
no strict 'subs';
use warnings;
use lib substr `ade-config ade_include_prefix`,0,-1;
use ADE;
use File::Find;
use URI::Escape;
use Data::Dumper;

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    $VERSION     = 1.00;

    @ISA         = qw(Exporter);
    @EXPORT      = qw(fad_diff fad_dump fad_load fad_collect_info fad_insert_info $IT_FILE $IT_DIR $IT_PIPE $IT_SYMLINK $IT_BLOCK $IT_CHAR $IT_SOCKET $CT_DELETED $CT_ADDED $CT_TYPE $CT_OWNER $CT_GROUP $CT_MODE $CT_LINKS $CT_CONT_MAJMIN $CT_CONT_CRC $CT_CONT_SYMLINK $BY_REQUEST_NOT_CHECKED $NOT_READABLE);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

    # your exported package globals go here,
    # as well as any optionally exported functions
    @EXPORT_OK   = qw($Var1 %Hashit &func3);
}
our @EXPORT_OK;

# exported package globals go here
our $Var1;
our %Hashit;
#  Change types. $CT_TYPE refers to a change in the items
#  type field as listed above.
our($CT_DELETED, $CT_ADDED, $CT_TYPE, $CT_OWNER, $CT_GROUP, $CT_MODE, $CT_LINKS, $CT_CONT_MAJMIN, $CT_CONT_CRC, $CT_CONT_SYMLINK);

# non-exported package globals go here
our @more;
our $stuff;

# initialize package globals, first exported ones
$Var1   = '';
%Hashit = ();
($CT_DELETED, $CT_ADDED, $CT_TYPE, $CT_OWNER, $CT_GROUP, $CT_MODE, $CT_LINKS, $CT_CONT_MAJMIN, $CT_CONT_CRC, $CT_CONT_SYMLINK) = qw(d a t u g m l s C S);


# then the others (which are still accessible as $Some::Module::stuff)
$stuff  = '';
@more   = ();

# all file-scoped lexicals must be created before
# the functions below that use them.

# file-private lexicals go here
my $priv_var    = '';
my %secret_hash = ();
my($subversion_string) = '# $HeadURL$ $LastChangedRevision$';
#  File system object type descriptors
my($IT_FILE, $IT_DIR, $IT_PIPE, $IT_SYMLINK, $IT_BLOCK, $IT_CHAR, $IT_SOCKET) = qw(f d p l b c s);
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($magic_number) = "FaDFiLe";
my($fad_version) = "4";
my(%fad_defined_errors) = (
        fad_err_misc  => { fmt => "%s" },
    );

# here's a file-private function as a closure,
# callable as &$priv_func;  it cannot be prototyped.
my $priv_func = sub {
    # stuff goes here.
};

# make all your functions, whether exported or not;
# remember to put something interesting in the {} stubs
sub func1      {}    # no prototype
sub func2()    {}    # proto'd void
sub func3($$)  {}    # proto'd to 2 scalars

# this one isn't exported, but could be called!
sub func4(\%)  {}    # proto'd to 1 hash ref

#  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, $d, $rc);
    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, $new_other_names_index, $old_other_names_index);
    my(%old_hash_by_filename, %new_hash_by_filename, @new_index_by_filename, @old_index_by_filename, $new_index_offset, $old_index_offset);

    &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;
        }
    }
    $d = Data::Dumper->new([\%old_hash_by_filename]);
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped hash is " . $d->Dump);
    undef $d;

    #  Make an ordered list of *those* filenames.
    @old_index_by_filename = sort { $a cmp $b } keys %old_hash_by_filename;
    $d = Data::Dumper->new([\@old_index_by_filename]);
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped index is " . $d->Dump);
    undef $d;
    
    #  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;
        }
    }

    $d = Data::Dumper->new([\%new_hash_by_filename]);
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped hash is " . $d->Dump);
    undef $d;
    #  Make an ordered list of *those* filenames.
    @new_index_by_filename = sort { $a cmp $b } keys %new_hash_by_filename;
    $d = Data::Dumper->new([\@new_index_by_filename]);
    &ade_err_debug($errstack_ref, 40, "fad_diff: dumped index is " . $d->Dump);
    undef $d;
    

    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);

        if ($old_index_offset < $#old_index_by_filename+1) {
            $old_name = $old_index_by_filename[$old_index_offset];
            @old_other_names = sort @{${$old_store_ref}{$old_hash_by_filename{$old_name}}{names}};
            $old_type = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{type};
            $old_owner = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{owner};
            $old_group = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{group};
            $old_mode = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{mode};
            $old_links = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{links};
            $old_content = ${$old_store_ref}{$old_hash_by_filename{$old_name}}{data}{content};
            &ade_err_debug($errstack_ref, 4, "fad_diff: old_name=$old_name, old_index_offset=$old_index_offset, #old_index_by_filename=" . ($#old_index_by_filename+1) . ", old_type=$old_type, old_owner=$old_owner, old_group=$old_group, old_links=$old_links, old_content=$old_content");
        } else {
            &ade_err_debug($errstack_ref, 4, "fad_diff: no old data left to read");
        }

        if ($new_index_offset < $#new_index_by_filename+1) {
            $new_name = $new_index_by_filename[$new_index_offset];
            @new_other_names = sort @{${$new_store_ref}{$new_hash_by_filename{$new_name}}{names}};
            $new_type = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{type};
            $new_owner = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{owner};
            $new_group = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{group};
            $new_mode = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{mode};
            $new_links = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{links};
            $new_content = ${$new_store_ref}{$new_hash_by_filename{$new_name}}{data}{content};
            &ade_err_debug($errstack_ref, 4, "fad_diff: new_name=$new_name, new_index_offset=$new_index_offset, #new_index_by_filename=" . ($#new_index_by_filename+1) . ", new_type=$new_type, new_owner=$new_owner, new_group=$new_group, new_links=$new_links, new_content=$new_content");
        } else {
            &ade_err_debug($errstack_ref, 4, "fad_diff: no new data left to read");
        }


        &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 => $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 => $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 => $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 => $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 => $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 => $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 => $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 eq $NOT_READABLE || $new_content eq $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 $new_content && ($old_content eq $BY_REQUEST_NOT_CHECKED && $new_content eq $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 eq $BY_REQUEST_NOT_CHECKED || $new_content eq $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 => $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 => $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 => $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 (%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) = @_;
    my($d, $rc);

    if (($rc=&_fad_header_write($errstack_ref, $out_handle)) != $ade_err_ok) {
        return($rc);
    }
    $d = Data::Dumper->new([$data_store_ref]);
    print $out_handle $d->Dump;
    return($ade_err_ok);
}

sub fad_load
{
    my($errstack_ref, $in_handle, $old_store_ref, $regexp) = @_;
    my($code, $VAR1, $key, $new_hash_by_filename, $filename);
    my(%old_hash_by_filename, %new_hash_by_filename, $rc);

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

    #  Generate index by filename of old data.
    foreach $key (keys %{$old_store_ref}) {
        foreach $filename (@{${$old_store_ref}{$key}{names}}) {
            &ade_err_debug($errstack_ref, 40, "fad_load: old data: processing $filename ...");
            $old_hash_by_filename{$filename} = $key;
        }
    }

    #  Read new data's header.
    if (($rc=&_fad_header_read($errstack_ref, $in_handle, undef)) != $ade_err_ok) {
        return($rc);
    }

    #  Read new data's body.
    &ade_err_debug($errstack_ref, 40, "fad_load: slurping ...");
    { local $/; undef $/; $code = scalar(<$in_handle>); }
    &ade_err_debug($errstack_ref, 40, "fad_load: code=[$code]");
    eval $code;
 
    #  Generate index by filename of new data.
    foreach $key (keys %{$VAR1}) {
        foreach $filename (@{${$VAR1}{$key}{names}}) {
            &ade_err_debug($errstack_ref, 40, "fad_load: new data: processing $filename ...");
            $new_hash_by_filename{$filename} = $key;
        }
    }

    #  Loop over each new item, rejecting it if it is to be filtered
    #  out, flagging an error if it exists already, otherwise inserting it.
    &ade_err_debug($errstack_ref, 40, "fad_load: looping over new names ...");
    foreach $filename (keys %new_hash_by_filename) {
        &ade_err_debug($errstack_ref, 40, "fad_load: processing $filename ...");
        if (defined($regexp) && $filename !~ /$regexp/) {
            &ade_err_debug($errstack_ref, 40, "fad_load: $filename: filtered out");
            next;
        } elsif (defined($old_hash_by_filename{$filename})) {
            &ade_err_error($errstack_ref, fad_err_misc, "$filename: characteristics for this file loaded already");
            return($ade_err_fail);
        } else {
            &ade_err_debug($errstack_ref, 40, "fad_load: $filename: inserting ...");
            ${$old_store_ref}{$new_hash_by_filename{$filename}} = ${$VAR1}{$new_hash_by_filename{$filename}};
        }
    }

    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 = $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 $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) = @_;

    #  Statutory headers
    print $out_handle "$magic_number\n";
    print $out_handle "FAD-Version: $fad_version\n";

    #  Version-specific headers
    print $out_handle "Unix-Time: " . time . "\n";

    #  End of headers marker
    print $out_handle "EOH\n";

    return($ade_err_ok);
}

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

 

    &ade_err_debug($errstack_ref, 40, "_fad_header_read: reading magic number");
    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
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: looping over remaining lines ...");
    $had_eoh = 0;
    while (!$had_eoh && !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(/:\s*/, $read_header_line, 2);
        $val = 0 if (defined($key) && !defined($val));
        if ($key eq "EOH") {
            $had_eoh = 1;
        } else {
            $read_header{$key} = $val;
            &ade_err_debug($errstack_ref, 40, "_fad_header_read: read header (key=$key, val=$val)");
        }
    }
    #  If (had EOF and) not yet had end-of-headers marker then error.
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: checking headers were terminated ...");
    if (!$had_eoh) {
        &ade_err_debug($errstack_ref, 40, "_fad_header_read: headers were not terminated");
        &ade_err_error($errstack_ref, fad_err_misc, "headers not terminated");
        return($ade_err_fail);
    }
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: headers were terminated");

    #  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);
    }
    
    &ade_err_debug($errstack_ref, 40, "_fad_header_read: validating 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);
    }

    #  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{'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 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, "delete_fadrecord_from_fadstore_by_name: dev/inode=$dev/$inode (name=$name), count=${$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);
#}
#

#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 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) = @_;
#    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 $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 _fad_loadtimechecks
{
    my ($errstack_ref) = @_; shift;

    &ade_err_registerdefderrs(\%fad_defined_errors);

    return($ade_err_ok);
}

END { }       # module clean-up code here (global destructor)

## YOUR CODE GOES HERE
&_fad_loadtimechecks(undef);

1;  # don't forget to return a true value from the file

