#!/bin/env perl5

# Todo
#
#   File rename/move options
#   Help display?
#   Tab dialog?
#
    # Manipulate file attributes
    use strict;
    use warnings;

    use Win32::File;
    use Tk;
    use Tk::DirTree;
#    use Tk::FileSelect;
    use Time::Local;

    # Global vars for the callback methods
    my($main_win,$done_but,$cancel_but,$report_lab);
    my($txt_area,$pickdir_but,$showdir_entry);
    my($operating_system);

#    my($place,$index,$pat,$max_thumb,$thumb_width);
#    my($keep_ext,$ignore_tilde,$as_text);

    # I should create a new date handling package but...
    my(@months,%month2val,@long_months);
    my($now_time,$now_hour,$now_min,$now_dom,$now_mon,$now_year);
    &time_init;

    my($match_dir,$match_base,$match_ext);
    my($match_min,$match_max);
    my($match_mbefore,$match_mafter);
    my($match_cbefore,$match_cafter);
    my($match_abefore,$match_aafter);
    my($match_mbefore_str,$match_mafter_str);
    my($match_cbefore_str,$match_cafter_str);
    # Access times are strange
#    my($match_abefore_str,$match_aafter_str);

    my($action_delete,$action_notesize);
    my($action_mtime,$action_mtime_str);
#    my($action_atime,$action_atime_str);

    my($start_dir,$error_text);
    my($report_when,$l,%total_sizes);
    my($save_listing_name,$save_list_open);

    my(@win_attribs,%sizes);

    # I could just use $^O here but I have an aversion to 
    # putting control characters in scripts
    $operating_system = eval(sprintf('$%c',0xf));

    $report_when = "match";  # "never,match,all"
    $match_dir  = '.*';
    $match_base = '.*';
    $match_ext  = '.*';
    $match_min = "0k";
    $match_max = "2T";
#    $match_abefore_str = 
    $match_cbefore_str = $match_mbefore_str = "now";
#    $match_aafter_str = 
    $match_cafter_str = $match_mafter_str = "00:00 1 Jan 1980";

    $action_delete = "";
    $action_notesize = "";
    $action_mtime_str = "";
#    $action_atime_str = "";

    @win_attribs = ("archive","normal","compressed",
                    "directory","hidden",
                    "offline","readonly","system","temporary");
    %sizes = (
        "k" => 1024,
        "K" => 1024,
        "m" => 1024*1024,
        "M" => 1024*1024,
        "g" => 1024*1024*1024,
        "G" => 1024*1024*1024,
        "t" => 1024*1024*1024*1024,
        "T" => 1024*1024*1024*1024,
      );
      
    foreach $l (@win_attribs)
      {
        no strict;
        ${"match_".$l}  = "ignore";
        ${"action_".$l} = "ignore";
      }

    &make_interface;
    MainLoop;
    exit(0);

sub make_interface
  {
    require Cwd;
    my($t_frame,$m_frame,$b_frame,$p_frame,$a_frame);
    my($report_option);
    my($tt_frame);
    my($row,$col,$l);

    $start_dir = Cwd::getcwd();

    $main_win = new MainWindow(
        -title   => "Change Win32 File Attributes",
      );

    $t_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'top',
          );

    $m_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'top',
          );

    $p_frame = $m_frame->Frame(
        -borderwidth  => 3,
        -relief       => "sunken",
      )->pack(
            -fill => 'y',
            -side => 'left',
          );

    $a_frame = $m_frame->Frame(
        -borderwidth  => 3,
        -relief       => "sunken",
      )->pack(
            -fill => 'y',
            -side => 'right',
          );

    $b_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'bottom'
          );

    # Override some functions in DirTree for MSWindows
        eval(<<'EndOverride') if($operating_system =~ /^MSWin/i);
         # Override some funs for windows
         package Tk::DirTree;
         use no warning;
         sub has_subdir {1}
         sub DirCmd {
             my ($w, $dir, undef) = @_;
             $dir =~ s/^(\w:)$/$1\//;
             my $h = DirHandle->new($dir) or return;
             my @names = grep( $_ ne '.' && $_ ne '..', $h->read );
             return @names;
         }
         sub add_to_tree {
             my( $w, $dir, $name, $parent ) = @_;

             my $image = $w->Getimage( $w->cget('-image') );
             my $mode = 'none';
             $mode = 'open' if $w->has_subdir( $dir );

             my @args = (-image => $image, -text => $name);
             if( $parent ) {             # Add in alphabetical order.
                 foreach my $sib ($w->infoChildren( $parent )) {
                     if( lc($sib) gt lc($dir) ) {
                         push @args, (-before => $sib);
                         last;
                     }
                 }
             }

             $w->add( $dir, @args );
             $w->setmode( $dir, $mode );
         }
EndOverride

    # We want the main text area last so that it expands
    $txt_area = $main_win->Scrolled('Text',
        -scrollbars => 'oe',
      )->pack(
            -fill => 'both',
            -side => 'top'
          );

    $report_option = $t_frame->Optionmenu(
        -options => ["never","match","all","not"],
        -variable => \$report_when,
      )->pack(
            -side => 'right',
          );

    $t_frame->Label(
        -text => "  Report when:"
      )->pack(
            -side => 'right',
          );
    
