Puppet::VcsTools::Version - Tk GUI to manage a VcsTools::Version object

package Puppet::VcsTools::Version ;

use strict;
use Carp;
use vars qw(@ISA $VERSION);
use Puppet::Show ;
use VcsTools::Version ;

$VERSION = sprintf "%d.%03d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;

@ISA=qw/VcsTools::Version/;

# must pass the info data structure when creating it
sub new
  {
    my $type = shift;
    my %args = @_;

    my $self = {};
    $self->{name}=$args{name};

    $self->{body} = new Puppet::Show(cloth => $self, @_);
    
    if (defined $args{storageArgs})
      {
        # transition code, should be removed sooner or later
        my %storeArgs = %{$args{storageArgs}} ;
        carp "new $type $args{name}: storageArgs is deprecated";
        carp "new $type $args{name}: usage is deprecated" 
          if defined $args{usage};
 
        my $usage = $self->{usage} = $args{usage} || 'File';
        
        if ($usage eq 'MySql')
          {
            $storeArgs{version} = $args{revision};
            require VcsTools::VerSqlStorage;
            $args{storage} = new VcsTools::VerSqlStorage (%storeArgs) ;
          }
        else
          {
            $args{storage} =  new Puppet::Storage (name => $self->{name},
                                                     %storeArgs) ;
          }
         $self->{storageArgs}=$args{storageArgs};
     }

    if (defined $args{manager})
      {
        carp "new $type $args{name}: manager is deprecated";
        my $mgr = $args{manager} ;
        $args{getBrotherSub} = sub {$mgr->getVersionObj(@_)} ;
        $self->{manager}=$args{manager};
      }

    # mandatory parameter
    foreach (qw/revision getBrotherSub storage/)
      {
        die "No $_ passed to $type $self->{name}\n" unless 
          defined $args{$_};
        $self->{$_} = delete $args{$_} ;
      }
    
    $self->{editor} = $args{editor};
    
    bless $self,$type ;
  }

sub getVersionObj
  {
    my $self = shift ;
    my $rev = shift ;
    carp "Version::getVersionObj is deprecated";
    return $self->{getBrotherSub}->($rev);
  }


sub display
  {
    my $self = shift ;
    $self->{body}-> display(@_);
 }

sub closeDisplay
  {
    shift->{body}->closeDisplay();
  }

sub drawTree
  {
    my $self = shift ;
    my $tree = shift ;
    my $x = 100 ;
    my $y = 100 ;
    my $widthR = 0 ;
    
    $tree->clear();
    $self->drawSubTree($tree,$x,$y,\$widthR) ;
    $tree->addAllShortcuts() ;
    # We give up the equalTo stuff. Too many potential problems with it.
  }

# called recursively to draw all nodes, internal method
sub drawSubTree
  {
    my $self = shift ;
    my $tree = shift ;
    my $x = shift ;
    my $y = shift ;
    my $widthR = shift ;

    my $rev = $self->{revision} ;
    my $info =  $self->{storage}->
      getDbInfo(qw/date keywords fix mergedFrom lower branches/) ;

    my $date = $info->{date} || '';
    $date =~ s/ .*$//;

    # print "drawing $rev : x $x y $y widthR $$widthR\n";

    my @array = ($date) ;
    push @array, @{$info->{keywords}} if defined $info->{keywords};
    push @array, @{$info->{fix}}      if defined $info->{fix} ;

    $tree->addNode
      (
       nodeId => $rev,
       text => \@array,
       xref => \$x,
       yref => \$y
      ) ;

    # check if this node is a merge
    # we must store the info now, and draw them later on.
    if (defined $info->{mergedFrom})
      {
        $tree->addShortcutInfo(from => $info->{mergedFrom}, to => $rev) ;
      }

    if (defined $info->{lower})
      {
        my ($lx,$ly)=($x,$y);
        $tree->addDirectArrow
          (
           from => $rev,
           to => $info->{lower},
           xref => \$lx,
           yref => \$ly
          );

        $self->{getBrotherSub}->($info->{lower}) 
          ->drawSubTree($tree, $lx, $ly, $widthR );
      }
    
    if (defined $info->{branches})
      {
        foreach my $branch ( @{$info->{branches}} )
          {
            my ($lx,$ly)=($x,$y);
            my $subWidth = 0;
            $tree->addSlantedArrow
              (
               from => $rev,
               to => $branch,
               xref => \$lx,
               yref => \$ly,
               deltaXref => $widthR
              );

            $self->{getBrotherSub}->($branch)
              ->drawSubTree($tree, $lx ,$ly, \$subWidth );
            $$widthR += $subWidth ;
          }
      }
  }

1;

__END__

#'