[Rt-commit] r11055 - in rt/branches/3.8-TESTING: html/Elements html/Search html/Search/Elements html/Ticket/Graphs lib/RT/Graph
ruz at bestpractical.com
ruz at bestpractical.com
Wed Mar 12 19:18:04 EDT 2008
Author: ruz
Date: Wed Mar 12 19:18:04 2008
New Revision: 11055
Added:
rt/branches/3.8-TESTING/html/Search/Elements/Graph
rt/branches/3.8-TESTING/html/Search/Graph.html
rt/branches/3.8-TESTING/html/Ticket/Graphs/
rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/
rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/EditGraphProperties
rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/ShowGraph
rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/ShowLegends
rt/branches/3.8-TESTING/html/Ticket/Graphs/dhandler
rt/branches/3.8-TESTING/html/Ticket/Graphs/index.html
rt/branches/3.8-TESTING/lib/RT/Graph/
rt/branches/3.8-TESTING/lib/RT/Graph/Tickets.pm
Modified:
rt/branches/3.8-TESTING/html/Elements/ShowLinks
Log:
* integrate Graphs
Modified: rt/branches/3.8-TESTING/html/Elements/ShowLinks
==============================================================================
--- rt/branches/3.8-TESTING/html/Elements/ShowLinks (original)
+++ rt/branches/3.8-TESTING/html/Elements/ShowLinks Wed Mar 12 19:18:04 2008
@@ -102,7 +102,17 @@
</td>
</tr>
-% # Allow people to add more rows to the table
+<tr><td colspan="2"><hr /></td></tr>
+<tr><td colspan="2">
+<a href="<% $RT::WebPath %>/Ticket/Graphs/index.html?id=<% $Ticket->id %>&Type=Members">
+<% loc('Ticket Relationship Graph') %>
+</a></td></tr>
+<tr><td colspan="2">
+<a href="<% $RT::WebPath %>/Ticket/Graphs/index.html?id=<% $Ticket->id %>&Type=Links">
+<% loc('Ticket Full Relationship Graph') %>
+</a></td></tr>
+
+% # Allow people to add more rows to the table
% $m->callback( %ARGS );
</table>
Added: rt/branches/3.8-TESTING/html/Search/Elements/Graph
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Search/Elements/Graph Wed Mar 12 19:18:04 2008
@@ -0,0 +1,3 @@
+<%INIT>
+return $m->comp('/Ticket/Graphs/Elements/ShowGraph', %ARGS);
+</%INIT>
Added: rt/branches/3.8-TESTING/html/Search/Graph.html
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Search/Graph.html Wed Mar 12 19:18:04 2008
@@ -0,0 +1,3 @@
+<%INIT>
+return $m->comp('/Ticket/Graphs/index.html', %ARGS );
+</%INIT>
Added: rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/EditGraphProperties
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/EditGraphProperties Wed Mar 12 19:18:04 2008
@@ -0,0 +1,94 @@
+<&| /Widgets/TitleBox, title => loc('Graph Properties') &>
+Depth <select name="Depth">
+<option value="0"><% loc('Unlimit') %></option>
+% foreach ( 1..6 ) {
+<option value="<% $_ %>" <% ($Depth||0) == $_? 'selected': '' %>><% $_ %></option>
+% }
+</select><br />
+
+% my @properties = RT::Graph::Tickets->TicketProperties( $session{'CurrentUser'} );
+
+Fill boxes with color using:
+<select name="FillUsing">
+<option value=""><% 'nothing' %></option>
+<%PERL>
+my @tmp = @properties;
+while ( my ($group, $list) = (splice @tmp, 0, 2) ) {
+ # coloring by links and dates sounds stupid
+ next if $group eq 'Dates' || $group eq 'Links';
+
+ foreach my $prop ( @$list ) {
+ my $selected = '';
+ $selected = 'selected="selected"' if $prop eq ($FillUsing||'');
+</%PERL>
+<option value="<% $prop %>" <% $selected |n %>><% $prop %></option>
+% } }
+</select><br />
+
+% if ( RT::Link->can('Description' ) ) {
+% my $checked = '';
+% $checked = 'checked="checked"' if $ShowLinkDescriptions;
+Show link descriptions:
+<input type="checkbox" name="ShowLinkDescriptions" value="1" <% $checked |n %> />
+<br />
+% }
+
+<%PERL>
+if ( $AllowAdditionalProperties ) {
+ for my $i ( 1..($Depth||6) ) {
+ my @default;
+ if ( my $tmp = $ARGS{ 'Level-'. $i .'-Properties' } ) {
+ @default = ref $tmp? @$tmp : ($tmp);
+ }
+
+ $m->comp('SELF:Properties',
+ Level => $i,
+ Available => \@properties,
+ Default => \@default,
+ );
+ }
+}
+</%PERL>
+
+<& /Elements/Submit, Label => loc('Update Graph'), Name => 'Update' &>
+
+</&>
+
+<%ARGS>
+$id => undef
+$Depth => 3
+$FillUsing => ''
+$ShowLinkDescriptions => 0
+$AllowAdditionalProperties => 1
+</%ARGS>
+<%INIT>
+require RT::Graph::Tickets;
+require RT::Link;
+</%INIT>
+
+<%METHOD Properties>
+<%ARGS>
+ at Available => ()
+ at Default => ()
+$Level => 1,
+</%ARGS>
+<%INIT>
+my $id = "graph-properties-box-$Level";
+my $class = '';
+$class = 'class="hidden"' if $Level != 1 && !@Default;
+</%INIT>
+Show Tickets Properties on <% $Level %> level
+(<small><a href="#" onclick="hideshow('<% $id %>'); return false;">open/close</a></small>):
+<table id="<% $id %>" <% $class |n %>>
+% while ( my ($group, $list) = (splice @Available, 0, 2) ) {
+<tr><td><% $group %>:</td><td>
+% foreach my $prop ( @$list ) {
+% my $checked = '';
+% $checked = 'checked="checked"' if grep $_ eq $prop, @Default;
+<input type="checkbox" class="checkbox" name="Level-<% $Level %>-Properties" value="<% $prop %>" <% $checked |n %> /><% $prop %>
+% }
+</td></tr>
+% }
+</table>
+<br />
+</%METHOD>
Added: rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/ShowGraph
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/ShowGraph Wed Mar 12 19:18:04 2008
@@ -0,0 +1,30 @@
+<div><img src="<% $RT::WebPath %>/Ticket/Graphs/<% $Type %>/<% $id %>?<% $m->comp('/Elements/QueryString', %ARGS) %>" usemap="<% $graph->{'NAME'} || 'test' %>" style="border: none" />
+<% Encode::decode_utf8( $graph->as_cmapx ) |n %>
+</div>
+<& ShowLegends, %ARGS, Ticket => $ticket &>
+<%ARGS>
+$id => undef;
+$Type => 'Links',
+</%ARGS>
+<%INIT>
+my $ticket = RT::Ticket->new( $session{'CurrentUser'} );
+$ticket->Load( $id );
+unless ( $ticket->id ) {
+ $RT::Logger->error("Couldn't load ticket $id");
+ return;
+}
+$ARGS{'id'} = $id = $ticket->id;
+
+$Type = ucfirst lc $Type;
+unless ( $Type eq 'Links' || $Type eq 'Members' ) {
+ $RT::Logger->error("'$Type' is incorrect type of ticket graph");
+ $Type = 'Links';
+}
+
+require RT::Graph::Tickets;
+my $method = 'Ticket'. $Type;
+my $graph = RT::Graph::Tickets->$method(
+ %ARGS,
+ Ticket => $ticket,
+);
+</%INIT>
Added: rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/ShowLegends
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Ticket/Graphs/Elements/ShowLegends Wed Mar 12 19:18:04 2008
@@ -0,0 +1,25 @@
+<&| /Widgets/TitleBox, title => loc('Legends') &>
+<table>
+
+<tr style="height: 2.8em;"><td>Status:</td><td>
+% foreach my $status ( sort keys %RT::Graph::Tickets::ticket_status_style ) {
+% my $style = $RT::Graph::Tickets::ticket_status_style{ $status };
+<span style="color: <% $style->{'fontcolor'} %>; padding: 0.6em; border: 1px solid black;"><% $status %></span>
+% }
+</td></tr>
+
+% if ( $FillUsing ) {
+<tr style="height: 2.8em;"><td><% $FillUsing %>:</td><td>
+% foreach my $value ( sort keys %RT::Graph::Tickets::fill_cache ) {
+% my $color = $RT::Graph::Tickets::fill_cache{ $value };
+<span style="background-color: <% $color %>; padding: 0.6em; border: 1px solid black;"><% $value %></span>
+% }
+</td></tr>
+% }
+
+</table>
+</&>
+
+<%ARGS>
+$FillUsing => ''
+</%ARGS>
Added: rt/branches/3.8-TESTING/html/Ticket/Graphs/dhandler
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Ticket/Graphs/dhandler Wed Mar 12 19:18:04 2008
@@ -0,0 +1,30 @@
+<%INIT>
+my $arg = $m->dhandler_arg;
+
+my ($type, $id);
+if ( $arg =~ m{^(Members|Links)/(\d+)$}i ) {
+ ($type, $id) = ($1, $2);
+} else {
+ return $m->abort( 404 );
+}
+
+my $ticket = RT::Ticket->new($session{'CurrentUser'} );
+$ticket->Load( $id );
+unless ( $ticket->id ) {
+ $RT::Logger->error("Couldn't load ticket #$id");
+ return $m->abort( 404 );
+}
+
+require RT::Graph::Tickets;
+my $method = 'Ticket'. ucfirst lc $type;
+my $graph = RT::Graph::Tickets->$method(
+ %ARGS,
+ Ticket => $ticket,
+);
+
+$r->content_type( 'image/png' );
+$m->clear_buffer;
+$graph->as_png( sub { $m->out( shift ) } );
+$m->abort;
+
+</%INIT>
Added: rt/branches/3.8-TESTING/html/Ticket/Graphs/index.html
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/html/Ticket/Graphs/index.html Wed Mar 12 19:18:04 2008
@@ -0,0 +1,66 @@
+<& /Elements/Header, Title => $title &>
+<& /Ticket/Elements/Tabs,
+ Ticket => $ticket,
+ Title => $title,
+ current_tab => "Ticket/ModifyLinks.html?id=$id",
+&>
+
+<& /Elements/ListActions, actions => \@results &>
+
+<& Elements/ShowGraph, %ARGS, Ticket => $ticket &>
+
+<form action="<% $RT::WebPath %><% $m->request_comp->path %>">
+<input type="hidden" class="hidden" name="id" value="<% $id %>" />
+<input type="hidden" class="hidden" name="Type" value="<% $ARGS{'Type'} %>" />
+
+<& Elements/EditGraphProperties,
+ %ARGS,
+ Ticket => $ticket,
+ Type => $Type,
+ AllowAdditionalProperties => $Type eq 'Links'? 0 : 1,
+&>
+
+<& /Search/Elements/EditSearches,
+ Name => 'Owner',
+ SearchType => $saved_search->{SearchType},
+ AllowCopy => 0,
+ CurrentSearch => $saved_search->{CurrentSearch},
+ SearchId => $saved_search->{SearchId},
+ Title => loc('Manage saved graphs'),
+&>
+</form>
+
+<%ARGS>
+</%ARGS>
+<%INIT>
+my @results;
+
+my @save_arguments = qw(Type id Depth FillUsing ShowLinkDescriptions);
+foreach my $level ( 0 .. 6 ) {
+ push @save_arguments, "Level-". $level ."-Properties";
+}
+my $saved_search = $m->comp( '/Widgets/SavedSearch:new',
+ SearchType => 'Graph',
+ SearchFields => \@save_arguments,
+);
+push @results, $m->comp( '/Widgets/SavedSearch:process', args => \%ARGS, self => $saved_search );
+
+my $id = $ARGS{'id'};
+my $ticket = LoadTicket( $id );
+$ARGS{'id'} = $id = $ticket->id;
+
+my $Type = $ARGS{'Type'} || 'Links';
+$Type = ucfirst lc $Type;
+unless ( $Type eq 'Links' || $Type eq 'Members' ) {
+ $RT::Logger->error("'$Type' is incorrect type of ticket graph");
+ $Type = 'Links';
+}
+$ARGS{'Depth'} = 3 unless defined $ARGS{'Depth'} && length $ARGS{'Depth'};
+
+my $title;
+if ( $Type eq 'Links' ) {
+ $title = loc( "Ticket #[_1] full relationships graph", $id );
+} else {
+ $title = loc( "Ticket #[_1] relationships graph", $id );
+}
+</%INIT>
Added: rt/branches/3.8-TESTING/lib/RT/Graph/Tickets.pm
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/lib/RT/Graph/Tickets.pm Wed Mar 12 19:18:04 2008
@@ -0,0 +1,339 @@
+package RT::Graph::Tickets;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.09';
+
+=head1 NAME
+
+RT::Graph::Tickets - view relations between tickets as graphs
+
+=cut
+
+use IPC::Run;
+use IPC::Run::SafeHandles;
+use GraphViz;
+
+our %ticket_status_style = (
+ new => { fontcolor => '#FF0000' },
+ open => { fontcolor => '#000000' },
+ stalled => { fontcolor => '#DAA520' },
+ resolved => { fontcolor => '#00FF00' },
+ rejected => { fontcolor => '#808080' },
+ deleted => { fontcolor => '#A9A9A9' },
+);
+
+my %link_style = (
+ MemberOf => { style => 'solid' },
+ DependsOn => { style => 'dashed', constraint => 'false' },
+ RefersTo => { style => 'dotted', constraint => 'false' },
+);
+
+my @fill_colors = qw(
+ #0000FF #8A2BE2 #A52A2A #DEB887 #5F9EA0 #7FFF00 #D2691E #FF7F50
+ #6495ED #FFF8DC #DC143C #00FFFF #00008B #008B8B #B8860B #A9A9A9
+ #A9A9A9 #006400 #BDB76B #8B008B #556B2F #FF8C00 #9932CC #8B0000
+ #E9967A #8FBC8F #483D8B #2F4F4F #2F4F4F #00CED1 #9400D3 #FF1493
+ #00BFFF #696969 #696969 #1E90FF #B22222 #FFFAF0 #228B22 #FF00FF
+ #DCDCDC #F8F8FF #FFD700 #DAA520 #808080 #808080 #008000 #ADFF2F
+ #F0FFF0 #FF69B4 #CD5C5C #4B0082 #FFFFF0 #F0E68C #E6E6FA #FFF0F5
+ #7CFC00 #FFFACD #ADD8E6 #F08080 #E0FFFF #FAFAD2 #D3D3D3 #D3D3D3
+ #90EE90 #FFB6C1 #FFA07A #20B2AA #87CEFA #778899 #778899 #B0C4DE
+ #FFFFE0 #00FF00 #32CD32 #FAF0E6 #FF00FF #800000 #66CDAA #0000CD
+ #BA55D3 #9370D8 #3CB371 #7B68EE #00FA9A #48D1CC #C71585 #191970
+ #F5FFFA #FFE4E1 #FFE4B5 #FFDEAD #000080 #FDF5E6 #808000 #6B8E23
+ #FFA500 #FF4500 #DA70D6 #EEE8AA #98FB98 #AFEEEE #D87093 #FFEFD5
+ #FFDAB9 #CD853F #FFC0CB #DDA0DD #B0E0E6 #800080 #FF0000 #BC8F8F
+ #4169E1 #8B4513 #FA8072 #F4A460 #2E8B57 #FFF5EE #A0522D #C0C0C0
+ #87CEEB #6A5ACD #708090 #708090 #FFFAFA #00FF7F #4682B4 #D2B48C
+ #008080 #D8BFD8 #FF6347 #40E0D0 #EE82EE #F5DEB3 #FFFF00 #9ACD32
+);
+
+sub gv_escape($) {
+ my $value = shift;
+ $value =~ s{(?=")}{\\}g;
+ return $value;
+}
+
+our (%fill_cache, @available_colors) = ();
+
+sub TicketMembers {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ Graph => undef,
+ Seen => undef,
+ Depth => 0,
+ CurrentDepth => 1,
+ @_
+ );
+ unless ( $args{'Graph'} ) {
+ $args{'Graph'} = GraphViz->new(
+ name => "ticket_members_". $args{'Ticket'}->id,
+ bgcolor => "transparent",
+ node => { shape => 'box', style => 'rounded,filled', fillcolor => 'white' },
+ );
+ %fill_cache = ();
+ @available_colors = @fill_colors;
+ }
+
+ $self->AddTicket( %args );
+
+ $args{'Seen'} ||= {};
+ return $args{'Graph'} if $args{'Seen'}{ $args{'Ticket'}->id }++;
+
+ return $args{'Graph'} if $args{'Depth'} && $args{'CurrentDepth'} >= $args{'Depth'};
+
+ my $show_link_descriptions = $args{'ShowLinkDescriptions'}
+ && RT::Link->can('Description');
+
+ my $to_links = $args{'Ticket'}->Links('Target', 'MemberOf');
+ $to_links->GotoFirstItem;
+ while ( my $link = $to_links->Next ) {
+ my $base = $link->BaseObj;
+ next unless $base->isa('RT::Ticket');
+
+ $self->TicketMembers(
+ %args,
+ Ticket => $base,
+ CurrentDepth => $args{'CurrentDepth'} + 1,
+ );
+
+ my $desc;
+ $desc = $link->Description if $show_link_descriptions;
+ $args{'Graph'}->add_edge(
+ $args{'Ticket'}->id => $base->id,
+ $desc? (label => gv_escape $desc): (),
+ );
+ }
+ return $args{'Graph'};
+};
+
+my %property_cb = (
+ Queue => sub { return $_[0]->QueueObj->Name || $_[0]->Queue },
+ CF => sub {
+ my $values = $_[0]->CustomFieldValues( $_[1] );
+ return join ', ', map $_->Content, @{ $values->ItemsArrayRef };
+ },
+);
+foreach my $field (qw(Subject Status TimeLeft TimeWorked TimeEstimated)) {
+ $property_cb{ $field } = sub { return $_[0]->$field },
+}
+foreach my $field (qw(Creator LastUpdatedBy Owner)) {
+ $property_cb{ $field } = sub {
+ my $method = $field .'Obj';
+ return $_[0]->$method->Name;
+ };
+}
+foreach my $field (qw(Requestor Cc AdminCc)) {
+ $property_cb{ $field."s" } = sub {
+ my $method = $field .'Addresses';
+ return $_[0]->$method;
+ };
+}
+foreach my $field (qw(Told Starts Started Due Resolved LastUpdated Created)) {
+ $property_cb{ $field } = sub {
+ my $method = $field .'Obj';
+ return $_[0]->$method->AsString;
+ };
+}
+foreach my $field (qw(Members DependedOnBy ReferredToBy)) {
+ $property_cb{ $field } = sub {
+ return join ', ', map $_->BaseObj->id, @{ $_[0]->$field->ItemsArrayRef };
+ };
+}
+foreach my $field (qw(MemberOf DependsOn RefersTo)) {
+ $property_cb{ $field } = sub {
+ return join ', ', map $_->TargetObj->id, @{ $_[0]->$field->ItemsArrayRef };
+ };
+}
+
+
+sub TicketProperties {
+ my $self = shift;
+ my $user = shift;
+ my @res = (
+ Basics => [qw(Subject Status Queue TimeLeft TimeWorked TimeEstimated)],
+ People => [qw(Owner Requestors Ccs AdminCcs Creator LastUpdatedBy)],
+ Dates => [qw(Created Starts Started Due Resolved Told LastUpdated)],
+ Links => [qw(MemberOf Members DependsOn DependedOnBy RefersTo ReferredToBy)],
+ );
+ my $cfs = RT::CustomFields->new( $user );
+ $cfs->LimitToLookupType('RT::Queue-RT::Ticket');
+ $cfs->OrderBy( FIELD => 'Name' );
+ my ($first, %seen) = (1);
+ while ( my $cf = $cfs->Next ) {
+ next if $seen{ lc $cf->Name }++;
+ next if $cf->Type eq 'Image';
+ if ( $first ) {
+ push @res, 'CustomFields', [];
+ $first = 0;
+ }
+ push @{ $res[-1] }, 'CF.{'. $cf->Name .'}';
+ }
+ return @res;
+}
+
+sub _SplitProperty {
+ my $self = shift;
+ my $property = shift;
+ my ($key, @subkeys) = split /\./, $property;
+ foreach ( grep /^{.*}$/, @subkeys ) {
+ s/^{//;
+ s/}$//;
+ }
+ return $key, @subkeys;
+}
+
+sub _PropertiesToFields {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ Graph => undef,
+ CurrentDepth => 1,
+ @_
+ );
+
+ my @properties;
+ if ( my $tmp = $args{ 'Level-'. $args{'CurrentDepth'} .'-Properties' } ) {
+ @properties = ref $tmp? @$tmp : ($tmp);
+ }
+
+ my @fields;
+ foreach my $property( @properties ) {
+ my ($key, @subkeys) = $self->_SplitProperty( $property );
+ unless ( $property_cb{ $key } ) {
+ $RT::Logger->error("Couldn't find property handler for '$key' and '@subkeys' subkeys");
+ next;
+ }
+ push @fields, ($subkeys[0] || $key) .': '. $property_cb{ $key }->( $args{'Ticket'}, @subkeys );
+ }
+
+ return @fields;
+}
+
+sub AddTicket {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ Properties => [],
+ Graph => undef,
+ CurrentDepth => 1,
+ @_
+ );
+
+ my %node_style = (
+ %{ $ticket_status_style{ $args{'Ticket'}->Status } || {} },
+ URL => $RT::WebPath .'/Ticket/Display.html?id='. $args{'Ticket'}->id,
+ tooltip => gv_escape( $args{'Ticket'}->Subject || '#'. $args{'Ticket'}->id ),
+ );
+
+ my @fields = $self->_PropertiesToFields( %args );
+ if ( @fields ) {
+ unshift @fields, $args{'Ticket'}->id;
+ $node_style{'label'} = gv_escape( '{ '. join( ' | ', map { s/(?=[{}|])/\\/g; $_ } @fields ) .' }' );
+ $node_style{'shape'} = 'record';
+ }
+
+ if ( $args{'FillUsing'} ) {
+ my ($key, @subkeys) = $self->_SplitProperty( $args{'FillUsing'} );
+ my $value = $property_cb{ $key }->( $args{'Ticket'}, @subkeys );
+ if ( defined $value && length $value && $value =~ /\S/ ) {
+ my $fill = $fill_cache{ $value };
+ $fill = $fill_cache{ $value } = shift @available_colors
+ unless $fill;
+ if ( $fill ) {
+ $node_style{'fillcolor'} = $fill;
+ $node_style{'style'} ||= '';
+ $node_style{'style'} = join ',', split( ',', $node_style{'style'} ), 'filled'
+ unless $node_style{'style'} =~ /\bfilled\b/;
+ }
+ }
+ }
+
+ $args{'Graph'}->add_node( $args{'Ticket'}->id, %node_style );
+}
+
+sub TicketLinks {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ Graph => undef,
+ Seen => undef,
+ SeenEdge => undef,
+ Depth => 0,
+ @_
+ );
+ unless ( $args{'Graph'} ) {
+ $args{'Graph'} = GraphViz->new(
+ name => 'ticket_links_'. $args{'Ticket'}->id,
+ bgcolor => "transparent",
+ node => { shape => 'box', style => 'filled,rounded', fillcolor => 'white' },
+ );
+ %fill_cache = ();
+ @available_colors = @fill_colors;
+ }
+ $self->AddTicket( %args );
+
+ $args{'Seen'} ||= {};
+ return $args{'Graph'} if $args{'Seen'}{ $args{'Ticket'}->id }++;
+
+ return $args{'Graph'} if $args{'Depth'} && $args{'Depth'} == 1;
+
+ $args{'SeenEdge'} ||= {};
+
+ my $show_link_descriptions = $args{'ShowLinkDescriptions'}
+ && RT::Link->can('Description');
+
+ my $from_links = $args{'Ticket'}->Links('Base');
+ $from_links->GotoFirstItem;
+ while ( my $link = $from_links->Next ) {
+ my $target = $link->TargetObj;
+ next unless $target->isa('RT::Ticket');
+
+ $self->TicketLinks(
+ %args,
+ Ticket => $target,
+ Depth => $args{'Depth'}? $args{'Depth'} - 1 : 0,
+ );
+ next if $args{'SeenEdge'}{ $link->id }++;
+
+ my $desc;
+ $desc = $link->Description if $show_link_descriptions;
+ $args{'Graph'}->add_edge(
+ $link->Type eq 'MemberOf'
+ ? ($target->id => $args{'Ticket'}->id)
+ : ($args{'Ticket'}->id => $target->id),
+ %{ $link_style{ $link->Type } || {} },
+ $desc? (label => gv_escape $desc): (),
+ );
+ }
+
+ my $to_links = $args{'Ticket'}->Links('Target');
+ $to_links->GotoFirstItem;
+ while ( my $link = $to_links->Next ) {
+ my $base = $link->BaseObj;
+ next unless $base->isa('RT::Ticket');
+
+ $self->TicketLinks(
+ %args,
+ Ticket => $base,
+ Depth => $args{'Depth'}? $args{'Depth'} - 1 : 0,
+ );
+ next if $args{'SeenEdge'}{ $link->id }++;
+
+ my $desc;
+ $desc = $link->Description if $show_link_descriptions;
+ $args{'Graph'}->add_edge(
+ $link->Type eq 'MemberOf'
+ ? ($args{'Ticket'}->id => $base->id)
+ : ($base->id => $args{'Ticket'}->id),
+ %{ $link_style{ $link->Type } || {} },
+ $desc? (label => gv_escape $desc): (),
+ );
+ }
+ return $args{'Graph'};
+}
+
+1;
More information about the Rt-commit
mailing list