#    $tt_frame = $t_frame->Frame(
#      )->pack(
#            -fill => 'x',
#            -side => 'top'
#          );

    $pickdir_but = $t_frame->Button(
        -text => "Browse",
        -command => \&select_start_dir,
      )->pack(
            -side => 'right',
          );

    $showdir_entry = $t_frame->Entry(
        -textvariable => \$start_dir,
      )->pack(
            -fill => 'both',
          );

    # Specify the pattern for matching against
    $p_frame->Label(
        -text    => "Pattern to match",
      )->grid(
            -row     => 0,
            -column  => 0,
            -columnspan => 6,
          );

    $p_frame->Label(
        -text    => "Directory",
      )->grid(
            -row     => 1,
            -column  => 0,
            -columnspan => 2,
            -sticky  => "s",
          );

    $p_frame->Entry(
        -textvariable => \$match_dir,
      )->grid(
            -row     => 2,
            -column  => 0,
            -columnspan => 2,
            -sticky  => "n",
          );

    $p_frame->Label(
        -text    => "Base Filename",
      )->grid(
            -row     => 1,
            -column  => 2,
            -columnspan => 2,
            -sticky  => "s",
          );
    $p_frame->Entry(
        -textvariable => \$match_base,
      )->grid(
            -row     => 2,
            -column  => 2,
            -columnspan => 2,
            -sticky  => "n",
          );

    $p_frame->Label(
        -text    => "Extension",
      )->grid(
            -row     => 1,
            -column  => 4,
            -sticky  => "s",
          );
    $p_frame->Entry(
        -textvariable => \$match_ext,
        -width => 6,
      )->grid(
            -row     => 2,
            -column  => 4,
            -sticky  => "n",
          );

    $row = 3;
    $col = 0;
    foreach $l (@win_attribs)
      {
        no strict;
        $p_frame->Label(
            -text => "\u$l",
          )->grid(
                -row => $row,
                -column => $col,
                -sticky  => "e",
            );
        $p_frame->Optionmenu(
            -options => ["ignore","set","unset"],
            -variable => \${"match_$l"},
          )->grid(
                -row => $row,
                -column => $col+1,
                -sticky  => "w",
            );
        $col+=2;
        if($col >= 6)
          {
            $col = 0;
            $row++;
          }
      }

    $p_frame->Label(
        -text    => "Size at least",
      )->grid(
            -row     => 6,
            -column  => 0,
            -columnspan => 1,
            -sticky  => "e",
          );
    $p_frame->Entry(
        -textvariable => \$match_min,
        -width => 6,
      )->grid(
            -row     => 6,
            -column  => 1,
            -sticky  => "w",
          );

    $p_frame->Label(
        -text    => "Size at most",
      )->grid(
            -row     => 6,
            -column  => 3,
            -columnspan => 1,
            -sticky  => "e",
          );
    $p_frame->Entry(
        -textvariable => \$match_max,
        -width => 6,
      )->grid(
            -row     => 6,
            -column  => 4,
            -sticky  => "w",
          );

    $p_frame->Label(
        -text    => "Created Before",
      )->grid(
            -row     => 7,
            -column  => 0,
            -columnspan => 1,
            -sticky  => "e",
          );

    $p_frame->Entry(
        -textvariable => \$match_cbefore_str,
      )->grid(
            -row     => 7,
            -column  => 1,
            -columnspan => 2,
            -sticky  => "w",
          );
    $p_frame->Label(
        -text    => "Created After",
      )->grid(
            -row     => 7,
            -column  => 3,
            -columnspan => 1,
            -sticky  => "e",
          );
    $p_frame->Entry(
        -textvariable => \$match_cafter_str,
      )->grid(
            -row     => 7,
            -column  => 4,
            -columnspan => 2,
            -sticky  => "w",
          );

    $p_frame->Label(
        -text    => "Modified Before",
      )->grid(
            -row     => 8,
            -column  => 0,
            -columnspan => 1,
            -sticky  => "e",
          );
    $p_frame->Entry(
        -textvariable => \$match_mbefore_str,
      )->grid(
            -row     => 8,
            -column  => 1,
            -columnspan => 2,
            -sticky  => "w",
          );
    $p_frame->Label(
        -text    => "Modified After",
      )->grid(
            -row     => 8,
            -column  => 3,
            -columnspan => 1,
            -sticky  => "e",
          );
    $p_frame->Entry(
        -textvariable => \$match_mafter_str,
      )->grid(
            -row     => 8,
            -column  => 4,
            -columnspan => 2,
            -sticky  => "w",
          );

