]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
320f0092 | 5 | # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC |
84fb5b46 MKG |
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'} ||= {}; | |
c33a4027 MKG |
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'}; | |
84fb5b46 MKG |
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; |