Master to 4.2.8
[usit-rt.git] / lib / RT / Graph / Tickets.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
6 #                                          <sales@bestpractical.com>
7 #
8 # (Except where explicitly superseded by other copyright notices)
9 #
10 #
11 # LICENSE:
12 #
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
16 # from www.gnu.org.
17 #
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28 #
29 #
30 # CONTRIBUTION SUBMISSION POLICY:
31 #
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
37 #
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
46 #
47 # END BPS TAGGED BLOCK }}}
48
49 package RT::Graph::Tickets;
50
51 use strict;
52 use warnings;
53
54 =head1 NAME
55
56 RT::Graph::Tickets - view relations between tickets as graphs
57
58 =cut
59
60 unless ($RT::DisableGraphViz) {
61     require GraphViz;
62     GraphViz->import;
63 }
64
65 our %ticket_status_style = (
66     new      => { fontcolor => '#FF0000', fontsize => 10 },
67     open     => { fontcolor => '#000000', fontsize => 10 },
68     stalled  => { fontcolor => '#DAA520', fontsize => 10 },
69     resolved => { fontcolor => '#00FF00', fontsize => 10 },
70     rejected => { fontcolor => '#808080', fontsize => 10 },
71     deleted  => { fontcolor => '#A9A9A9', fontsize => 10 },
72 );
73
74 our %link_style = (
75     MemberOf  => { style => 'solid' },
76     DependsOn => { style => 'dashed' },
77     RefersTo  => { style => 'dotted' },
78 );
79
80 # We don't use qw() because perl complains about "possible attempt to put comments in qw() list"
81 our @fill_colors = split ' ',<<EOT;
82     #0000FF #8A2BE2 #A52A2A #DEB887 #5F9EA0 #7FFF00 #D2691E #FF7F50
83     #6495ED #FFF8DC #DC143C #00FFFF #00008B #008B8B #B8860B #A9A9A9
84     #A9A9A9 #006400 #BDB76B #8B008B #556B2F #FF8C00 #9932CC #8B0000
85     #E9967A #8FBC8F #483D8B #2F4F4F #2F4F4F #00CED1 #9400D3 #FF1493
86     #00BFFF #696969 #696969 #1E90FF #B22222 #FFFAF0 #228B22 #FF00FF
87     #DCDCDC #F8F8FF #FFD700 #DAA520 #808080 #808080 #008000 #ADFF2F
88     #F0FFF0 #FF69B4 #CD5C5C #4B0082 #FFFFF0 #F0E68C #E6E6FA #FFF0F5
89     #7CFC00 #FFFACD #ADD8E6 #F08080 #E0FFFF #FAFAD2 #D3D3D3 #D3D3D3
90     #90EE90 #FFB6C1 #FFA07A #20B2AA #87CEFA #778899 #778899 #B0C4DE
91     #FFFFE0 #00FF00 #32CD32 #FAF0E6 #FF00FF #800000 #66CDAA #0000CD
92     #BA55D3 #9370D8 #3CB371 #7B68EE #00FA9A #48D1CC #C71585 #191970
93     #F5FFFA #FFE4E1 #FFE4B5 #FFDEAD #000080 #FDF5E6 #808000 #6B8E23
94     #FFA500 #FF4500 #DA70D6 #EEE8AA #98FB98 #AFEEEE #D87093 #FFEFD5
95     #FFDAB9 #CD853F #FFC0CB #DDA0DD #B0E0E6 #800080 #FF0000 #BC8F8F
96     #4169E1 #8B4513 #FA8072 #F4A460 #2E8B57 #FFF5EE #A0522D #C0C0C0
97     #87CEEB #6A5ACD #708090 #708090 #FFFAFA #00FF7F #4682B4 #D2B48C
98     #008080 #D8BFD8 #FF6347 #40E0D0 #EE82EE #F5DEB3 #FFFF00 #9ACD32
99 EOT
100
101 sub gv_escape($) {
102     my $value = shift;
103     $value =~ s{(?=["\\])}{\\}g;
104     return $value;
105 }
106
107 our (%fill_cache, @available_colors) = ();
108
109 our %property_cb = (
110     Queue => sub { return $_[0]->QueueObj->Name || $_[0]->Queue },
111     CF    => sub {
112         my $values = $_[0]->CustomFieldValues( $_[1] );
113         return join ', ', map $_->Content, @{ $values->ItemsArrayRef };
114     },
115 );
116 foreach my $field (qw(Subject Status TimeLeft TimeWorked TimeEstimated)) {
117     $property_cb{ $field } = sub { return $_[0]->$field },
118 }
119 foreach my $field (qw(Creator LastUpdatedBy Owner)) {
120     $property_cb{ $field } = sub {
121         my $method = $field .'Obj';
122         return $_[0]->$method->Name;
123     };
124 }
125 foreach my $field (qw(Requestor Cc AdminCc)) {
126     $property_cb{ $field."s" } = sub {
127         my $method = $field .'Addresses';
128         return $_[0]->$method;
129     };
130 }
131 foreach my $field (qw(Told Starts Started Due Resolved LastUpdated Created)) {
132     $property_cb{ $field } = sub {
133         my $method = $field .'Obj';
134         return $_[0]->$method->AsString;
135     };
136 }
137 foreach my $field (qw(Members DependedOnBy ReferredToBy)) {
138     $property_cb{ $field } = sub {
139         return join ', ', map $_->BaseObj->id, @{ $_[0]->$field->ItemsArrayRef };
140     };
141 }
142 foreach my $field (qw(MemberOf DependsOn RefersTo)) {
143     $property_cb{ $field } = sub {
144         return join ', ', map $_->TargetObj->id, @{ $_[0]->$field->ItemsArrayRef };
145     };
146 }
147
148
149 sub TicketProperties {
150     my $self = shift;
151     my $user = shift;
152     my @res = (
153         Basics => [qw(Subject Status Queue TimeLeft TimeWorked TimeEstimated)], # loc_qw
154         People => [qw(Owner Requestors Ccs AdminCcs Creator LastUpdatedBy)], # loc_qw
155         Dates  => [qw(Created Starts Started Due Resolved Told LastUpdated)], # loc_qw
156         Links  => [qw(MemberOf Members DependsOn DependedOnBy RefersTo ReferredToBy)], # loc_qw
157     );
158     my $cfs = RT::CustomFields->new( $user );
159     $cfs->LimitToLookupType('RT::Queue-RT::Ticket');
160     $cfs->OrderBy( FIELD => 'Name' );
161     my ($first, %seen) = (1);
162     while ( my $cf = $cfs->Next ) {
163         next if $seen{ lc $cf->Name }++;
164         next if $cf->Type eq 'Image';
165         if ( $first ) {
166             push @res, 'CustomFields', [];
167             $first = 0;
168         }
169         push @{ $res[-1] }, 'CF.{'. $cf->Name .'}';
170     }
171     return @res;
172 }
173
174 sub _SplitProperty {
175     my $self = shift;
176     my $property = shift;
177     my ($key, @subkeys) = split /\./, $property;
178     foreach ( grep /^{.*}$/, @subkeys ) {
179         s/^{//;
180         s/}$//;
181     }
182     return $key, @subkeys;
183 }
184
185 sub _PropertiesToFields {
186     my $self = shift;
187     my %args = (
188         Ticket       => undef,
189         Graph        => undef,
190         CurrentDepth => 1,
191         @_
192     );
193
194     my @properties;
195     if ( my $tmp = $args{ 'Level-'. $args{'CurrentDepth'} .'-Properties' } ) {
196         @properties = ref $tmp? @$tmp : ($tmp);
197     }
198
199     my @fields;
200     foreach my $property( @properties ) {
201         my ($key, @subkeys) = $self->_SplitProperty( $property );
202         unless ( $property_cb{ $key } ) {
203             $RT::Logger->error("Couldn't find property handler for '$key' and '@subkeys' subkeys");
204             next;
205         }
206         push @fields, ($subkeys[0] || $key) .': '. $property_cb{ $key }->( $args{'Ticket'}, @subkeys );
207     }
208
209     return @fields;
210 }
211
212 sub AddTicket {
213     my $self = shift;
214     my %args = (
215         Ticket       => undef,
216         Properties   => [],
217         Graph        => undef,
218         CurrentDepth => 1,
219         @_
220     );
221
222     my %node_style = (
223         style => 'filled,rounded',
224         %{ $ticket_status_style{ $args{'Ticket'}->Status } || {} },
225         URL   => $RT::WebPath .'/Ticket/Display.html?id='. $args{'Ticket'}->id,
226         tooltip => gv_escape( $args{'Ticket'}->Subject || '#'. $args{'Ticket'}->id ),
227     );
228
229     my @fields = $self->_PropertiesToFields( %args );
230     if ( @fields ) {
231         unshift @fields, $args{'Ticket'}->id;
232         my $label = join ' | ', map { s/(?=[{}|><])/\\/g; $_ } @fields;
233         $label = "{ $label }" if ($args{'Direction'} || 'TB') =~ /^(?:TB|BT)$/;
234         $node_style{'label'} = gv_escape( $label );
235         $node_style{'shape'} = 'record';
236     }
237     
238     if ( $args{'FillUsing'} ) {
239         my ($key, @subkeys) = $self->_SplitProperty( $args{'FillUsing'} );
240         my $value;
241         if ( $property_cb{ $key } ) {
242             $value = $property_cb{ $key }->( $args{'Ticket'}, @subkeys );
243         } else {
244             $RT::Logger->error("Couldn't find property callback for '$key'");
245         }
246         if ( defined $value && length $value && $value =~ /\S/ ) {
247             my $fill = $fill_cache{ $value };
248             $fill = $fill_cache{ $value } = shift @available_colors
249                 unless $fill;
250             if ( $fill ) {
251                 $node_style{'fillcolor'} = $fill;
252                 $node_style{'style'} ||= '';
253                 $node_style{'style'} = join ',', split( ',', $node_style{'style'} ), 'filled'
254                     unless $node_style{'style'} =~ /\bfilled\b/;
255             }
256         }
257     }
258
259     $args{'Graph'}->add_node( $args{'Ticket'}->id, %node_style );
260 }
261
262 sub TicketLinks {
263     my $self = shift;
264     my %args = (
265         Ticket               => undef,
266
267         Graph                => undef,
268         Direction            => 'TB',
269         Seen                 => undef,
270         SeenEdge             => undef,
271
272         LeadingLink          => 'Members',
273         ShowLinks            => [],
274
275         MaxDepth             => 0,
276         CurrentDepth         => 1,
277
278         ShowLinkDescriptions => 0,
279         @_
280     );
281
282     my %valid_links = map { $_ => 1 }
283         qw(Members MemberOf RefersTo ReferredToBy DependsOn DependedOnBy);
284
285     # Validate our link types
286     $args{ShowLinks}   = [ grep { $valid_links{$_} } @{$args{ShowLinks}} ];
287     $args{LeadingLink} = 'Members' unless $valid_links{ $args{LeadingLink} };
288
289     unless ( $args{'Graph'} ) {
290         $args{'Graph'} = GraphViz->new(
291             name    => 'ticket_links_'. $args{'Ticket'}->id,
292             bgcolor => "transparent",
293 # TODO: patch GraphViz to support all posible RDs
294             rankdir => ($args{'Direction'} || "TB") eq "LR",
295             node => { shape => 'box', style => 'filled,rounded', fillcolor => 'white' },
296         );
297         %fill_cache = ();
298         @available_colors = @fill_colors;
299     }
300
301     $args{'Seen'} ||= {};
302     if ( $args{'Seen'}{ $args{'Ticket'}->id } && $args{'Seen'}{ $args{'Ticket'}->id } <= $args{'CurrentDepth'} ) {
303       return $args{'Graph'};
304     } elsif ( ! defined $args{'Seen'}{ $args{'Ticket'}->id } ) {
305       $self->AddTicket( %args );
306     }
307     $args{'Seen'}{ $args{'Ticket'}->id } = $args{'CurrentDepth'};
308
309     return $args{'Graph'} if $args{'MaxDepth'} && $args{'CurrentDepth'} >= $args{'MaxDepth'};
310
311     $args{'SeenEdge'} ||= {};
312
313     my $show_link_descriptions = $args{'ShowLinkDescriptions'}
314         && RT::Link->can('Description');
315
316     foreach my $type ( $args{'LeadingLink'}, @{ $args{'ShowLinks'} } ) {
317         my $links = $args{'Ticket'}->$type();
318         $links->GotoFirstItem;
319         while ( my $link = $links->Next ) {
320             next if $args{'SeenEdge'}{ $link->id }++;
321
322             my $target = $link->TargetObj;
323             next unless $target && $target->isa('RT::Ticket');
324
325             my $base = $link->BaseObj;
326             next unless $base && $base->isa('RT::Ticket');
327
328             my $next = $target->id == $args{'Ticket'}->id? $base : $target;
329
330             $self->TicketLinks(
331                 %args,
332                 Ticket => $next,
333                 $type eq $args{'LeadingLink'}
334                     ? ( CurrentDepth => $args{'CurrentDepth'} + 1 )
335                     : ( MaxDepth => $args{'CurrentDepth'} + 1,
336                         CurrentDepth => $args{'CurrentDepth'} + 1 ),
337             );
338
339             my $desc;
340             $desc = $link->Description if $show_link_descriptions;
341             $args{'Graph'}->add_edge(
342                 # we revers order of member links to get better layout
343                 $link->Type eq 'MemberOf'
344                     ? ($target->id => $base->id, dir => 'back')
345                     : ($base->id => $target->id),
346                 %{ $link_style{ $link->Type } || {} },
347                 $desc? (label => gv_escape $desc): (),
348             );
349         }
350     }
351
352     return $args{'Graph'};
353 }
354
355 RT::Base->_ImportOverlays();
356
357 1;