#!/bin/env perl

# The program should tell you which files have been added to the hierarchy, and 
# which files have been altered
# 
# What if file names include : in them?
#
    use strict;
    use warnings;

    use Time::Local;
    use Cwd;
    use IO::File;
#    use TsortOpt;

    # Here are the global variables that leak between the various packages
    # in this file
    use vars ('$operating_system','$top_dir','$generate');
    use vars ('$top_dir','$verbose','$file_name');
    use vars ('$no_size','$no_checksum','$no_mtime');
    use vars ('$no_mode','$ignore','$follow_links');
    use vars ('$simplify','$no_tk');

    my($size,$sum,$value,$fname);
    my($mtime,$ctime,$mode,$check,$dir);

    my %options = ("generate","BOOL","dir",":top_dir",
                "verbose","BOOL","file",":file_name",
                "no_size","BOOL:no_size","no_checksum","BOOL:no_checksum",
                "no_mtime","BOOL:no_mtime","no_mode","BOOL:no_mode",
                "ignore","N/A","follow-links","BOOL:follow_links",
                "simplify","BOOL","no_tk","BOOL");

    &init();
    
    # To find the directory we have a number of possible options
    #   1.  We were given a -dir <dir_name> option
    #        Use the one we were given
    #   2.  A checksum file was specified
    #        Find the highest common directory and use that
    #   3.  None of the above
    #        Use . with a checksum file called "check.sum"
    if($top_dir)
      {
        if(!$file_name)
          {
            $file_name = $top_dir."/check.sum";
          }
      }
    elsif(!$generate && $file_name)
      {
        # We must scan the file finding the longest directory spec that matches 
        # all the files
        my($best_match);

        my $ifh = IO::File->new($file_name);
        if(!defined $ifh)
          {
            print STDERR "Cannot read checksum file \"$file_name\"\n";
            exit 0;
          }
        $best_match = "";
        while(<$ifh>)
          {
            next if(/^#/);
            if($best_match)
              {
                if($best_match ne substr($_,0,length($best_match)))
                  {
                    my $count;
                    for($count=0;$count<length($best_match);$count++)
                      {
                        last if(substr($best_match,$count,1) ne substr($_,$count,1));
                      }
                    $best_match = substr($_,0,$count);
                  }
              }
            else
              {
                $best_match = $_;
              }
          }
        $ifh->close();
        # cut the best match back to just before the final /
        $best_match =~ s/\/[^\/]*$//;
        $dir = $best_match;
      }
    else
      {
        $dir = ".";
        $file_name = $dir."/check.sum" if (!$file_name);
      }

    # Generate an associative array of what is really there
    if($verbose)
      {
        report("Scanning directory \"$dir\"");
        report("Checksum file is   \"$file_name\"");
      }

    # This call sets up the associative array so that for each actual file we find
    # we are given
    #   $actual{$file_name} = "real:$size:$checksum"
    # the first field indicates that the file is really there (other values will be
    # "same" "diff" and "file")
    my %actual = &find_files($dir);

#    local(*FILE_OUT);

    # If we are using the script to generate the file we can now go ahead
    if($generate)
       {
        my $fh;

        $fh = IO::File->new(">".$file_name);
        if(!defined $fh)
          {
            err_report("Cannot open \"$file_name\"");
            # exit(20);
            return(20);
          }
        print $fh "# Checksum file for the check_dir script\n";

        foreach my $file (sort keys(%actual))
           {
            my($t1,$size,$check,$mtime,$mode) = split(/:/,$actual{$file});
            print $fh "$file:$size:$check:$mtime:$mode\n";
            }
        $fh->close();
        exit(0);
        }

    # Now read the listing file in comparison
    open(FILE_LIST,$file_name);
    while(<FILE_LIST>)
       {
        chop;
        next if (/^#/);
        my($fname,$fsiz,$fchk,$fmtime,$fmode) = split(/:/,$_);

        # We want to ignore all the things in the file that match
        # our ignore flag, or our checksum file
        next if($fname =~ /^$ignore/);
        next if($fname =~ m#^\./$ignore#);
        next if($fname =~ m#^$file_name$#);
        next if($fname =~ m#^\./$file_name$#);

        if(!$actual{$fname})
           {
            # In file but does not appear in real life
            $actual{$fname} = "file:$fsiz:$fchk:$fmtime:$fmode";
            }
          else
           {
            my($rtyp,$rsiz,$rchk,$rmtime,$rmode) = split(/:/,$actual{$fname});
            if((!$no_size      && ($fsiz   != $rsiz)) ||
               # A File checksum of "N/A" implies that the checksums were 
               # off when the file was generated
               (($fchk =~ /\d/) && 
                !$no_checksum  && ($fchk   != $rchk  )) ||
               (($rmtime =~ /\d/) &&
                !$no_mtime     && ($fmtime != $rmtime)) ||
               (!$no_mode      && ($fmode  != $rmode )))
               {
                # The thing in the file is different!!
                $actual{$fname} = join(':',"diff",$rsiz,$rchk,$rmtime,$rmode,
                                                  $fsiz,$fchk,$fmtime,$fmode);
                }
              else
               {
                $actual{$fname} = "same:$fsiz:$fchk:$fmtime:$fmode";
                }
            }
        }
    close(FILE_LIST);

    # Now that we have the details give the user a summary of the differences
    my $extra_files = 0;
    my $first = 1;
    foreach my $file (sort keys(%actual))
       {
        my($state,$size,$check,$mtime,$mode,$s2,$c2,$m2,$o2) = split(/:/,$actual{$file});
        if($state eq "real")
           {
            if($extra_files == 0)
               {
                report("\nExtra files in hierarchy") if(!$simplify);
                $first = 0;
                }
            if($simplify)
               {
                report("extra:$file");
                }
              else
               {
                report("  $file");
                }
            $extra_files++;
            }
        }

    my $missing_files = 0;
    foreach my $file (sort keys(%actual))
       {
        my($state,$size,$check,$mtime,$mode,$s2,$c2,$m2,$o2) = split(/:/,$actual{$file});
        if($state eq "file")
           {
            if($missing_files == 0)
               {
                report("\nFiles missing from hierarchy") if(!$simplify);
                $first = 0;
                }
            if($simplify)
               {
                report("missing:$file");
                }
              else
               {
                report("  $file");
                }
            $missing_files++;
            }
        }

    my $changed_files = 0;
    foreach my $file (sort keys(%actual))
       {
        my($state,$size,$check,$mtime,$mode,$s2,$c2,$m2,$o2) = split(/:/,$actual{$file});
        if($state eq "diff")
           {
            if($changed_files == 0)
               {
                report("\nFiles altered in hierarchy") if(!$simplify);
                $first = 0;
                }
            print "  ";
            if(!$no_size)
               {
                if($size == $s2)
                   {
                    print "      ";
                    }
                  else
                   {
                    print "size  ";
                    }
                }
            if(!$no_checksum)
               {
                if($check == $c2)
                   {
                    print "          ";
                    }
                  else
                   {
                    print "checksum  ";
                    }
                }
            if(!$no_mtime)
               {
                if($mtime == $m2)
                   {
                    print "       ";
                    }
                  else
                   {
                    print "mtime  ";
                    }
                }
            if(!$no_mode)
               {
                if($mode == $o2)
                   {
                    print "      ";
                    }
                  else
                   {
                    print "mode  ";
                    }
                }
            print ":" if($simplify);
            print "$file\n";
            $changed_files++;
            }
        }

    if($extra_files==0 && $missing_files==0 && $changed_files==0)
       {
        report("Hierarchy consistent with check file") if(!$simplify);
        exit(0);
        }
      elsif(!$simplify)
       {
        printf"\n";
        printf"%5d Extra files\n",$extra_files;
        printf"%5d Missing files\n",$missing_files;
        printf"%5d Changed files\n",$changed_files;
        exit(10);
        }
        
sub report
  {
    my(@lines) = @_;
    foreach my $line (@lines)
      {
        print $line."\n";
      }
  }

sub find_files
   {
    my($root_dir) = @_;
    my(%ret,$this_file,@files);
    local(*DIR_FH);

    opendir(DIR_FH,$root_dir);
    # Ignore the . and .. entries 
    @files = grep(!/^\.\.?$/,readdir(DIR_FH));
    closedir(DIR_FH);
    while($this_file = shift(@files))
       {
        $this_file = $root_dir."/".$this_file;

        # Ignore all files that start with the ignore string
        next if($this_file =~ /^$ignore/);
        next if($this_file =~ m#^\./$ignore#);

        # Who checks the checksums?
        next if($this_file =~ m/^$file_name$/);
        next if($this_file =~ m#^\./$file_name$#);

        if(-l $this_file && !$follow_links)
           {
            my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                                   $atime,$mtime,$ctime) = lstat($this_file);

            $mtime = "N/A"; # NGC says we never want to check the mod time of
                            # symbolic links
            
            if($no_checksum)
               {
                $check = "N/A";
                }
              else
               {
                $check = &checksum($this_file, 1 );
                }

            $ret{$this_file} = "real:$size:$check:$mtime:$mode";
            if($verbose)
               {
                printf"Found %28s %7d %7d %7d %3o\n",$this_file,$size,
                                                      $check,$mtime,$mode;
                }
            }
          elsif(-d $this_file)
           {
            my(%next);

            # Merge in the record from the subdirectory
            %next = &find_files($this_file);
            foreach my $f (keys(%next))
               {
                $ret{$f} = $next{$f};
                }
            }
          else
           {
            # An ordinary file
            my($check);
            my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                                   $atime,$mtime,$ctime) = stat($this_file);

            if($no_checksum)
               {
                $check = "N/A";
                }
              else
               {
                $check = &checksum($this_file, 0 );
                }
            if($verbose)
               {
                printf"Found %28s %7d %7d %7d %3o\n",$this_file,$size,$check,$mtime,$mode;
                }
            # Replace multiple // with a single /
            ($this_file =~ s/\/\//\//g);
            $ret{$this_file} = "real:$size:$check:$mtime:$mode";
            }
        }
    return(%ret);
    }

sub checksum
   {
    my($fname, $link ) = @_;

    return "43210";

    my($cmd,$sum,$this);
    local(*FPTR);

    # I am not assuming that the "sum" program is on the local system
    # I am using OdChkSum instead

    # Since running sum on a file which we cannot read is silly
    return(-1) if(!-r $fname);

    $cmd = "OdChkSum" ;
    $cmd .= " -l" if( $link ) ;

    # Check for special file types
    # if we get one then don't look at the contents, 
    # the command "sum /dev/zero" can take quite a while 
    # to complete
    return(10) if(-p $fname);
    return(11) if(-S $fname);
    return(12) if(-b $fname);
    return(13) if(-c $fname);

    if(open(FPTR,"$cmd $fname|"))
       {
        $sum = <FPTR> ;
        chop $sum ;
        close(FPTR);
        }
    else
       {
        $sum = 0;
        }
    $sum =~ s/^\s*// ;
    $sum =~ s/\s.*// ;
    return($sum);
    }

sub checksum_old
   {
    my($fname) = @_;
    my($sum,$this);
    local(*FPTR);

    # I am assuming that the "sum" program is on the local system

    # Since running sum on a file which we cannot read is silly
    return(-1) if(!-r $fname);

    # Check for special file types
    # if we get one then don't look at the contents, 
    # the command "sum /dev/zero" can take quite a while 
    # to complete
    return(10) if(-p $fname);
    return(11) if(-S $fname);
    return(12) if(-b $fname);
    return(13) if(-c $fname);

    if(open(FPTR,"sum $fname|"))
       {
        read(FPTR,$sum,5);
        close(FPTR);
        }
    else
       {
        $sum = 0;
        }
    return($sum);
    }

sub link_sum
   {
    my($value) = @_;
    my($sum,$ch);

    $sum = 0;
    while($value)
       {
        $ch = substr($value,0,1);
        substr($value,0,1) = "";
        $sum = ($sum + 1)*(1+unpack("c",$ch));
        $sum &= 0xffff;
        }
    return($sum);
    }

sub require_if_present
  {
    # So here is a trick for discovering if the module is 
    # available (and loading it if it is).  This function returns 
    # True if the module is there and this generally sets a 
    # flag to tell the rest of the program how to behave
    my($module_name) = @_;
    my($module_found);
    
    $module_found = 0;
    
    eval(<<"LoadModule");
        # Use require so we don't load the module if it is not there
        require $module_name;
        \$module_found = 1;
LoadModule

    return($module_found);
  }

sub init
  {
    # I could just use $^O here but I have an aversion to 
    # putting control characters in scripts
    $operating_system = eval(sprintf('$%c',0xf));

    TsortOpt::get(%options);
  }

{
# General way to handle command line options in Perl
# putting the module here makes distribution easier
package TsortOpt;

sub usage
  {
    # Tell the user what the options are and quit
    my(%options) = @_;
    my($opt,$arg_str,$var,$val,$count,$c2);

    print  STDERR "\n";
    print  STDERR "Program options with default values\n";
    for $opt (keys(%options))
      {
        print STDERR "    -$opt ";
        $arg_str = $options{$opt};
        while($arg_str !~ /^$/)
          {
            ($var,$arg_str) = split(/;/,$arg_str,2);
            ($val,$var) = split(/:/,$var);
            if($val ne "BOOL")
              {
                print STDERR "$val ";
              }
          }
        print STDERR "\n";
      }
    print STDERR "\n";
    exit;
  }

sub get
  {
    # Read the command line options 
    my(%options) = @_;
    my($count,$c2,$arg_str,$var,$val,$opt);

    for $opt (keys(%options))
      {
        # First scan all the options setting the variables to the default values
        $arg_str = $options{$opt};
        $c2 = 0;
        while($arg_str)
          {
            ($var,$arg_str) = split(/;/,$arg_str,2);
            ($val,$var) = split(/:/,$var);
            if(!$var)
              {
                if($c2 == 0)
                  {
                    $var = $opt;
                  }
                else
                  {
                    $var = "$opt$c2";
                  }
              }
            if($val eq "BOOL")
              {
                eval "\$::$var = \"\"";
                ::add_output("eval 5545 returned: $@\n") if($@);
              }
            else
              {
                eval "\$::$var = \"$val\"";
                ::add_output("eval 5550 returned: $@\n") if($@);
              }    
            $c2++;
          }
      }

    # Read the options from the command line
    for ($count=0;$count <= $#ARGV;$count++)
      {
        next if($count > $#ARGV);
        # Ignore if does not start with a "-"
        next if ($ARGV[$count] !~ /^-/);

        # Extract and strip off leading "-"
        $opt = $ARGV[$count];
        $opt =~ s/^-//;

        # Show usage if requested
        show_usage(%options) if($opt eq "usage");

        # Show usage if not a recognised option
        $arg_str = $options{$opt};
        if(!defined $arg_str || $arg_str eq "")
          {
            # For this application we want to pass unrecognised options 
            # to the program
            next;
          }
        splice(@ARGV,$count,1);
        $c2 = 0;
        while(defined $arg_str && $arg_str ne "")
          {
            ($var,$arg_str) = split(/;/,$arg_str,2);
            ($val,$var) = split(/:/,$var);
            if(!defined $var || $var eq "")
              {
                if($c2 == 0)
                  {
                    $var = $opt;
                  }
                else
                  {
                    $var = "$opt$c2";
                  }
              }
            if($val eq "BOOL")
              {
                eval "\$::$var = 1";
                ::add_output("eval 5598 returned: $@\n") if($@);
              }
            else
              {
                $val = splice(@ARGV,$count,1);
                if($val =~ /^\"/)
                  {
                    ($opt,$val) = split(/\"/,$val);
                  }
                eval "\$::$var = \"$val\"";
                ::add_output("eval 5608 returned: $@\n") if($@);
              }    
            $c2++;
          }
        redo;
      }
  }
}

{
# A record that tells us about a file
package FileRecord;

my(%all_files);

sub write_to_file
  {
  }

sub read_from_file
  {
  }
}