#    $p_frame->Label(
#        -text    => "Accessed Before",
#      )->grid(
#            -row     => 9,
#            -column  => 0,
#            -columnspan => 1,
#            -sticky  => "e",
#          );
#    $p_frame->Entry(
#        -textvariable => \$match_abefore_str,
#      )->grid(
#            -row     => 9,
#            -column  => 1,
#            -columnspan => 2,
#            -sticky  => "w",
#          );
#    $p_frame->Label(
#        -text    => "Accessed After",
#      )->grid(
#            -row     => 9,
#            -column  => 3,
#            -columnspan => 1,
#            -sticky  => "e",
#          );
#    $p_frame->Entry(
#        -textvariable => \$match_aafter_str,
#      )->grid(
#            -row     => 9,
#            -column  => 4,
#            -columnspan => 2,
#            -sticky  => "w",
#          );

    # The action to carry out
    $a_frame->Label(
        -text    => "Action on matching files",
      )->grid(
            -row     => 0,
            -column  => 0,
            -columnspan => 6,
          );

    $a_frame->Checkbutton(
        -text     => "Delete files",
        -variable => \$action_delete,
      )->grid(
            -row     => 1,
            -column  => 0,
            -columnspan => 2,
          );
    $a_frame->Checkbutton(
        -text     => "Note Sizes",
        -variable => \$action_notesize,
      )->grid(
            -row     => 1,
            -column  => 4,
            -columnspan => 2,
          );

    $row = 3;
    $col = 0;
    foreach $l (@win_attribs)
      {
        no strict;
        $a_frame->Label(
            -text => "\u$l",
          )->grid(
              -row => $row,
              -column => $col,
                -sticky  => "e",
            );
        $a_frame->Optionmenu(
            -options => ["ignore","set","unset"],
            -variable => \${"action_$l"},
          )->grid(
              -row => $row,
              -column => $col+1,
                -sticky  => "w",
            );
        $col+=2;
        if($col >= 6)
          {
            $col = 0;
            $row++;
          }
      }

    $a_frame->Label(
        -text    => "Set Modified Time",
      )->grid(
            -row     => 8,
            -column  => 0,
            -columnspan => 2,
            -sticky  => "e",
          );
    $a_frame->Entry(
        -textvariable => \$action_mtime_str,
      )->grid(
            -row     => 8,
            -column  => 2,
            -columnspan => 2,
            -sticky  => "w",
          );
    
    $a_frame->Label(
        -text    => "Save Listing To",
      )->grid(
            -row     => 9,
            -column  => 0,
            -columnspan => 2,
            -sticky  => "e",
          );
    $a_frame->Entry(
        -textvariable => \$save_listing_name,
      )->grid(
            -row     => 9,
            -column  => 2,
            -columnspan => 3,
            -sticky  => "w",
          );
    
        
#    $a_frame->Label(
#        -text    => "Set Accessed Time",
#      )->grid(
#            -row     => 9,
#            -column  => 0,
#            -columnspan => 2,
#            -sticky  => "e",
#          );
#    $a_frame->Entry(
#        -textvariable => \$action_atime_str,
#      )->grid(
#            -row     => 9,
#            -column  => 2,
#            -columnspan => 2,
#            -sticky  => "w",
#          );
    
    # Bottom frame
    $done_but = $b_frame->Button(
        -text    => "Start",
        -command => \&start,
      )->pack(
            -side => 'left',
            -fill => 'y',
          );

    $cancel_but = $b_frame->Button(
        -text    => "Done",
        -command => sub {$main_win->destroy},
      )->pack(
            -side => 'right',
            -fill => 'y',
          );

    $report_lab = $b_frame->Label(
        -text    => $error_text,
      )->pack(
            -fill => 'both',
          );
  }

sub select_start_dir
  {
    &select_dir(\$start_dir);
  }

sub select_dir
  {
    # If we have a directory tree browser use it to select 
    # the directory
    my($dir_ref) = @_;
    my($status,$scrolled,$dtdialog);
    my($dtdialog_frame,$dtdialog_scrolled,$dtdialog_ok,$dtdialog_dir);

    $dtdialog = $main_win->Toplevel;
    $dtdialog->title("Choose Directory");
    $dtdialog_frame = $dtdialog->Frame->pack(
        -fill => "x",
        -side => "bottom"
      );
    $dtdialog_scrolled = $dtdialog->Scrolled('DirTree',
        -scrollbars => 'osoe',
        -width => 35,
        -height => 20,
        -selectmode => 'browse',
        -exportselection => 1,
        -browsecmd => sub {$dtdialog_dir=shift},
        -command   => sub {$dtdialog_ok = 1 },
      )->pack(-fill => "both", -expand => 1);

    if($operating_system =~ /^MSWin/i)
      {
        require Win32API::File;

        my(@drv,$d,$p);
        $p = " "x105;
        &Win32API::File::GetLogicalDriveStrings(105,$p);
        foreach $d (split(/\x00/,$p))
          {
            $d =~ s/\\//g;
            $d = lc($d);
            next if(${$dir_ref} =~ /^$d/i);
            $dtdialog_scrolled->add_to_tree($d, $d);
          }
      }

    $dtdialog_frame->Button(-text => 'OK',
        -command => sub {$dtdialog_ok =  1}
      )->pack(-side => 'left');
    $dtdialog_frame->Button(-text => 'Cancel',
        -command => sub {$dtdialog_ok = -1}
      )->pack(-side => 'left');

    $dtdialog_ok = 0;
    $dtdialog_dir = ${$dir_ref};
    $dtdialog_frame->waitVariable(\$dtdialog_ok);

    if ($dtdialog_ok == 1)
      {
        if (-x $dtdialog_dir)
          {
            $dtdialog_dir =~ s/^(\w):$/$1:\//;
            ${$dir_ref} = $dtdialog_dir;
          }
        else
          {
            &add_output("$dtdialog_dir doesn't exist");
          }
      }
    $dtdialog->withdraw;
    $dtdialog->destroy;    
  }

