#!/bin/env perl5
# 
# TsorT Global search and replace
# 
    use strict 'vars';
    use Tk;
    use Tk::FileSelect;
    require Cwd;

    my($ext,$bak,$find,$replace);
    my($main_win,$t_frame,$b_frame,$done_but,$cancel_but,$report_lab);
    my($src_dir,$src_fs,$recurse_dir);
    
    $ext = "html";
    $bak = "bak2";
    $find = "../images/";
    $replace = "./";
    $src_dir = Cwd::getcwd();
    
    $main_win = new MainWindow(
        -title   => "TsorT Search Replace",
      );

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

    $src_fs = $main_win->FileSelect(
            -directory => $src_dir,
          );

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

    $t_frame->Label(
        -text => "Source Directory"
      )->pack(
            -side => 'left',
            -fill => 'y',
          );

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

    # The source name pattern
    $t_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'top'
          );

    $t_frame->Entry(
        -textvariable => \$bak,
        -width => 5,
      )->pack(
            -side => 'right',
            -fill => 'y',
          );

    $t_frame->Label(
        -text => "Backup Ext",
      )->pack(
            -side => 'right',
            -fill => 'y',
          );

    $t_frame->Entry(
        -textvariable => \$ext,
        -width => 5,
      )->pack(
            -side => 'right',
            -fill => 'y',
          );

    $t_frame->Label(
        -text => "Ext",
      )->pack(
            -side => 'right',
            -fill => 'y',
          );

    $t_frame->Checkbutton(
            -text => "Recurse Subdirs",
            -variable => \$recurse_dir,
          )->pack(
                -side => 'left'
              );
    
    # The source name pattern
    $t_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'top'
          );

    $t_frame->Label(
        -text => "Find Text"
      )->pack(
            -side => 'left',
            -fill => 'y',
          );

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

    # The source name pattern
    $t_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'top'
          );

    $t_frame->Label(
        -text => "Replace With"
      )->pack(
            -side => 'left',
            -fill => 'y',
          );

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

    # The bottom frame kicks off the program and shows the state
    $b_frame = $main_win->Frame(
      )->pack(
            -fill => 'x',
            -side => 'bottom'
          );

    $done_but = $b_frame->Button(
        -text    => "Start",
        -command => \&do_cmd,
      )->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    => "User Input",
      )->pack(
            -fill => 'both',
          );

    # OK all the widgets are in place, lets go
    MainLoop;
    
    # Returns once it is done
    exit(0);

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

    $report_lab->configure(-text => $val);
  }

sub select_src_dir
  {
    my($new_dir);

    $src_fs->configure(
        -directory => $src_dir,
      );

    $new_dir = $src_fs->Show;
    if($new_dir)
      {
        # Remove the disk specifier
 #       $new_dir =~ s/^\S://;
        $new_dir =~ s#.+(\S\:[^\:]+)$#\1#;
        if($new_dir =~ s#/+[^/]+$##)
          {
          }
        else
          {
            &report("Cannot parse dir from $new_dir\n");
            return;
          }
        &report("Set source dir $new_dir\n");
        $src_dir = $new_dir;
      }
    else
      {
        &report("Canceled setting source\n");
      }
  }

sub do_cmd
  {
    my($isrc_dir) = @_;

    $bak = "backup" if(!$bak);

    &do_dir($src_dir);
    &report("Rename completed");
  }
    
sub do_dir
  {
    # Do what we will on a directory
    my($dirname,$fname,@files,@subdirs) =@_;
    local(*DIR);
    opendir(DIR,$dirname);
    @files = readdir(DIR);
    closedir(DIR);
    foreach $fname (@files)
      {
        next if($fname =~ /^\.+$/);
        if(-d "$dirname/$fname")
          {
            push(@subdirs,"$dirname/$fname");
          }
        elsif(!$ext || $fname =~ /\.$ext$/i)
          {
            local(*INFILE,*OUTFILE);
            my($newfile,$oldfile,$line);
            
            $oldfile = "$dirname/$fname";
            $newfile = "$dirname/$fname.$bak";
            rename $oldfile, $newfile;
            open(INFILE,$newfile);
            binmode(INFILE);
            open(OUTFILE,">$oldfile");
            binmode(OUTFILE);
            while($line = <INFILE>)
              {
                $line =~ s/$find/$replace/g;
                print OUTFILE $line;
              }
            close(OUTFILE);
            close(INFILE);
          }
      }

    return if(!$recurse_dir);
    foreach $fname (@subdirs)
      {
        &do_dir($fname);
      }
  }