package VCP::Dest::branch_diagram ; =head1 NAME VCP::Dest::branch_diagram - An experimental diagram drawing "destination" =head1 SYNOPSIS vcp <source> branch_diagram:foo.png vcp <source> branch_diagram:foo.png --skip=none ## for verbose output =head1 DESCRIPTION This generates (using GraphViz) a diagram of the branch structure of the source repository. Note: You must install graphviz, from AT&T (specifically, the C<dot> command) and the GraphViz.pm Perl module for this to work. =head1 OPTIONS =over =item --skip=# Set the "skip" threshold. use C<--skip=none> to prevent skipping. The default is 5, meaning that the minimum number of revisions that will be skipped is 5. This sets the minimum number you should see in a "# skipped" message in the result graph. =back =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_REVS', ## a HASH of rev nodes keyed on name,rev_id. These ## are all accumulated and then the graph is built ## in handle_footer. 'SKIP_THRESHOLD', ## Where to start skipping. ) ; =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( @_ ) ; $self->{SKIP_THRESHOLD} = 5; ## Parse the options my ( $spec, $options ) = @_ ; $self->parse_repo_spec( $spec ) ; GetOptions( "skip=s" => \$self->{SKIP_THRESHOLD} ) 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( @_ ) ; } 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 $saw = $self->last_seen( $r ); my $base = defined $r->base_rev_id ? $r->base_rev_id : defined $saw ? $saw->rev_id : undef; $base = $r->name . "#" . $base if defined $base; my $key = $r->name . "#" . $r->rev_id; $self->{BD_REVS}->{$key}->{REV} = $r; $self->{BD_REVS}->{$key}->{BASE} = $base; $self->{BD_REVS}->{$key}->{KEY} = $key; ++$self->{BD_REVS}->{$base}->{COUNT} if defined $base; } sub _add_rev_node { my VCP::Dest::branch_diagram $self = shift ; my ( $g, $rev_record ) = @_; my $r = $rev_record->{REV}; my $label = join( "", $rev_record->{KEY}, defined $r->change_id ? ( " @", $r->change_id ) : (), ); my @color; @color = ( color => $rev_record->{COLOR}, ) if defined $rev_record->{COLOR}; my @edge_fontcolor = map $_ eq "color" ? "fontcolor" : $_, @color; $g->add_node( $rev_record->{KEY}, label => $label, fontsize => 10, fontname => "Helvetica", shape => "box", height => 0, width => 0, group => $r->name . "(" . ( $r->branch_id || "(main)" ) . ")", @color, ); my $prev_node = $rev_record->{BASE}; my $is_new_branch = ( $r->branch_id || "" ) ne ( defined $prev_node && exists $self->{BD_REVS}->{$prev_node} ? $self->{BD_REVS}->{$prev_node}->{REV}->branch_id || "" : "" ); my $branch_label = ""; $branch_label = $r->branch_id if $is_new_branch; if ( defined $prev_node ) { my @style; @style = ( style => "dotted" ) unless defined $r->base_rev_id; if ( $rev_record->{SKIPPED} ) { my $k = $prev_node . "..." . $rev_record->{KEY}; $g->add_node( $k, label => $rev_record->{SKIPPED} . " skipped", fontsize => 10, fontname => "Helvetica", shape => "box", height => 0, width => 0, peripheries => 0, group => $r->name . "(" . ( $r->branch_id || "(main)" ) . ")", @edge_fontcolor, ); $g->add_edge( { label => $branch_label, from => $prev_node, to => $k, fontsize => 10, fontname => "Helvetica", @color, @edge_fontcolor, @style, arrowhead => "none", length $branch_label ? ( weight => 0 ) : (), } ); $prev_node = $k, $branch_label = ""; } $g->add_edge( { label => $branch_label, fontsize => 10, fontname => "Helvetica", from => $prev_node, to => $rev_record->{KEY}, @edge_fontcolor, @color, @style, length $branch_label ? ( weight => 0 ) : (), } ); } } sub handle_footer { my VCP::Dest::branch_diagram $self = shift ; my $fn = $self->repo_filespec; my ( $ext ) = ( $fn =~ /\.([^.]*)\z/ ); my $method = "as_$ext"; my $g = GraphViz->new( # rankdir => "LR", ## Wide .pngs can't be created, go tall. nodesep => 0.1, ranksep => 0.25, ordering => "out", ); my %seen_colors; my $total; my $count; my @colors = map $_->[-1], sort { ## 1 word names include the primary colors length $a->[-1] <=> length $b->[-1] || abs( $a->[0] - $total/$count ) <=> abs( $b->[0] - $total/$count ) } grep { my $avg = $_->[0]; $total += $avg; ++$count; ( $_->[-1] =~ /gray/ ? $avg > 125 : $avg > 50 ) && $avg < 150 } map [ ( $_->[0] + $_->[1] + $_->[2] ) / 3, @$_], grep $_->[-1] =~ /\A[a-z\s]+\z/, grep !$seen_colors{$_->[-1]}++, map { $_->[-1] =~ s/grey/gray/g; $_ } map [ split /\s+/, $_, 4 ], split /\n+\s*/, `showrgb`; #use Slay::PerlUtil; dump \@colors; #die; my %branch_colors; for ( $self->header->{branches}->get ) { my $c = shift @colors; @colors = ( @colors, $c ); $branch_colors{$_->branch_id} = $c; } #use Slay::PerlUtil; dump \%branch_colors; my %important_revs; my $revs = $self->{BD_REVS}; $_->{VIS} = 1 for grep ! $_->{COUNT} || $_->{COUNT} > 1 || !defined $_->{BASE}, values %$revs; for ( values %$revs ) { next unless $_->{VIS}; if ( defined $_->{BASE} ) { my $b = $_->{BASE}; my @skipped; while ( ! $revs->{$b}->{VIS} && defined $revs->{$b}->{BASE} ) { push @skipped, $b; $b = $revs->{$b}->{BASE}; } ## Only skip enough to matter if ( $self->{SKIP_THRESHOLD} ne "none" && @skipped >= $self->{SKIP_THRESHOLD} ) { $_->{BASE} = $b; $_->{SKIPPED} = @skipped; } else { $revs->{$_}->{VIS} = 1 for @skipped; } } } ## Sort by name to get predictable ordering of files from left to right ## Sort by branch ID to put all branches to right. for ( sort { $a->{REV}->name cmp $b->{REV}->name || ( $a->{REV}->branch_id || "" ) cmp ( $b->{REV}->branch_id || "" ) } values %$revs ) { next unless $_->{VIS}; my $r = $_->{REV}; if ( defined $r->branch_id ) { $_->{COLOR} = $branch_colors{$r->branch_id}; unless ( defined $_->{BASE} ) { ## UNROOTED BRANCH! $_->{BASE} = $_->{KEY} . "???"; $g->add_node( $_->{BASE}, label => "???", fontcolor => "red", fontsize => 14, fontname => "Helvetica", peripheries => 0, group => $r->name . "(" . $r->branch_id . ")", ); } } $self->_add_rev_node( $g, $_ ); } $g->$method( $fn ); } sub metadata_only { 1 } =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
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#26 | 4021 | Barrie Slaymaker |
- Remove all phashes and all base & fields pragmas - Work around SWASHGET error |
||
#25 | 4012 | Barrie Slaymaker | - Remove dependance on pseudohashes (deprecated Perl feature) | ||
#24 | 3858 | Barrie Slaymaker | - Final tweaks for 0.5 release | ||
#23 | 3813 | Barrie Slaymaker | - VCP::Rev::previous() is no more | ||
#22 | 3532 | John Fetkovich |
changed File::Spec->rel2abs( blah, start_dir ) to start_dir_rel2abs blah everywhere. which does the same thing and is defined in VCP::Utils |
||
#21 | 3489 | Barrie Slaymaker | - Document options emitted to .vcp files. | ||
#20 | 3460 | Barrie Slaymaker |
- Revamp Plugin/Source/Dest hierarchy to allow for reguritating options in to .vcp files |
||
#19 | 3400 | Barrie Slaymaker |
- Make dest file be relative to vcp's starting dir - Print and log the dest file location for the user to see |
||
#18 | 3208 | John Fetkovich | documentation (pod) fixes. | ||
#17 | 3133 | Barrie Slaymaker |
Make destinations call back to sources to check out files to simplify the architecture (is_metadata_only() no longer needed) and make it more optimizable (checkouts can be batched). |
||
#16 | 3019 | Barrie Slaymaker | Display the action/placeholder/base rev status | ||
#15 | 2929 | John Fetkovich | added empty() call | ||
#14 | 2838 | John Fetkovich | Use parse_options rather than using Getopt::Long directly. | ||
#13 | 2802 | John Fetkovich |
Added a source_repo_id to each revision, and repo_id to each Source and Dest. The repo_ids include repository type (cvs,p4,revml,vss,...) and the repo_server fields. Changed the $self->...->set() and $self->...->get() lines in VCP::Dest::* to pass in a conglomerated key value, by passing in the key as an ARRAY ref. Also various restructuring in VCP::DB.pm, VCP::DB_file.pm and VCP::DB_file::sdbm.pm related to this change. |
||
#12 | 2753 | John Fetkovich | POD fixes | ||
#11 | 2329 | Barrie Slaymaker |
Silly GraphViz seems to bungle colors. Should sniff the version. |
||
#10 | 2322 | Barrie Slaymaker | Fix jack-in-the-bug options parsing exposed by .vcp files | ||
#9 | 2200 | Barrie Slaymaker | Add some examples to branch_diagram.pm | ||
#8 | 2148 | Barrie Slaymaker |
Elide the middle of the list of labels so revs with many labels aren't huge |
||
#7 | 2042 | Barrie Slaymaker | Basic source::p4 branching support | ||
#6 | 2026 | Barrie Slaymaker | VCP::8::cvs now supoprt branching | ||
#5 | 2017 | Barrie Slaymaker |
Interim checkin of id=/base_version_id for revml: and branch_diagram: |
||
#4 | 2015 | Barrie Slaymaker | submit changes | ||
#3 | 2011 | Barrie Slaymaker | Tweak images to be smaller, more readable (IMHO) | ||
#2 | 2009 | Barrie Slaymaker |
lots of fixes, improve core support for branches and VCP::Source::cvs now supports branches. |
||
#1 | 2006 | Barrie Slaymaker |
more preparations for branching support, handling of cvs :foo:... CVSROOT specs, misc fixes, improvements |