sub start
  {
    $txt_area->delete("0.0","end");
    $match_mbefore = &str2time($match_mbefore_str);
    $match_mafter  = &str2time($match_mafter_str);
    $match_cbefore = &str2time($match_cbefore_str);
    $match_cafter  = &str2time($match_cafter_str);
#    $match_abefore = &str2time($match_abefore_str);
#    $match_aafter  = &str2time($match_aafter_str);
    if($match_mbefore == 0 || $match_mafter == 0 ||
#         $match_abefore == 0 || $match_aafter == 0 ||
         $match_cbefore == 0 || $match_cafter == 0)
      {
        return;
      }
    if($action_mtime_str)
      {
        $action_mtime = &str2time($action_mtime_str);
        return if($action_mtime == 0)
      }
    else
      {
        $action_mtime = 0;
      }
#    if($action_atime_str)
#      {
#        $action_atime = &str2time($action_atime_str);
#        return if($action_atime == 0)
#      }
#    else
#      {
#        $action_atime = 0;
#      }
    $start_dir =~ s#/+$##;
    if(!-d $start_dir)
      {
        &error("\"$start_dir\" is not a directory");
        return;
      }

    if($start_dir =~ m#^\S+\:$#)
      {
        # A start directory of "C:" needs special handling
        chdir "$start_dir/";
      }
    else
      {
        chdir $start_dir;
      }
    if($save_listing_name)
      {
        open(LISTOUT,">$start_dir/$save_listing_name");
        $save_list_open = 1;
      }
    %total_sizes = ();
    &do_dir($start_dir);
    if($action_notesize)
      {
        my(%reverse_sizes,$f,$s);
        
        &report("-"x83);
        foreach $f (keys(%total_sizes))
          {
            $s = $total_sizes{$f};
            if($reverse_sizes{$s})
              {
                # Must splice into the existing list
                my(@files,$i);
                @files = @{$reverse_sizes{$s}};
                @files = sort bylength (@files,$f);
                $reverse_sizes{$s} = \@files;
              }
            else
              {
                $reverse_sizes{$s} = [$f];
              }
          }
        foreach $s (sort numerically keys(%reverse_sizes))
          {
            my(@files);
            @files = @{$reverse_sizes{$s}};
            foreach $f (@files)
              {
                &report("  ".&tell_size($s)."  ->  $f");
              }
          }
      }
    &report("#"x83);
    if($save_listing_name)
      {
        $save_list_open = 0;
        close(LISTOUT);
      }
  }

sub numerically
  {
    return($a <=> $b);
  }

sub bylength
  {
    return(length($b) <=> length($a));
  }

sub do_dir
  {
    my($dir) = @_;
    my($name,@files,@subdirs);
    local(*DIR);

    opendir(DIR,"$dir/");
    @files = readdir(DIR);
    closedir(DIR);
    
    foreach $name (@files)
      {
        my(%fstat);

        next if($name =~ /^\./);
        %fstat = &stat_file("$dir/$name");
        if(!%fstat)
          {
            next;
          }
          
        if(&is_match(%fstat))
          {
            %fstat = &do_file(%fstat);
            # Report after we have done the action
            &report_file(%fstat) if($report_when ne "never" && $report_when ne "not");
          }
        elsif($report_when eq "all" || $report_when eq "not")
          {
            &report_file(%fstat);
          }

        # Check the dir again in case we just deleted it
        if(-d "$dir/$name")
          {
            &do_dir("$dir/$name");
          }
      }
  }

sub is_match
  {
    my(%fstat) = @_;
    my($l,$m_min,$m_max);
    
    # Match  dir_name, base_name, ext_name
    return "" if($match_dir && !($fstat{"dir_name"} =~ /^$match_dir$/i));
    return "" if($match_ext && !($fstat{"base_name"} =~ /^$match_base$/i));
    # The extension is a bit strange, if the user types an empty 
    # string then we really want an empty extension
    if(!$match_ext && $fstat{"ext_name"})
      {
        return "";
      }
    elsif($match_ext && !($fstat{"ext_name"} =~ /^$match_ext$/i))
      {
        return "";
      }

    # Check out the file attributes
    foreach $l (@win_attribs)
      {
        no strict;
        my($match);
        
        $match = ${"match_$l"};
        next if($match eq "ignore");
        if($match eq "set")
          {
            return "" if(!$fstat{$l});
          }
        else
          {
            return "" if($fstat{$l});
          }
      }

    # File size
    $m_min = &parse_size($match_min);
    if($m_min < 0)
      {
        &error("Min size $m_min!");
      }
    return "" if($fstat{"size"} < $m_min);
    $m_max = &parse_size($match_max);
    if($m_max < 0)
      {
        &error("Max size $m_max!");
      }
    return "" if($fstat{"size"} > $m_max);
        
    # Modification time
    return "" if($fstat{"mtime"} > $match_mbefore);
    return "" if($fstat{"mtime"} < $match_mafter);

    # Creation time
    return "" if($fstat{"ctime"} > $match_cbefore);
    return "" if($fstat{"ctime"} < $match_cafter);
    
    # Access time
#    return "" if($fstat{"atime"} > $match_abefore);
#    return "" if($fstat{"atime"} < $match_aafter);
    
    # If we got through all the tests then we have a winner!
    return 1;
  }

sub parse_size
  {
    my($in) = @_;
    my($s);
    return($in) if($in =~ /^\s*\d+\s*$/);
    
    if($in =~ /(\d+\.\d*|\d*\.\d+|\d+)\s*(\S)/i)
      {
        if(!$sizes{$2})
          {
            &error("Invalid size spec char $2");
            return 0;
          }
        return(int($1 * $sizes{$2}));
      }
    &error("Cannot parse size \"$in\"");
    return 0;
  }

sub tell_size
  {
    my($size)  = @_;
    my($factor,$v);

    foreach $factor ("T","G","M","k")
      {
        $v = int($size/$sizes{$factor});
        return(sprintf("%5d ${factor}b",$v)) if($v > 9);
      }
    sprintf("%5d   ",$size);
  }

sub note_size
  {
    my(%fstat) = @_;
    my($name,$size);
    my($lc_start_dir);
    
    # Assume running on Windows    
    $name = lc($fstat{"name"});
    $size = $fstat{"size"};
    return if(!$size);

    # Remove the starting directory from the name
    $name = "./".substr($name,length($start_dir));
    $name =~ s#//+#/#g;
    
    while($name)
      {
        if($total_sizes{$name})
          {
            $total_sizes{$name} += $size;
          }
        else
          {
            $total_sizes{$name} = $size;
          }
        if($name =~ s#[\/\\]+[^\/\\]*$##)
          {
            # Just take off dir
          }
        elsif($name =~ s#^\.+$##)
          {
            # Up to disk
          }
        elsif($name =~ s#^(\w+)\:.+$#$1\:#)
          {
            # Up to disk
          }
        else
          {
            $name = "";
          }
      }
  }

sub do_file
  {
    # Action: delete, set attrib, change mtime
    my(%fstat) = @_;
    my($l,$change,$flag);
    
    if($action_delete)
      {
        unlink($fstat{"name"});
        return;
      }
    elsif($action_notesize)
      {
        &note_size(%fstat);
      }

    $change = "";
    $flag = 0;
    foreach $l (@win_attribs)
      {
        no strict;
        my($match);
        
        $match = ${"action_$l"};
        next if($match eq "ignore");
        if($match eq "set" && !$fstat{$l})
          {
            $fstat{$l} = 1;
            $change = 1;
            $flag |= eval("\U$l");
          }
        elsif($match eq "unset" && $fstat{$l})
          {
            $fstat{$l} = "";
            $change = 1;
          }
        elsif($fstat{$l})
          {
            $flag |= eval("\U$l");
          }
      }
    if($change)
      {
        Win32::File::SetAttributes($fstat{"name"},$flag);
      }

    if($action_mtime != 0) # || $action_atime != 0)
      {
        $fstat{"mtime"} = $action_mtime if($action_mtime != 0);
#        $fstat{"atime"} = $action_atime if($action_atime != 0);
        utime($fstat{"atime"},$fstat{"mtime"},$fstat{"name"});
      }

    # I can't see how to change the file creation time from perl
    # under UNIX this is the inode modification time and is more
    # complex.

    return(%fstat);
  }

sub stat_file
  {
    # Find out all about a file
    my($name) = @_;
    
    my($attribs,@stat,%fstat,$n,$t);

    $fstat{"name"} = $name;
    $n = $name;
    if($n =~ s#^(.*)/([^/]+)$#$2#)
      {
        $fstat{"dir_name"} = $1;
      }
    else
      {
        $fstat{"dir_name"} = $1;
      }
    # This will not work if we follow soft links
    # (but windows doesn't have any so...)
    $fstat{"dir_name"} =~ s#^$start_dir\/*##;

    if($n =~ /^(.*)\.([^\.]+)$/)
      {
        $fstat{"base_name"} = $1;
        $fstat{"ext_name"} = $2;
      }
    else
      {
        $fstat{"base_name"} = $n;
        $fstat{"ext_name"} = "";
      }

    if(!Win32::File::GetAttributes($name,$attribs))
      {
        &error(sprintf("%-20s Failed to get attribures",$name));
        return ();
      }
    $fstat{"archive"} = 1    if($attribs & ARCHIVE);
    $fstat{"compressed"} = 1 if($attribs & COMPRESSED);
    $fstat{"directory"} = 1  if($attribs & DIRECTORY);
    $fstat{"normal"} = 1     if($attribs & NORMAL);
    $fstat{"hidden"} = 1     if($attribs & HIDDEN);
    $fstat{"offline"} = 1    if($attribs & OFFLINE);
    $fstat{"readonly"} = 1   if($attribs & READONLY);
    $fstat{"system"} = 1     if($attribs & SYSTEM);
    $fstat{"temporary"} = 1  if($attribs & TEMPORARY);

    @stat = stat($name);
    if(!@stat)
      {
        &error(sprintf("%-20s Stat failed",$name));
        return ();
      }
    $fstat{"size"} =  $stat[7];
    $fstat{"atime"} = $stat[8];
    $fstat{"mtime"} = $stat[9];
    $fstat{"ctime"} = $stat[10];

    return(%fstat);
  }

sub report_file
  {
    my(%fstat) = @_;
    my($flags,$l,$c);
    
    foreach $l (@win_attribs)
      {
        $c = substr($l,0,1);
        $c = "\U$c";
        if($fstat{$l})
          {
            $flags .= $c;
          }
        else
          {
            $flags .= "-";
          }
      }
    &report(sprintf(" %15s %-4s %8d %s  %s  %-25s ",
        $fstat{"base_name"},$fstat{"ext_name"},$fstat{"size"},$flags,
        &time2str($fstat{"mtime"}),$fstat{"dir_name"}));
  }

sub report
  {
    my($line) = @_;

    $txt_area->insert('end',$line . "\n");
    if($save_list_open)
      {
        print LISTOUT "$line\n";
      }
  }

sub error
  {
    my($l) = @_;
    $error_text = $l;
    $report_lab->configure(-text => $error_text);
    &report($error_text);
  }

######################################################################

sub time_init
  {
    my($i);

    @months = 
      (
        '',
        'Jan','Feb','Mar','Apr','May','Jun',
        'Jul','Aug','Sep','Oct','Nov','Dec'
      );
    @long_months =
      (
        '',
        'January',   'February', 'March',    'April', 
        'May',       'June',     'July',     'August', 
        'September', 'October',  'November', 'December'
      );
    for($i=0;$i<=$#months;$i++)
      {
        my($m);

        $m = $months[$i];
        $month2val{$m}     = $i;
        $month2val{"\l$m"} = $i;
        $month2val{"\U$m"} = $i;
      }
    for($i=1;$i<=$#long_months;$i++)
      {
        my($m);

        $m = $long_months[$i];
        $month2val{$m}     = $i;
        $month2val{"\l$m"} = $i;
        $month2val{"\U$m"} = $i;
      }
    $now_time = &time2str(time);
    if($now_time =~ /^(\d\d):(\d\d)\s+(\d+)\s+(\S+)\s+(\d\d\d\d)$/)
      {
        $now_hour  = $1;
        $now_min   = $2;
        $now_dom   = $3;
        $now_mon   = $4;
        $now_year  = $5;
      }
    else
      {
        print STDERR "Bad date string \"$now_time\"\n";
        exit(19);
      }
  }

sub time2str
  {
    my($time) = @_;
    my($s,$mi,$h,$d,$mo,$y) = localtime($time);
    my($ret);
    
    $y += 2000 if($y < 70);
    $y += 1900 if($y < 200);
    $ret = sprintf("%02d:%02d %2d %s %04d",$h,$mi,$d,$months[$mo+1],$y);
    return($ret);
  }

sub str2time
  {
    my($date_str,$end_of) = @_;
    my($actual_date,$hour,$min,$day,$month_str,$month_val,$year);

    $actual_date = &date_to_std($date_str,$end_of);
    if($actual_date =~ /^(\d\d):(\d\d)\s+(\d+)\s+(\S+)\s+(\d\d\d\d)$/)
      {
        ($hour,$min,$day,$month_str,$year) = ($1,$2,$3,$4,$5);
        if(!$month2val{$month_str})
          {
            &error("Cannot parse month \"$month_str\"");
            my($s,$mi,$h,$d,$mo,$y) = localtime(time);
            $month_val = $mo;
          }
        else
          {
            $month_val = $month2val{$month_str} - 1;
          }
        return(timelocal(0,$min,$hour,$day,$month_val,$year));
      }
    else
      {
        &error("Cannot parse date spec \"$date_str\"");
        return(0);
      }
  }

sub date_to_std
  {
    my($date_str,$end_of) = @_;
    my($this_min,$this_hour,$this_dom,$this_mon,$this_year);
    my($am_flag,@ret);

    return($date_str) if($date_str =~ /^\d\d:\d\d\s+\d+\s+\w\w\w\s+\d\d\d\d$/);
    $date_str =~ s/^\s+//;
    $date_str =~ s/\s+$//;
    if(!$date_str || $date_str =~ /^now$/i || $date_str =~ /^today$/i)
      {
        # ""  "now"  "today"
        $date_str = &time2str(time);
        return($date_str);
      }
    elsif($date_str =~ /^yesterday$/i)
      {
        # "yesterday"
        $date_str = &time2str(time-24*60*60);
        return($date_str);
      }
    # First convert some obvious date strings into
    # the standard form

    $this_min= $this_hour = $this_dom = $this_mon = $this_year = -1;

    @ret = &get_time1($date_str);
    if($ret[0] eq "found")
      {
        my($pre,$post);

        $this_hour = $ret[1];
        $this_min  = $ret[2] if($ret[2]);
        $am_flag   = $ret[3] if($ret[3]);
        $pre = $ret[4]; $post = $ret[5];
        $pre =~ s/\s+$//;
        $post =~ s/^\s+//;
        if($pre && $post)
          {
            $date_str = "$pre $post";
          }
        else
          {
            $date_str = "$pre$post";
          }
      }

    if($date_str)
      {
        # How about looking for a month name
        @ret = &get_date1($date_str);
        if($ret[0] eq "found")
          {
            my($pre,$post);
    
            $this_dom  = $ret[1];
            $this_mon  = $ret[2] if($ret[2]);
            $this_year = $ret[3] if($ret[3]);
            $pre = $ret[4]; $post = $ret[5];
            $pre =~ s/\s+$//;
            $post =~ s/^\s+//;
            if($pre && $post)
              {
                $date_str = "$pre $post";
              }
            else
              {
                $date_str = "$pre$post";
              }
          }
        if($date_str)
          {
            # Still not worked it out
            if($date_str =~ /(\d?\d)(\d\d)/)
              {
                $this_hour= $1; $this_min = $2;
              }
          }
      }

    # Now tidy everything up
    if($this_min < 0)
      {
        $this_min = 0;
        $this_min = 59 if($end_of);
      }
    if($this_hour < 0)
      {
        $this_hour = 0;
        $this_hour = 23 if($end_of);
        $am_flag = 0;
      }
    $this_dom = $now_dom if($this_dom < 0);
    $this_mon = $now_mon if($this_mon < 0);
    $this_year= $now_year if($this_year < 0);

    $this_mon = $months[$this_mon] if($this_mon =~ /^\d+$/);
    if($month2val{$this_mon} < 1 || $month2val{$this_mon} > 12)
      {
        &error("Bad month name $this_mon");
        $this_mon = $now_mon;
      }
    else
      {
        $this_mon = $months[$month2val{$this_mon}];
      }

    if($am_flag)
      {
        $this_hour = 0 if($this_hour > 11);
        $this_hour += 12 if($am_flag =~ /p/i);
      }
    $this_min  = 59 if($this_min > 59);
    $this_hour = 23 if($this_hour > 23);
    $this_dom  = 31 if($this_dom > 31);
    $this_year = 2038 if($this_year > 2038);

    $this_hour = "0".($this_hour+0) if($this_hour < 10);
    $this_min  = "0".($this_min+0) if($this_min < 10);
    $this_year += 2000 if($this_year < 50);
    $this_year += 1900 if($this_year < 200);
    return("$this_hour:$this_min $this_dom $this_mon $this_year");
  }

sub get_date1
  {
    # Returns ("found",$dom,$month,$year,$pre,$post) or 
    #         ("failed")
    my($input) = @_;
    my($mpat,$opat,$spat,$ypat,$npat,$ipat,$dpat);
    my(@m,@l);

    if($input =~ /^(.*)today(.*)$/i || $input =~ /^(.*)now(.*)$/i)
      {
        return("found",$now_dom,$now_mon,$now_year,$1,$2);
      }
    elsif($input =~ /^(.*)yesterday(.*)$/i)
      {
        my($s,$mi,$h,$d,$mo,$y) = localtime(time - 24*60*60);
        return("found",$d,$mo+1,$y,$1,$2);
      }
    $spat = '[\s\/\-\,]*';
    @m = @months; shift(@m);
    @l = @long_months; shift(@l);
    # Named month
    $mpat = "(".join('|',@m,@l).")$spat";
    # Ordinal day number
    $opat = '([0-3]?\d)\s*(st|nd|rd|th)'.$spat;
    # four digit year
    $ypat = '(199|200|201|202|203)(\d)';
    # Day number
    $npat = '([0-3]?\d)'.$spat;
    # Month number
    $dpat = '([0-1]?\d)'.$spat;
    # Year number
    $ipat = '([90123]\d)'.$spat;

    if($input =~ /$mpat/i)
      {
        # There is a named month somewhere in the pattern
        if($input =~ /$opat/i)
          {
            # We have a named month AND an ordinal date
            if($input =~ /^$opat$mpat$ypat(.*)$/i)
              {
                return("found",$1,$3,$4.$5,"",$6);
              }
            elsif($input =~ /^(.*\D)$opat$mpat$ypat(.*)$/i)
              {
                return("found",$2,$4,$5.$6,$1,$7);
              }
            elsif($input =~ /^(.*)$mpat$opat$ypat(.*)$/i)
              {
                return("found",$3,$2,$5.$6,$1,$7);
              }
            elsif($input =~ /^$opat$mpat$ipat$/i)
              {
                return("found",$1,$3,$4,"","");
              }
            elsif($input =~ /^(.*\D)$opat$mpat$ipat$/i)
              {
                return("found",$2,$4,$5,$1,"");
              }
            elsif($input =~ /^(.*)$mpat$opat$ipat$/i)
              {
                return("found",$3,$2,$5,$1,"");
              }
            elsif($input =~ /^$opat$mpat(.*)$/i)
              {
                return("found",$1,$3,"","",$4);
              }
            elsif($input =~ /^(.*\D)$opat$mpat(.*)$/i)
              {
                return("found",$2,$4,"",$1,$5);
              }
            elsif($input =~ /^(.*)$mpat$opat(.*)$/i)
              {
                return("found",$3,$2,"",$1,$5);
              }
          }
        else
          {
            # by rights there should be a numerical date
            if($input =~ /^$npat$mpat$ypat(.*)$/i)
              {
                return("found",$1,$2,$3.$4,"",$5);
              }
            elsif($input =~ /^(.*\D)$npat$mpat$ypat(.*)$/i)
              {
                return("found",$2,$3,$4.$5,$1,$6);
              }
            elsif($input =~ /^(.*)$mpat$npat$ypat(.*)$/i)
              {
                return("found",$3,$2,$4.$5,$1,$6);
              }
            elsif($input =~ /^$npat$mpat$ipat$/i)
              {
                return("found",$1,$2,$3,"","");
              }
            elsif($input =~ /^(.*\D)$npat$mpat$ipat$/i)
              {
                return("found",$2,$3,$4,$1,"");
              }
            elsif($input =~ /^(.*)$mpat$npat$ipat$/i)
              {
                return("found",$3,$2,$4,$1,"");
              }
            elsif($input =~ /^$npat$mpat(.*)$/i)
              {
                return("found",$1,$2,"","",$3);
              }
            elsif($input =~ /^(.*\D)$npat$mpat(.*)$/i)
              {
                return("found",$2,$3,"",$1,$4);
              }
            elsif($input =~ /^(.*)$mpat$npat(.*)$/i)
              {
                return("found",$3,$2,"",$1,$4);
              }
          }
      }
    elsif($input =~ /$opat/i)
      {
        # An ordinal number but no named month
        if($input =~ /^$opat$dpat$ypat(.*)$/i)
          {
            return("found",$1,$3,$4.$5,"",$6);
          }
        elsif($input =~ /^(.*\D)$opat$dpat$ypat(.*)$/i)
          {
            return("found",$2,$4,$5.$6,$1,$7);
          }
        elsif($input =~ /^$dpat[\s\/\-\,]+$opat$ypat(.*)$/i)
          {
            return("found",$2,$1,$4.$5,"",$6);
          }
        elsif($input =~ /^(.*\D)$dpat[\s\/\-\,]+$opat$ypat(.*)$/i)
          {
            return("found",$3,$2,$5.$6,$1,$7);
          }
        elsif($input =~ /^$opat$dpat[\s\/\-\,]+$ipat$/i)
          {
            return("found",$1,$3,$4,"","");
          }
        elsif($input =~ /^(.*\D)$opat$dpat[\s\/\-\,]+$ipat$/i)
          {
            return("found",$2,$4,$5,$1,"");
          }
        elsif($input =~ /^$dpat[\s\/\-\,]+$opat$ipat$/i)
          {
            return("found",$2,$1,$4,"","");
          }
        elsif($input =~ /^(.*\D)$dpat[\s\/\-\,]+$opat$ipat$/i)
          {
            return("found",$3,$2,$5,$1,"");
          }
        elsif($input =~ /^$opat$dpat(.*)$/i)
          {
            return("found",$1,$3,"","",$4);
          }
        elsif($input =~ /^(.*\D)$opat$dpat(.*)$/i)
          {
            return("found",$2,$4,"",$1,$5);
          }
        elsif($input =~ /^$dpat[\s\/\-\,]+$opat(.*)$/i)
          {
            return("found",$2,$1,"","",$4);
          }
        elsif($input =~ /^(.*\D)$dpat[\s\/\-\,]+$opat(.*)$/i)
          {
            return("found",$3,$2,"",$1,$5);
          }
        elsif($input =~ /^$opat(.*)$/i)
          {
            return("found",$1,"","","",$3);
          }
        elsif($input =~ /^(.*\D)$opat(.*)$/i)
          {
            return("found",$2,"","",$1,$4);
          }
      }
    else
      {
        # So we don't have a named month or an ordinal number, we 
        # have to make some assumptions (like forcing separators)
        if($input =~ /^$npat[\s\/\-\,]+$dpat[\s\/\-\,]+$ypat(.*)$/i)
          {
            return("found",$1,$2,$3.$4,"",$5);
          }
        elsif($input =~ /^(.*\D)$npat[\s\/\-\,]+$dpat[\s\/\-\,]+$ypat(.*)$/i)
          {
            return("found",$2,$3,$4.$5,$1,$6);
          }
        elsif($input =~ /^$npat[\s\/\-\,]+$dpat[\s\/\-\,]+$ipat$/i)
          {
            return("found",$1,$2,$3,"","");
          }
        elsif($input =~ /^(.*\D)$npat[\s\/\-\,]+$dpat[\s\/\-\,]+$ipat$/i)
          {
            return("found",$2,$3,$4,$1,"");
          }
        elsif($input =~ /^$npat[\s\/\-\,]+$dpat(.*)$/i)
          {
            return("found",$1,$2,"","",$3);
          }
        elsif($input =~ /^(.*\D)$npat[\s\/\-\,]+$dpat(.*)$/i)
          {
            return("found",$2,$3,"",$1,$4);
          }
        elsif($input =~ /^$npat(.*)$/i)
          {
            return("found",$1,"","","",$2);
          }
        elsif($input =~ /^(.*\D)$npat(.*)$/i)
          {
            return("found",$2,"","",$1,$3);
          }
      }
    return("failed");
  }

sub get_time1
  {
    # Returns ("found",$hour,$min,$am_flag,$pre,$post) or 
    #         ("failed")
    my($input) = @_;
    my($hour,$min,$am_flag,$pre,$post);
    my($m_pat);

    $m_pat = '[\s\-]*([ap]m)[\s\-]*,?';

    if($input =~ /^(\d?\d)\:(\d\d)\:\d\d$m_pat(.*)$/)
      {
        return("found",$1,$2,$3,"",$4);
      }
    elsif($input =~ /^(.*\D)(\d?\d)\:(\d\d)\:\d\d$m_pat(.*)$/)
      {
        return("found",$2,$3,$4,$1,$5);
      }
    if($input =~ /^(\d?\d)\:(\d\d)$m_pat(.*)$/)
      {
        return("found",$1,$2,$3,"",$4);
      }
    elsif($input =~ /^(.*\D)(\d?\d)\:(\d\d)$m_pat(.*)$/)
      {
        return("found",$2,$3,$4,$1,$5);
      }
    elsif($input =~ /^(\d?\d)(\d\d)\d\d$m_pat(.*)$/)
      {
        return("found",$1,$2,$3,"",$4);
      }
    elsif($input =~ /^(.*\D)(\d?\d)(\d\d)\d\d$m_pat(.*)$/)
      {
        return("found",$2,$3,$4,$1,$5);
      }
    elsif($input =~ /^(\d?\d)(\d\d)$m_pat(.*)$/)
      {
        return("found",$1,$2,$3,"",$4);
      }
    elsif($input =~ /^(.*\D)(\d?\d)(\d\d)$m_pat(.*)$/)
      {
        return("found",$2,$3,$4,$1,$5);
      }
    elsif($input =~ /^(\d?\d)$m_pat(.*)$/)
      {
        return("found",$1,"",$2,"",$3);
      }
    elsif($input =~ /^(.*\D)(\d?\d)$m_pat(.*)$/)
      {
        return("found",$2,"",$3,$1,$4);
      }
    elsif($input =~ /^(\d?\d)\:(\d\d)\:\d\d(.*)$/)
      {
        return("found",$1,$2,"","",$3);
      }
    elsif($input =~ /^(.*\D)(\d?\d)\:(\d\d)\:\d\d(.*)$/)
      {
        return("found",$2,$3,"",$1,$4);
      }
    elsif($input =~ /^(\d?\d)\:(\d\d)(.*)$/)
      {
        return("found",$1,$2,"","",$3);
      }
    elsif($input =~ /^(.*\D)(\d?\d)\:(\d\d)(.*)$/)
      {
        return("found",$2,$3,"",$1,$4);
      }
    elsif($input =~ /^(\d?\d)(\d\d)\d\d(.*)$/)
      {
        return("found",$1,$2,"","",$3);
      }
    elsif($input =~ /^(.*\D)(\d?\d)(\d\d)\d\d(.*)$/)
      {
        return("found",$2,$3,"",$1,$4);
      }
    elsif($input =~ /^(\d?\d)(\d\d)(.*)$/)
      {
        return("found",$1,$2,"","",$3);
      }
    elsif($input =~ /^(.*\D)(\d?\d)(\d\d)$m_pat(.+)$/)
      {
        return("found",$2,$3,$4,$1,$5);
      }
    return("failed");
  }