#!/opt/perl5/bin/perl

use Tk ;
use ExtUtils::testlib;
use Puppet::VcsTools::File;
use Puppet::VcsTools::LogEdit;
use VcsTools::LogParser ;
use VcsTools::DataSpec::Rcs qw($description readHook);
use Getopt::Long ;
require Tk::ErrorDialog; 
use Fcntl ;
use MLDBM qw(DB_File);

use strict ;

my @allNames=() ;

GetOptions ('name=s@' => \@allNames)
  || die "GetOptions failed\n";


@allNames = @ARGV unless scalar @allNames>0 ;

my $dbDir = '.rcsWork/' ;
unless (-d $dbDir)
  {
    print "May I create the $dbDir directory ? (y/n)\n";
    my $rep = <STDIN> ;
    if ($rep =~ /^y/i)
      {
        mkdir ($dbDir,0755) or die "Create $dbDir failed\n";
      }
    else
      {
        $dbDir = $ENV{'PWD'};
      }
  }

my $version = '1.1';
my $keyV = '%version%'; 

my $ds = new VcsTools::LogParser
  (
   description => $description,
   readHook => \&readHook
  ) ;

my $mw = MainWindow-> new ;

my $he = $mw->LogEditor( 'format' => $ds) ;

my $create = sub 
  {
    my $name = shift ;

    my %dbhash;
    tie %dbhash,  'MLDBM', $dbDir.$name , O_CREAT|O_RDWR, 0640 or die $! ;
    
    if (not defined $dbhash{$keyV} or $dbhash{$keyV} ne $version)
      {
        print "Performing cleanup of old local database\n";
        my @keys = keys %dbhash ;
        map (delete $dbhash{$_}, @keys) ; # mega cleanup
        $dbhash{$keyV}=$version ;
      }

    return new Puppet::VcsTools::File 
      (
       storageArgs =>
       {
        dbHash => \%dbhash,
        keyRoot => ''
       },
       vcsClass => 'VcsTools::RcsAgent',
       name => $name ,
       workDir => $ENV{'PWD'},
       dataScanner => $ds ,
       logEditor => $he,
       'topTk' => $mw
      );
  };

if (scalar @allNames > 1)
  {
    # several files to work on
    require Tk::TFrame ;
    my $f = $mw -> TFrame
      (
       -label => [text => 'rcsWork main window'],
       -borderwidth => 2,
       -relief => 'groove'
      ); 
    $f -> pack( -expand => 1,-fill => 'both');

    my $l = $f->Scrolled(qw/Listbox -scrollbars osoe/);
    $l-> pack( -expand => 1, -fill => 'both');

    map($l->insert('end',$_),@allNames) ;

    $f->Button(text => 'quit', command => sub {$mw->destroy;}) ->
      pack(qw/fill x/);

    $l->bind
      (
       '<Double-1>' => sub 
       {
         my $item = shift ;
         my $name = $item->get ('active') ;
         $create->($name)-> display();
       }
      ) ;

  }
else
  {
    $mw->withdraw ;
  }

if (scalar @allNames == 1)
  {
    $create->($allNames[0])-> display( master =>1);
  }

MainLoop ; # Tk's

__END__

=head1 NAME

rcsWork - RCS file manager

=head1 SYNOPSIS

 # fully qualified
 rcsWork -base SLEE [-rcsDir code/toto] -host hptnofs -name titi.c -name foo.h
  
 # or
 rcsWork -base SLEE [-rcsDir code/toto] -host hptnofs titi.c foo.h bar.c

 # if you trust your .fmrc file
 rcsWork titi.c foo.h bar.c

=head1 DESCRIPTION

Launch a Tk application to manage your RCS file

=head1 AUTHOR

Dominique Dumont    Dominique_Dumont@grenoble.hp.com

Copyright (c) 1998-1999 Dominique Dumont. All rights reserved.  This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

perl(1), L<Puppet::VcsTools::File>,  L<Puppet::VcsTools::History>

=cut
