branch_diagram.pm #1

package VCP::Dest::branch_diagram ;

=head1 NAME

VCP::Dest::branch_diagram - An experimental diagram drawing "destination"

=head1 SYNOPSIS

=head1 DESCRIPTION

This generates (using GraphViz) a diagram of the branch structure of the
source repository.

=head1 METHODS

=over

=cut

$VERSION = 1 ;

use strict ;

use Carp ;
use File::Basename ;
use File::Path ;
use Getopt::Long ;
use VCP::Debug ':debug' ;
use VCP::Dest ;
use VCP::Branches ;
use VCP::Branch ;
use VCP::Rev ;
use GraphViz;

use base qw( VCP::Dest ) ;
use fields (
    'BD_GRAPH',          ## The graph being built
    'BD_BRANCH_COLORS',  ## We color code branches
) ;

=item new

Creates a new instance of a VCP::Dest::branch_diagram.

=cut

sub new {
   my $class = shift ;
   $class = ref $class || $class ;

   my VCP::Dest::branch_diagram $self = $class->SUPER::new( @_ ) ;

   ## Parse the options
   my ( $spec, $options ) = @_ ;

   $self->parse_repo_spec( $spec ) ;

   GetOptions( "ArGhOpTioN" => \"" ) or $self->usage_and_exit ; # No options!

   return $self ;
}


sub backfill {
   my VCP::Dest::branch_diagram $self = shift ;
   my VCP::Rev $r ;
   ( $r ) = @_ ;

confess unless defined $self && defined $self->header ;

   return 1 ;
}


sub handle_header {
   my VCP::Dest::branch_diagram $self = shift ;
   $self->SUPER::handle_header( @_ ) ;

   $self->{BD_GRAPH}        = GraphViz->new(
      rankdir => "LR",
      nodesep  => 0.1,
      ranksep  => 0.1,
      ordering => "out",
   );

   my @colors = qw( brown red green blue );

   for ( $self->header->{branches}->get ) {
       my $c = shift @colors;
       @colors = ( @colors, $c );
       $self->{BD_BRANCH_COLORS}->{$_->branch_id} = $c;
   }

}


sub handle_rev {
   my VCP::Dest::branch_diagram $self = shift ;

   my VCP::Rev $r ;
   ( $r ) = @_ ;
debug "vcp: handle_rev got $r ", $r->name if debugging $self ;

   my $g = $self->{BD_GRAPH};

   my $label = join( "",
      $r->name,
      "#",
      $r->rev_id,
      defined $r->branch_id 
         ? join $r->branch_id, " (", ")"
         : (),
   );

   my @color;
   @color = ( color => $self->{BD_BRANCH_COLORS}->{$r->branch_id} )
      if defined $r->branch_id;

   $g->add_node(
      join( "#", $r->name, $r->rev_id ),
      label    => $label,
      fontsize => 10,
      fontname => "Helvetica",
      shape    => "box",
      height   => 0,
      width    => 0,
      @color,
   );

   my $saw = $self->seen( $r );

   my $base_rev_id =
      defined $r->base_rev_id ? $r->base_rev_id
      : defined $saw          ? $saw->rev_id
                              : undef;
   
   my @style;
   @style = ( style => "dashed" )
       unless defined $r->base_rev_id;

   if ( defined $base_rev_id ) {
      $g->add_edge( {
         from => join( "#", $r->name, $base_rev_id ),
         to   => join( "#", $r->name, $r->rev_id      ),
         @color,
         @style,
      } );
   }
}


sub handle_footer {
   my VCP::Dest::branch_diagram $self = shift ;

   my $fn = $self->repo_filespec;

   my ( $ext ) = ( $fn =~ /\.([^.]*)\z/ );
   my $method = "as_$ext";
   $self->{BD_GRAPH}->$method( $fn );
}


=back

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=head1 COPYRIGHT

Copyright (c) 2000, 2001, 2002 Perforce Software, Inc.
All rights reserved.

See L<VCP::License|VCP::License> (C<vcp help license>) for the terms of use.

=cut

1