import rt 3.8.10
[freeside.git] / rt / lib / RT / Ticket_Overlay.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2011 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 # {{{ Front Material 
50
51 =head1 SYNOPSIS
52
53   use RT::Ticket;
54   my $ticket = new RT::Ticket($CurrentUser);
55   $ticket->Load($ticket_id);
56
57 =head1 DESCRIPTION
58
59 This module lets you manipulate RT\'s ticket object.
60
61
62 =head1 METHODS
63
64
65 =cut
66
67
68 package RT::Ticket;
69
70 use strict;
71 no warnings qw(redefine);
72
73 use RT::Queue;
74 use RT::User;
75 use RT::Record;
76 use RT::Links;
77 use RT::Date;
78 use RT::CustomFields;
79 use RT::Tickets;
80 use RT::Transactions;
81 use RT::Reminders;
82 use RT::URI::fsck_com_rt;
83 use RT::URI;
84 use MIME::Entity;
85
86
87 # {{{ LINKTYPEMAP
88 # A helper table for links mapping to make it easier
89 # to build and parse links between tickets
90
91 our %LINKTYPEMAP = (
92     MemberOf => { Type => 'MemberOf',
93                   Mode => 'Target', },
94     Parents => { Type => 'MemberOf',
95          Mode => 'Target', },
96     Members => { Type => 'MemberOf',
97                  Mode => 'Base', },
98     Children => { Type => 'MemberOf',
99           Mode => 'Base', },
100     HasMember => { Type => 'MemberOf',
101                    Mode => 'Base', },
102     RefersTo => { Type => 'RefersTo',
103                   Mode => 'Target', },
104     ReferredToBy => { Type => 'RefersTo',
105                       Mode => 'Base', },
106     DependsOn => { Type => 'DependsOn',
107                    Mode => 'Target', },
108     DependedOnBy => { Type => 'DependsOn',
109                       Mode => 'Base', },
110     MergedInto => { Type => 'MergedInto',
111                    Mode => 'Target', },
112
113 );
114
115 # }}}
116
117 # {{{ LINKDIRMAP
118 # A helper table for links mapping to make it easier
119 # to build and parse links between tickets
120
121 our %LINKDIRMAP = (
122     MemberOf => { Base => 'MemberOf',
123                   Target => 'HasMember', },
124     RefersTo => { Base => 'RefersTo',
125                 Target => 'ReferredToBy', },
126     DependsOn => { Base => 'DependsOn',
127                    Target => 'DependedOnBy', },
128     MergedInto => { Base => 'MergedInto',
129                    Target => 'MergedInto', },
130
131 );
132
133 # }}}
134
135 sub LINKTYPEMAP   { return \%LINKTYPEMAP   }
136 sub LINKDIRMAP   { return \%LINKDIRMAP   }
137
138 our %MERGE_CACHE = (
139     effective => {},
140     merged => {},
141 );
142
143 # {{{ sub Load
144
145 =head2 Load
146
147 Takes a single argument. This can be a ticket id, ticket alias or 
148 local ticket uri.  If the ticket can't be loaded, returns undef.
149 Otherwise, returns the ticket id.
150
151 =cut
152
153 sub Load {
154     my $self = shift;
155     my $id   = shift;
156     $id = '' unless defined $id;
157
158     # TODO: modify this routine to look at EffectiveId and
159     # do the recursive load thing. be careful to cache all
160     # the interim tickets we try so we don't loop forever.
161
162     # FIXME: there is no TicketBaseURI option in config
163     my $base_uri = RT->Config->Get('TicketBaseURI') || '';
164     #If it's a local URI, turn it into a ticket id
165     if ( $base_uri && $id =~ /^$base_uri(\d+)$/ ) {
166         $id = $1;
167     }
168
169     unless ( $id =~ /^\d+$/ ) {
170         $RT::Logger->debug("Tried to load a bogus ticket id: '$id'");
171         return (undef);
172     }
173
174     $id = $MERGE_CACHE{'effective'}{ $id }
175         if $MERGE_CACHE{'effective'}{ $id };
176
177     my ($ticketid, $msg) = $self->LoadById( $id );
178     unless ( $self->Id ) {
179         $RT::Logger->debug("$self tried to load a bogus ticket: $id");
180         return (undef);
181     }
182
183     #If we're merged, resolve the merge.
184     if ( $self->EffectiveId && $self->EffectiveId != $self->Id ) {
185         $RT::Logger->debug(
186             "We found a merged ticket. "
187             . $self->id ."/". $self->EffectiveId
188         );
189         my $real_id = $self->Load( $self->EffectiveId );
190         $MERGE_CACHE{'effective'}{ $id } = $real_id;
191         return $real_id;
192     }
193
194     #Ok. we're loaded. lets get outa here.
195     return $self->Id;
196 }
197
198 # }}}
199
200 # {{{ sub Create
201
202 =head2 Create (ARGS)
203
204 Arguments: ARGS is a hash of named parameters.  Valid parameters are:
205
206   id 
207   Queue  - Either a Queue object or a Queue Name
208   Requestor -  A reference to a list of  email addresses or RT user Names
209   Cc  - A reference to a list of  email addresses or Names
210   AdminCc  - A reference to a  list of  email addresses or Names
211   SquelchMailTo - A reference to a list of email addresses - 
212                   who should this ticket not mail
213   Type -- The ticket\'s type. ignore this for now
214   Owner -- This ticket\'s owner. either an RT::User object or this user\'s id
215   Subject -- A string describing the subject of the ticket
216   Priority -- an integer from 0 to 99
217   InitialPriority -- an integer from 0 to 99
218   FinalPriority -- an integer from 0 to 99
219   Status -- any valid status (Defined in RT::Queue)
220   TimeEstimated -- an integer. estimated time for this task in minutes
221   TimeWorked -- an integer. time worked so far in minutes
222   TimeLeft -- an integer. time remaining in minutes
223   Starts -- an ISO date describing the ticket\'s start date and time in GMT
224   Due -- an ISO date describing the ticket\'s due date and time in GMT
225   MIMEObj -- a MIME::Entity object with the content of the initial ticket request.
226   CustomField-<n> -- a scalar or array of values for the customfield with the id <n>
227
228 Ticket links can be set up during create by passing the link type as a hask key and
229 the ticket id to be linked to as a value (or a URI when linking to other objects).
230 Multiple links of the same type can be created by passing an array ref. For example:
231
232   Parents => 45,
233   DependsOn => [ 15, 22 ],
234   RefersTo => 'http://www.bestpractical.com',
235
236 Supported link types are C<MemberOf>, C<HasMember>, C<RefersTo>, C<ReferredToBy>,
237 C<DependsOn> and C<DependedOnBy>. Also, C<Parents> is alias for C<MemberOf> and
238 C<Members> and C<Children> are aliases for C<HasMember>.
239
240 Returns: TICKETID, Transaction Object, Error Message
241
242
243 =cut
244
245 sub Create {
246     my $self = shift;
247
248     my %args = (
249         id                 => undef,
250         EffectiveId        => undef,
251         Queue              => undef,
252         Requestor          => undef,
253         Cc                 => undef,
254         AdminCc            => undef,
255         SquelchMailTo      => undef,
256         Type               => 'ticket',
257         Owner              => undef,
258         Subject            => '',
259         InitialPriority    => undef,
260         FinalPriority      => undef,
261         Priority           => undef,
262         Status             => 'new',
263         TimeWorked         => "0",
264         TimeLeft           => 0,
265         TimeEstimated      => 0,
266         Due                => undef,
267         Starts             => undef,
268         Started            => undef,
269         Resolved           => undef,
270         MIMEObj            => undef,
271         _RecordTransaction => 1,
272         DryRun             => 0,
273         @_
274     );
275
276     my ($ErrStr, @non_fatal_errors);
277
278     my $QueueObj = RT::Queue->new( $RT::SystemUser );
279     if ( ref $args{'Queue'} eq 'RT::Queue' ) {
280         $QueueObj->Load( $args{'Queue'}->Id );
281     }
282     elsif ( $args{'Queue'} ) {
283         $QueueObj->Load( $args{'Queue'} );
284     }
285     else {
286         $RT::Logger->debug("'". ( $args{'Queue'} ||''). "' not a recognised queue object." );
287     }
288
289     #Can't create a ticket without a queue.
290     unless ( $QueueObj->Id ) {
291         $RT::Logger->debug("$self No queue given for ticket creation.");
292         return ( 0, 0, $self->loc('Could not create ticket. Queue not set') );
293     }
294
295
296     #Now that we have a queue, Check the ACLS
297     unless (
298         $self->CurrentUser->HasRight(
299             Right  => 'CreateTicket',
300             Object => $QueueObj
301         )
302       )
303     {
304         return (
305             0, 0,
306             $self->loc( "No permission to create tickets in the queue '[_1]'", $QueueObj->Name));
307     }
308
309     unless ( $QueueObj->IsValidStatus( $args{'Status'} ) ) {
310         return ( 0, 0, $self->loc('Invalid value for status') );
311     }
312
313     #Since we have a queue, we can set queue defaults
314
315     #Initial Priority
316     # If there's no queue default initial priority and it's not set, set it to 0
317     $args{'InitialPriority'} = $QueueObj->InitialPriority || 0
318         unless defined $args{'InitialPriority'};
319
320     #Final priority
321     # If there's no queue default final priority and it's not set, set it to 0
322     $args{'FinalPriority'} = $QueueObj->FinalPriority || 0
323         unless defined $args{'FinalPriority'};
324
325     # Priority may have changed from InitialPriority, for the case
326     # where we're importing tickets (eg, from an older RT version.)
327     $args{'Priority'} = $args{'InitialPriority'}
328         unless defined $args{'Priority'};
329
330     # {{{ Dates
331     #TODO we should see what sort of due date we're getting, rather +
332     # than assuming it's in ISO format.
333
334     #Set the due date. if we didn't get fed one, use the queue default due in
335     my $Due = new RT::Date( $self->CurrentUser );
336     if ( defined $args{'Due'} ) {
337         $Due->Set( Format => 'ISO', Value => $args{'Due'} );
338     }
339     elsif ( my $due_in = $QueueObj->DefaultDueIn ) {
340         $Due->SetToNow;
341         $Due->AddDays( $due_in );
342     }
343
344     my $Starts = new RT::Date( $self->CurrentUser );
345     if ( defined $args{'Starts'} ) {
346         $Starts->Set( Format => 'ISO', Value => $args{'Starts'} );
347     }
348
349     my $Started = new RT::Date( $self->CurrentUser );
350     if ( defined $args{'Started'} ) {
351         $Started->Set( Format => 'ISO', Value => $args{'Started'} );
352     }
353     elsif ( $args{'Status'} ne 'new' ) {
354         $Started->SetToNow;
355     }
356
357     my $Resolved = new RT::Date( $self->CurrentUser );
358     if ( defined $args{'Resolved'} ) {
359         $Resolved->Set( Format => 'ISO', Value => $args{'Resolved'} );
360     }
361
362     #If the status is an inactive status, set the resolved date
363     elsif ( $QueueObj->IsInactiveStatus( $args{'Status'} ) )
364     {
365         $RT::Logger->debug( "Got a ". $args{'Status'}
366             ."(inactive) ticket with undefined resolved date. Setting to now."
367         );
368         $Resolved->SetToNow;
369     }
370
371     # }}}
372
373     # {{{ Dealing with time fields
374
375     $args{'TimeEstimated'} = 0 unless defined $args{'TimeEstimated'};
376     $args{'TimeWorked'}    = 0 unless defined $args{'TimeWorked'};
377     $args{'TimeLeft'}      = 0 unless defined $args{'TimeLeft'};
378
379     # }}}
380
381     # {{{ Deal with setting the owner
382
383     my $Owner;
384     if ( ref( $args{'Owner'} ) eq 'RT::User' ) {
385         if ( $args{'Owner'}->id ) {
386             $Owner = $args{'Owner'};
387         } else {
388             $RT::Logger->error('passed not loaded owner object');
389             push @non_fatal_errors, $self->loc("Invalid owner object");
390             $Owner = undef;
391         }
392     }
393
394     #If we've been handed something else, try to load the user.
395     elsif ( $args{'Owner'} ) {
396         $Owner = RT::User->new( $self->CurrentUser );
397         $Owner->Load( $args{'Owner'} );
398         $Owner->LoadByEmail( $args{'Owner'} )
399             unless $Owner->Id;
400         unless ( $Owner->Id ) {
401             push @non_fatal_errors,
402                 $self->loc("Owner could not be set.") . " "
403               . $self->loc( "User '[_1]' could not be found.", $args{'Owner'} );
404             $Owner = undef;
405         }
406     }
407
408     #If we have a proposed owner and they don't have the right
409     #to own a ticket, scream about it and make them not the owner
410    
411     my $DeferOwner;  
412     if ( $Owner && $Owner->Id != $RT::Nobody->Id 
413         && !$Owner->HasRight( Object => $QueueObj, Right  => 'OwnTicket' ) )
414     {
415         $DeferOwner = $Owner;
416         $Owner = undef;
417         $RT::Logger->debug('going to deffer setting owner');
418
419     }
420
421     #If we haven't been handed a valid owner, make it nobody.
422     unless ( defined($Owner) && $Owner->Id ) {
423         $Owner = new RT::User( $self->CurrentUser );
424         $Owner->Load( $RT::Nobody->Id );
425     }
426
427     # }}}
428
429 # We attempt to load or create each of the people who might have a role for this ticket
430 # _outside_ the transaction, so we don't get into ticket creation races
431     foreach my $type ( "Cc", "AdminCc", "Requestor" ) {
432         $args{ $type } = [ $args{ $type } ] unless ref $args{ $type };
433         foreach my $watcher ( splice @{ $args{$type} } ) {
434             next unless $watcher;
435             if ( $watcher =~ /^\d+$/ ) {
436                 push @{ $args{$type} }, $watcher;
437             } else {
438                 my @addresses = RT::EmailParser->ParseEmailAddress( $watcher );
439                 foreach my $address( @addresses ) {
440                     my $user = RT::User->new( $RT::SystemUser );
441                     my ($uid, $msg) = $user->LoadOrCreateByEmail( $address );
442                     unless ( $uid ) {
443                         push @non_fatal_errors,
444                             $self->loc("Couldn't load or create user: [_1]", $msg);
445                     } else {
446                         push @{ $args{$type} }, $user->id;
447                     }
448                 }
449             }
450         }
451     }
452
453     $RT::Handle->BeginTransaction();
454
455     my %params = (
456         Queue           => $QueueObj->Id,
457         Owner           => $Owner->Id,
458         Subject         => $args{'Subject'},
459         InitialPriority => $args{'InitialPriority'},
460         FinalPriority   => $args{'FinalPriority'},
461         Priority        => $args{'Priority'},
462         Status          => $args{'Status'},
463         TimeWorked      => $args{'TimeWorked'},
464         TimeEstimated   => $args{'TimeEstimated'},
465         TimeLeft        => $args{'TimeLeft'},
466         Type            => $args{'Type'},
467         Starts          => $Starts->ISO,
468         Started         => $Started->ISO,
469         Resolved        => $Resolved->ISO,
470         Due             => $Due->ISO
471     );
472
473 # Parameters passed in during an import that we probably don't want to touch, otherwise
474     foreach my $attr qw(id Creator Created LastUpdated LastUpdatedBy) {
475         $params{$attr} = $args{$attr} if $args{$attr};
476     }
477
478     # Delete null integer parameters
479     foreach my $attr
480         qw(TimeWorked TimeLeft TimeEstimated InitialPriority FinalPriority)
481     {
482         delete $params{$attr}
483           unless ( exists $params{$attr} && $params{$attr} );
484     }
485
486     # Delete the time worked if we're counting it in the transaction
487     delete $params{'TimeWorked'} if $args{'_RecordTransaction'};
488
489     my ($id,$ticket_message) = $self->SUPER::Create( %params );
490     unless ($id) {
491         $RT::Logger->crit( "Couldn't create a ticket: " . $ticket_message );
492         $RT::Handle->Rollback();
493         return ( 0, 0,
494             $self->loc("Ticket could not be created due to an internal error")
495         );
496     }
497
498     #Set the ticket's effective ID now that we've created it.
499     my ( $val, $msg ) = $self->__Set(
500         Field => 'EffectiveId',
501         Value => ( $args{'EffectiveId'} || $id )
502     );
503     unless ( $val ) {
504         $RT::Logger->crit("Couldn't set EffectiveId: $msg");
505         $RT::Handle->Rollback;
506         return ( 0, 0,
507             $self->loc("Ticket could not be created due to an internal error")
508         );
509     }
510
511     my $create_groups_ret = $self->_CreateTicketGroups();
512     unless ($create_groups_ret) {
513         $RT::Logger->crit( "Couldn't create ticket groups for ticket "
514               . $self->Id
515               . ". aborting Ticket creation." );
516         $RT::Handle->Rollback();
517         return ( 0, 0,
518             $self->loc("Ticket could not be created due to an internal error")
519         );
520     }
521
522     # Set the owner in the Groups table
523     # We denormalize it into the Ticket table too because doing otherwise would
524     # kill performance, bigtime. It gets kept in lockstep thanks to the magic of transactionalization
525     $self->OwnerGroup->_AddMember(
526         PrincipalId       => $Owner->PrincipalId,
527         InsideTransaction => 1
528     ) unless $DeferOwner;
529
530
531
532     # {{{ Deal with setting up watchers
533
534     foreach my $type ( "Cc", "AdminCc", "Requestor" ) {
535         # we know it's an array ref
536         foreach my $watcher ( @{ $args{$type} } ) {
537
538             # Note that we're using AddWatcher, rather than _AddWatcher, as we
539             # actually _want_ that ACL check. Otherwise, random ticket creators
540             # could make themselves adminccs and maybe get ticket rights. that would
541             # be poor
542             my $method = $type eq 'AdminCc'? 'AddWatcher': '_AddWatcher';
543
544             my ($val, $msg) = $self->$method(
545                 Type   => $type,
546                 PrincipalId => $watcher,
547                 Silent => 1,
548             );
549             push @non_fatal_errors, $self->loc("Couldn't set [_1] watcher: [_2]", $type, $msg)
550                 unless $val;
551         }
552     } 
553
554     if ($args{'SquelchMailTo'}) {
555        my @squelch = ref( $args{'SquelchMailTo'} ) ? @{ $args{'SquelchMailTo'} }
556         : $args{'SquelchMailTo'};
557         $self->_SquelchMailTo( @squelch );
558     }
559
560
561     # }}}
562
563     # {{{ Add all the custom fields
564
565     foreach my $arg ( keys %args ) {
566         next unless $arg =~ /^CustomField-(\d+)$/i;
567         my $cfid = $1;
568
569         foreach my $value (
570             UNIVERSAL::isa( $args{$arg} => 'ARRAY' ) ? @{ $args{$arg} } : ( $args{$arg} ) )
571         {
572             next unless defined $value && length $value;
573
574             # Allow passing in uploaded LargeContent etc by hash reference
575             my ($status, $msg) = $self->_AddCustomFieldValue(
576                 (UNIVERSAL::isa( $value => 'HASH' )
577                     ? %$value
578                     : (Value => $value)
579                 ),
580                 Field             => $cfid,
581                 RecordTransaction => 0,
582             );
583             push @non_fatal_errors, $msg unless $status;
584         }
585     }
586
587     # }}}
588
589     # {{{ Deal with setting up links
590
591     # TODO: Adding link may fire scrips on other end and those scrips
592     # could create transactions on this ticket before 'Create' transaction.
593     #
594     # We should implement different schema: record 'Create' transaction,
595     # create links and only then fire create transaction's scrips.
596     #
597     # Ideal variant: add all links without firing scrips, record create
598     # transaction and only then fire scrips on the other ends of links.
599     #
600     # //RUZ
601
602     foreach my $type ( keys %LINKTYPEMAP ) {
603         next unless ( defined $args{$type} );
604         foreach my $link (
605             ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
606         {
607             # Check rights on the other end of the link if we must
608             # then run _AddLink that doesn't check for ACLs
609             if ( RT->Config->Get( 'StrictLinkACL' ) ) {
610                 my ($val, $msg, $obj) = $self->__GetTicketFromURI( URI => $link );
611                 unless ( $val ) {
612                     push @non_fatal_errors, $msg;
613                     next;
614                 }
615                 if ( $obj && !$obj->CurrentUserHasRight('ModifyTicket') ) {
616                     push @non_fatal_errors, $self->loc('Linking. Permission denied');
617                     next;
618                 }
619             }
620             
621             my ( $wval, $wmsg ) = $self->_AddLink(
622                 Type                          => $LINKTYPEMAP{$type}->{'Type'},
623                 $LINKTYPEMAP{$type}->{'Mode'} => $link,
624                 Silent                        => !$args{'_RecordTransaction'},
625                 'Silent'. ( $LINKTYPEMAP{$type}->{'Mode'} eq 'Base'? 'Target': 'Base' )
626                                               => 1,
627             );
628
629             push @non_fatal_errors, $wmsg unless ($wval);
630         }
631     }
632
633     # }}}
634     # Now that we've created the ticket and set up its metadata, we can actually go and check OwnTicket on the ticket itself. 
635     # This might be different than before in cases where extensions like RTIR are doing clever things with RT's ACL system
636     if (  $DeferOwner ) { 
637             if (!$DeferOwner->HasRight( Object => $self, Right  => 'OwnTicket')) {
638     
639             $RT::Logger->warning( "User " . $DeferOwner->Name . "(" . $DeferOwner->id 
640                 . ") was proposed as a ticket owner but has no rights to own "
641                 . "tickets in " . $QueueObj->Name );
642             push @non_fatal_errors, $self->loc(
643                 "Owner '[_1]' does not have rights to own this ticket.",
644                 $DeferOwner->Name
645             );
646         } else {
647             $Owner = $DeferOwner;
648             $self->__Set(Field => 'Owner', Value => $Owner->id);
649
650         }
651         $self->OwnerGroup->_AddMember(
652             PrincipalId       => $Owner->PrincipalId,
653             InsideTransaction => 1
654         );
655     }
656
657     if ( $args{'_RecordTransaction'} ) {
658
659         # {{{ Add a transaction for the create
660         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
661             Type         => "Create",
662             TimeTaken    => $args{'TimeWorked'},
663             MIMEObj      => $args{'MIMEObj'},
664             CommitScrips => !$args{'DryRun'},
665         );
666
667         if ( $self->Id && $Trans ) {
668
669             $TransObj->UpdateCustomFields(ARGSRef => \%args);
670
671             $RT::Logger->info( "Ticket " . $self->Id . " created in queue '" . $QueueObj->Name . "' by " . $self->CurrentUser->Name );
672             $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name );
673             $ErrStr = join( "\n", $ErrStr, @non_fatal_errors );
674         }
675         else {
676             $RT::Handle->Rollback();
677
678             $ErrStr = join( "\n", $ErrStr, @non_fatal_errors );
679             $RT::Logger->error("Ticket couldn't be created: $ErrStr");
680             return ( 0, 0, $self->loc( "Ticket could not be created due to an internal error"));
681         }
682
683         if ( $args{'DryRun'} ) {
684             $RT::Handle->Rollback();
685             return ($self->id, $TransObj, $ErrStr);
686         }
687         $RT::Handle->Commit();
688         return ( $self->Id, $TransObj->Id, $ErrStr );
689
690         # }}}
691     }
692     else {
693
694         # Not going to record a transaction
695         $RT::Handle->Commit();
696         $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name );
697         $ErrStr = join( "\n", $ErrStr, @non_fatal_errors );
698         return ( $self->Id, 0, $ErrStr );
699
700     }
701 }
702
703
704 # }}}
705
706 # {{{ _Parse822HeadersForAttributes Content
707
708 =head2 _Parse822HeadersForAttributes Content
709
710 Takes an RFC822 style message and parses its attributes into a hash.
711
712 =cut
713
714 sub _Parse822HeadersForAttributes {
715     my $self    = shift;
716     my $content = shift;
717     my %args;
718
719     my @lines = ( split ( /\n/, $content ) );
720     while ( defined( my $line = shift @lines ) ) {
721         if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) {
722             my $value = $2;
723             my $tag   = lc($1);
724
725             $tag =~ s/-//g;
726             if ( defined( $args{$tag} ) )
727             {    #if we're about to get a second value, make it an array
728                 $args{$tag} = [ $args{$tag} ];
729             }
730             if ( ref( $args{$tag} ) )
731             {    #If it's an array, we want to push the value
732                 push @{ $args{$tag} }, $value;
733             }
734             else {    #if there's nothing there, just set the value
735                 $args{$tag} = $value;
736             }
737         } elsif ($line =~ /^$/) {
738
739             #TODO: this won't work, since "" isn't of the form "foo:value"
740
741                 while ( defined( my $l = shift @lines ) ) {
742                     push @{ $args{'content'} }, $l;
743                 }
744             }
745         
746     }
747
748     foreach my $date qw(due starts started resolved) {
749         my $dateobj = RT::Date->new($RT::SystemUser);
750         if ( defined ($args{$date}) and $args{$date} =~ /^\d+$/ ) {
751             $dateobj->Set( Format => 'unix', Value => $args{$date} );
752         }
753         else {
754             $dateobj->Set( Format => 'unknown', Value => $args{$date} );
755         }
756         $args{$date} = $dateobj->ISO;
757     }
758     $args{'mimeobj'} = MIME::Entity->new();
759     $args{'mimeobj'}->build(
760         Type => ( $args{'contenttype'} || 'text/plain' ),
761         Data => ($args{'content'} || '')
762     );
763
764     return (%args);
765 }
766
767 # }}}
768
769 # {{{ sub Import
770
771 =head2 Import PARAMHASH
772
773 Import a ticket. 
774 Doesn\'t create a transaction. 
775 Doesn\'t supply queue defaults, etc.
776
777 Returns: TICKETID
778
779 =cut
780
781 sub Import {
782     my $self = shift;
783     my ( $ErrStr, $QueueObj, $Owner );
784
785     my %args = (
786         id              => undef,
787         EffectiveId     => undef,
788         Queue           => undef,
789         Requestor       => undef,
790         Type            => 'ticket',
791         Owner           => $RT::Nobody->Id,
792         Subject         => '[no subject]',
793         InitialPriority => undef,
794         FinalPriority   => undef,
795         Status          => 'new',
796         TimeWorked      => "0",
797         Due             => undef,
798         Created         => undef,
799         Updated         => undef,
800         Resolved        => undef,
801         Told            => undef,
802         @_
803     );
804
805     if ( ( defined( $args{'Queue'} ) ) && ( !ref( $args{'Queue'} ) ) ) {
806         $QueueObj = RT::Queue->new($RT::SystemUser);
807         $QueueObj->Load( $args{'Queue'} );
808
809         #TODO error check this and return 0 if it\'s not loading properly +++
810     }
811     elsif ( ref( $args{'Queue'} ) eq 'RT::Queue' ) {
812         $QueueObj = RT::Queue->new($RT::SystemUser);
813         $QueueObj->Load( $args{'Queue'}->Id );
814     }
815     else {
816         $RT::Logger->debug(
817             "$self " . $args{'Queue'} . " not a recognised queue object." );
818     }
819
820     #Can't create a ticket without a queue.
821     unless ( defined($QueueObj) and $QueueObj->Id ) {
822         $RT::Logger->debug("$self No queue given for ticket creation.");
823         return ( 0, $self->loc('Could not create ticket. Queue not set') );
824     }
825
826     #Now that we have a queue, Check the ACLS
827     unless (
828         $self->CurrentUser->HasRight(
829             Right    => 'CreateTicket',
830             Object => $QueueObj
831         )
832       )
833     {
834         return ( 0,
835             $self->loc("No permission to create tickets in the queue '[_1]'"
836               , $QueueObj->Name));
837     }
838
839     # {{{ Deal with setting the owner
840
841     # Attempt to take user object, user name or user id.
842     # Assign to nobody if lookup fails.
843     if ( defined( $args{'Owner'} ) ) {
844         if ( ref( $args{'Owner'} ) ) {
845             $Owner = $args{'Owner'};
846         }
847         else {
848             $Owner = new RT::User( $self->CurrentUser );
849             $Owner->Load( $args{'Owner'} );
850             if ( !defined( $Owner->id ) ) {
851                 $Owner->Load( $RT::Nobody->id );
852             }
853         }
854     }
855
856     #If we have a proposed owner and they don't have the right 
857     #to own a ticket, scream about it and make them not the owner
858     if (
859         ( defined($Owner) )
860         and ( $Owner->Id != $RT::Nobody->Id )
861         and (
862             !$Owner->HasRight(
863                 Object => $QueueObj,
864                 Right    => 'OwnTicket'
865             )
866         )
867       )
868     {
869
870         $RT::Logger->warning( "$self user "
871               . $Owner->Name . "("
872               . $Owner->id
873               . ") was proposed "
874               . "as a ticket owner but has no rights to own "
875               . "tickets in '"
876               . $QueueObj->Name . "'" );
877
878         $Owner = undef;
879     }
880
881     #If we haven't been handed a valid owner, make it nobody.
882     unless ( defined($Owner) ) {
883         $Owner = new RT::User( $self->CurrentUser );
884         $Owner->Load( $RT::Nobody->UserObj->Id );
885     }
886
887     # }}}
888
889     unless ( $self->ValidateStatus( $args{'Status'} ) ) {
890         return ( 0, $self->loc("'[_1]' is an invalid value for status", $args{'Status'}) );
891     }
892
893     $self->{'_AccessibleCache'}{Created}       = { 'read' => 1, 'write' => 1 };
894     $self->{'_AccessibleCache'}{Creator}       = { 'read' => 1, 'auto'  => 1 };
895     $self->{'_AccessibleCache'}{LastUpdated}   = { 'read' => 1, 'write' => 1 };
896     $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read' => 1, 'auto'  => 1 };
897
898     # If we're coming in with an id, set that now.
899     my $EffectiveId = undef;
900     if ( $args{'id'} ) {
901         $EffectiveId = $args{'id'};
902
903     }
904
905     my $id = $self->SUPER::Create(
906         id              => $args{'id'},
907         EffectiveId     => $EffectiveId,
908         Queue           => $QueueObj->Id,
909         Owner           => $Owner->Id,
910         Subject         => $args{'Subject'},        # loc
911         InitialPriority => $args{'InitialPriority'},    # loc
912         FinalPriority   => $args{'FinalPriority'},    # loc
913         Priority        => $args{'InitialPriority'},    # loc
914         Status          => $args{'Status'},        # loc
915         TimeWorked      => $args{'TimeWorked'},        # loc
916         Type            => $args{'Type'},        # loc
917         Created         => $args{'Created'},        # loc
918         Told            => $args{'Told'},        # loc
919         LastUpdated     => $args{'Updated'},        # loc
920         Resolved        => $args{'Resolved'},        # loc
921         Due             => $args{'Due'},        # loc
922     );
923
924     # If the ticket didn't have an id
925     # Set the ticket's effective ID now that we've created it.
926     if ( $args{'id'} ) {
927         $self->Load( $args{'id'} );
928     }
929     else {
930         my ( $val, $msg ) =
931           $self->__Set( Field => 'EffectiveId', Value => $id );
932
933         unless ($val) {
934             $RT::Logger->err(
935                 $self . "->Import couldn't set EffectiveId: $msg" );
936         }
937     }
938
939     my $create_groups_ret = $self->_CreateTicketGroups();
940     unless ($create_groups_ret) {
941         $RT::Logger->crit(
942             "Couldn't create ticket groups for ticket " . $self->Id );
943     }
944
945     $self->OwnerGroup->_AddMember( PrincipalId => $Owner->PrincipalId );
946
947     foreach my $watcher ( @{ $args{'Cc'} } ) {
948         $self->_AddWatcher( Type => 'Cc', Email => $watcher, Silent => 1 );
949     }
950     foreach my $watcher ( @{ $args{'AdminCc'} } ) {
951         $self->_AddWatcher( Type => 'AdminCc', Email => $watcher,
952             Silent => 1 );
953     }
954     foreach my $watcher ( @{ $args{'Requestor'} } ) {
955         $self->_AddWatcher( Type => 'Requestor', Email => $watcher,
956             Silent => 1 );
957     }
958
959     return ( $self->Id, $ErrStr );
960 }
961
962 # }}}
963
964 # {{{ Routines dealing with watchers.
965
966 # {{{ _CreateTicketGroups 
967
968 =head2 _CreateTicketGroups
969
970 Create the ticket groups and links for this ticket. 
971 This routine expects to be called from Ticket->Create _inside of a transaction_
972
973 It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner.
974
975 It will return true on success and undef on failure.
976
977
978 =cut
979
980
981 sub _CreateTicketGroups {
982     my $self = shift;
983     
984     my @types = qw(Requestor Owner Cc AdminCc);
985
986     foreach my $type (@types) {
987         my $type_obj = RT::Group->new($self->CurrentUser);
988         my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role',
989                                                        Instance => $self->Id, 
990                                                        Type => $type);
991         unless ($id) {
992             $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ".
993                                $self->Id.": ".$msg);     
994             return(undef);
995         }
996      }
997     return(1);
998     
999 }
1000
1001 # }}}
1002
1003 # {{{ sub OwnerGroup
1004
1005 =head2 OwnerGroup
1006
1007 A constructor which returns an RT::Group object containing the owner of this ticket.
1008
1009 =cut
1010
1011 sub OwnerGroup {
1012     my $self = shift;
1013     my $owner_obj = RT::Group->new($self->CurrentUser);
1014     $owner_obj->LoadTicketRoleGroup( Ticket => $self->Id,  Type => 'Owner');
1015     return ($owner_obj);
1016 }
1017
1018 # }}}
1019
1020
1021 # {{{ sub AddWatcher
1022
1023 =head2 AddWatcher
1024
1025 AddWatcher takes a parameter hash. The keys are as follows:
1026
1027 Type        One of Requestor, Cc, AdminCc
1028
1029 PrincipalId The RT::Principal id of the user or group that's being added as a watcher
1030
1031 Email       The email address of the new watcher. If a user with this 
1032             email address can't be found, a new nonprivileged user will be created.
1033
1034 If the watcher you\'re trying to set has an RT account, set the PrincipalId paremeter to their User Id. Otherwise, set the Email parameter to their Email address.
1035
1036 =cut
1037
1038 sub AddWatcher {
1039     my $self = shift;
1040     my %args = (
1041         Type  => undef,
1042         PrincipalId => undef,
1043         Email => undef,
1044         @_
1045     );
1046
1047     # ModifyTicket works in any case
1048     return $self->_AddWatcher( %args )
1049         if $self->CurrentUserHasRight('ModifyTicket');
1050     if ( $args{'Email'} ) {
1051         my ($addr) = RT::EmailParser->ParseEmailAddress( $args{'Email'} );
1052         return (0, $self->loc("Couldn't parse address from '[_1]' string", $args{'Email'} ))
1053             unless $addr;
1054
1055         if ( lc $self->CurrentUser->UserObj->EmailAddress
1056             eq lc RT::User->CanonicalizeEmailAddress( $addr->address ) )
1057         {
1058             $args{'PrincipalId'} = $self->CurrentUser->id;
1059             delete $args{'Email'};
1060         }
1061     }
1062
1063     # If the watcher isn't the current user then the current user has no right
1064     # bail
1065     unless ( $args{'PrincipalId'} && $self->CurrentUser->id == $args{'PrincipalId'} ) {
1066         return ( 0, $self->loc("Permission Denied") );
1067     }
1068
1069     #  If it's an AdminCc and they don't have 'WatchAsAdminCc', bail
1070     if ( $args{'Type'} eq 'AdminCc' ) {
1071         unless ( $self->CurrentUserHasRight('WatchAsAdminCc') ) {
1072             return ( 0, $self->loc('Permission Denied') );
1073         }
1074     }
1075
1076     #  If it's a Requestor or Cc and they don't have 'Watch', bail
1077     elsif ( $args{'Type'} eq 'Cc' || $args{'Type'} eq 'Requestor' ) {
1078         unless ( $self->CurrentUserHasRight('Watch') ) {
1079             return ( 0, $self->loc('Permission Denied') );
1080         }
1081     }
1082     else {
1083         $RT::Logger->warning( "AddWatcher got passed a bogus type");
1084         return ( 0, $self->loc('Error in parameters to Ticket->AddWatcher') );
1085     }
1086
1087     return $self->_AddWatcher( %args );
1088 }
1089
1090 #This contains the meat of AddWatcher. but can be called from a routine like
1091 # Create, which doesn't need the additional acl check
1092 sub _AddWatcher {
1093     my $self = shift;
1094     my %args = (
1095         Type   => undef,
1096         Silent => undef,
1097         PrincipalId => undef,
1098         Email => undef,
1099         @_
1100     );
1101
1102
1103     my $principal = RT::Principal->new($self->CurrentUser);
1104     if ($args{'Email'}) {
1105         if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) {
1106             return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $args{'Email'}, $self->loc($args{'Type'})));
1107         }
1108         my $user = RT::User->new($RT::SystemUser);
1109         my ($pid, $msg) = $user->LoadOrCreateByEmail( $args{'Email'} );
1110         $args{'PrincipalId'} = $pid if $pid; 
1111     }
1112     if ($args{'PrincipalId'}) {
1113         $principal->Load($args{'PrincipalId'});
1114         if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) {
1115             return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email, $self->loc($args{'Type'})))
1116                 if RT::EmailParser->IsRTAddress( $email );
1117
1118         }
1119     } 
1120
1121  
1122     # If we can't find this watcher, we need to bail.
1123     unless ($principal->Id) {
1124             $RT::Logger->error("Could not load create a user with the email address '".$args{'Email'}. "' to add as a watcher for ticket ".$self->Id);
1125         return(0, $self->loc("Could not find or create that user"));
1126     }
1127
1128
1129     my $group = RT::Group->new($self->CurrentUser);
1130     $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->Id);
1131     unless ($group->id) {
1132         return(0,$self->loc("Group not found"));
1133     }
1134
1135     if ( $group->HasMember( $principal)) {
1136
1137         return ( 0, $self->loc('That principal is already a [_1] for this ticket', $self->loc($args{'Type'})) );
1138     }
1139
1140
1141     my ( $m_id, $m_msg ) = $group->_AddMember( PrincipalId => $principal->Id,
1142                                                InsideTransaction => 1 );
1143     unless ($m_id) {
1144         $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg);
1145
1146         return ( 0, $self->loc('Could not make that principal a [_1] for this ticket', $self->loc($args{'Type'})) );
1147     }
1148
1149     unless ( $args{'Silent'} ) {
1150         $self->_NewTransaction(
1151             Type     => 'AddWatcher',
1152             NewValue => $principal->Id,
1153             Field    => $args{'Type'}
1154         );
1155     }
1156
1157         return ( 1, $self->loc('Added principal as a [_1] for this ticket', $self->loc($args{'Type'})) );
1158 }
1159
1160 # }}}
1161
1162
1163 # {{{ sub DeleteWatcher
1164
1165 =head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS }
1166
1167
1168 Deletes a Ticket watcher.  Takes two arguments:
1169
1170 Type  (one of Requestor,Cc,AdminCc)
1171
1172 and one of
1173
1174 PrincipalId (an RT::Principal Id of the watcher you want to remove)
1175     OR
1176 Email (the email address of an existing wathcer)
1177
1178
1179 =cut
1180
1181
1182 sub DeleteWatcher {
1183     my $self = shift;
1184
1185     my %args = ( Type        => undef,
1186                  PrincipalId => undef,
1187                  Email       => undef,
1188                  @_ );
1189
1190     unless ( $args{'PrincipalId'} || $args{'Email'} ) {
1191         return ( 0, $self->loc("No principal specified") );
1192     }
1193     my $principal = RT::Principal->new( $self->CurrentUser );
1194     if ( $args{'PrincipalId'} ) {
1195
1196         $principal->Load( $args{'PrincipalId'} );
1197     }
1198     else {
1199         my $user = RT::User->new( $self->CurrentUser );
1200         $user->LoadByEmail( $args{'Email'} );
1201         $principal->Load( $user->Id );
1202     }
1203
1204     # If we can't find this watcher, we need to bail.
1205     unless ( $principal->Id ) {
1206         return ( 0, $self->loc("Could not find that principal") );
1207     }
1208
1209     my $group = RT::Group->new( $self->CurrentUser );
1210     $group->LoadTicketRoleGroup( Type => $args{'Type'}, Ticket => $self->Id );
1211     unless ( $group->id ) {
1212         return ( 0, $self->loc("Group not found") );
1213     }
1214
1215     # {{{ Check ACLS
1216     #If the watcher we're trying to add is for the current user
1217     if ( $self->CurrentUser->PrincipalId == $principal->id ) {
1218
1219         #  If it's an AdminCc and they don't have
1220         #   'WatchAsAdminCc' or 'ModifyTicket', bail
1221         if ( $args{'Type'} eq 'AdminCc' ) {
1222             unless (    $self->CurrentUserHasRight('ModifyTicket')
1223                      or $self->CurrentUserHasRight('WatchAsAdminCc') ) {
1224                 return ( 0, $self->loc('Permission Denied') );
1225             }
1226         }
1227
1228         #  If it's a Requestor or Cc and they don't have
1229         #   'Watch' or 'ModifyTicket', bail
1230         elsif ( ( $args{'Type'} eq 'Cc' ) or ( $args{'Type'} eq 'Requestor' ) )
1231         {
1232             unless (    $self->CurrentUserHasRight('ModifyTicket')
1233                      or $self->CurrentUserHasRight('Watch') ) {
1234                 return ( 0, $self->loc('Permission Denied') );
1235             }
1236         }
1237         else {
1238             $RT::Logger->warn("$self -> DeleteWatcher got passed a bogus type");
1239             return ( 0,
1240                      $self->loc('Error in parameters to Ticket->DeleteWatcher') );
1241         }
1242     }
1243
1244     # If the watcher isn't the current user
1245     # and the current user  doesn't have 'ModifyTicket' bail
1246     else {
1247         unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1248             return ( 0, $self->loc("Permission Denied") );
1249         }
1250     }
1251
1252     # }}}
1253
1254     # see if this user is already a watcher.
1255
1256     unless ( $group->HasMember($principal) ) {
1257         return ( 0,
1258                  $self->loc( 'That principal is not a [_1] for this ticket',
1259                              $args{'Type'} ) );
1260     }
1261
1262     my ( $m_id, $m_msg ) = $group->_DeleteMember( $principal->Id );
1263     unless ($m_id) {
1264         $RT::Logger->error( "Failed to delete "
1265                             . $principal->Id
1266                             . " as a member of group "
1267                             . $group->Id . ": "
1268                             . $m_msg );
1269
1270         return (0,
1271                 $self->loc(
1272                     'Could not remove that principal as a [_1] for this ticket',
1273                     $args{'Type'} ) );
1274     }
1275
1276     unless ( $args{'Silent'} ) {
1277         $self->_NewTransaction( Type     => 'DelWatcher',
1278                                 OldValue => $principal->Id,
1279                                 Field    => $args{'Type'} );
1280     }
1281
1282     return ( 1,
1283              $self->loc( "[_1] is no longer a [_2] for this ticket.",
1284                          $principal->Object->Name,
1285                          $args{'Type'} ) );
1286 }
1287
1288
1289
1290 # }}}
1291
1292
1293 =head2 SquelchMailTo [EMAIL]
1294
1295 Takes an optional email address to never email about updates to this ticket.
1296
1297
1298 Returns an array of the RT::Attribute objects for this ticket's 'SquelchMailTo' attributes.
1299
1300
1301 =cut
1302
1303 sub SquelchMailTo {
1304     my $self = shift;
1305     if (@_) {
1306         unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1307             return undef;
1308         }
1309     } else {
1310         unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1311             return undef;
1312         }
1313
1314     }
1315     return $self->_SquelchMailTo(@_);
1316 }
1317
1318 sub _SquelchMailTo {
1319     my $self = shift;
1320     if (@_) {
1321         my $attr = shift;
1322         $self->AddAttribute( Name => 'SquelchMailTo', Content => $attr )
1323             unless grep { $_->Content eq $attr }
1324                 $self->Attributes->Named('SquelchMailTo');
1325     }
1326     my @attributes = $self->Attributes->Named('SquelchMailTo');
1327     return (@attributes);
1328 }
1329
1330
1331 =head2 UnsquelchMailTo ADDRESS
1332
1333 Takes an address and removes it from this ticket's "SquelchMailTo" list. If an address appears multiple times, each instance is removed.
1334
1335 Returns a tuple of (status, message)
1336
1337 =cut
1338
1339 sub UnsquelchMailTo {
1340     my $self = shift;
1341
1342     my $address = shift;
1343     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1344         return ( 0, $self->loc("Permission Denied") );
1345     }
1346
1347     my ($val, $msg) = $self->Attributes->DeleteEntry ( Name => 'SquelchMailTo', Content => $address);
1348     return ($val, $msg);
1349 }
1350
1351
1352 # {{{ a set of  [foo]AsString subs that will return the various sorts of watchers for a ticket/queue as a comma delineated string
1353
1354 =head2 RequestorAddresses
1355
1356  B<Returns> String: All Ticket Requestor email addresses as a string.
1357
1358 =cut
1359
1360 sub RequestorAddresses {
1361     my $self = shift;
1362
1363     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1364         return undef;
1365     }
1366
1367     return ( $self->Requestors->MemberEmailAddressesAsString );
1368 }
1369
1370
1371 =head2 AdminCcAddresses
1372
1373 returns String: All Ticket AdminCc email addresses as a string
1374
1375 =cut
1376
1377 sub AdminCcAddresses {
1378     my $self = shift;
1379
1380     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1381         return undef;
1382     }
1383
1384     return ( $self->AdminCc->MemberEmailAddressesAsString )
1385
1386 }
1387
1388 =head2 CcAddresses
1389
1390 returns String: All Ticket Ccs as a string of email addresses
1391
1392 =cut
1393
1394 sub CcAddresses {
1395     my $self = shift;
1396
1397     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1398         return undef;
1399     }
1400     return ( $self->Cc->MemberEmailAddressesAsString);
1401
1402 }
1403
1404 # }}}
1405
1406 # {{{ Routines that return RT::Watchers objects of Requestors, Ccs and AdminCcs
1407
1408 # {{{ sub Requestors
1409
1410 =head2 Requestors
1411
1412 Takes nothing.
1413 Returns this ticket's Requestors as an RT::Group object
1414
1415 =cut
1416
1417 sub Requestors {
1418     my $self = shift;
1419
1420     my $group = RT::Group->new($self->CurrentUser);
1421     if ( $self->CurrentUserHasRight('ShowTicket') ) {
1422         $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id);
1423     }
1424     return ($group);
1425
1426 }
1427
1428 # }}}
1429
1430 # {{{ sub Cc
1431
1432 =head2 Cc
1433
1434 Takes nothing.
1435 Returns an RT::Group object which contains this ticket's Ccs.
1436 If the user doesn't have "ShowTicket" permission, returns an empty group
1437
1438 =cut
1439
1440 sub Cc {
1441     my $self = shift;
1442
1443     my $group = RT::Group->new($self->CurrentUser);
1444     if ( $self->CurrentUserHasRight('ShowTicket') ) {
1445         $group->LoadTicketRoleGroup(Type => 'Cc', Ticket => $self->Id);
1446     }
1447     return ($group);
1448
1449 }
1450
1451 # }}}
1452
1453 # {{{ sub AdminCc
1454
1455 =head2 AdminCc
1456
1457 Takes nothing.
1458 Returns an RT::Group object which contains this ticket's AdminCcs.
1459 If the user doesn't have "ShowTicket" permission, returns an empty group
1460
1461 =cut
1462
1463 sub AdminCc {
1464     my $self = shift;
1465
1466     my $group = RT::Group->new($self->CurrentUser);
1467     if ( $self->CurrentUserHasRight('ShowTicket') ) {
1468         $group->LoadTicketRoleGroup(Type => 'AdminCc', Ticket => $self->Id);
1469     }
1470     return ($group);
1471
1472 }
1473
1474 # }}}
1475
1476 # }}}
1477
1478 # {{{ IsWatcher,IsRequestor,IsCc, IsAdminCc
1479
1480 # {{{ sub IsWatcher
1481 # a generic routine to be called by IsRequestor, IsCc and IsAdminCc
1482
1483 =head2 IsWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL }
1484
1485 Takes a param hash with the attributes Type and either PrincipalId or Email
1486
1487 Type is one of Requestor, Cc, AdminCc and Owner
1488
1489 PrincipalId is an RT::Principal id, and Email is an email address.
1490
1491 Returns true if the specified principal (or the one corresponding to the
1492 specified address) is a member of the group Type for this ticket.
1493
1494 XX TODO: This should be Memoized. 
1495
1496 =cut
1497
1498 sub IsWatcher {
1499     my $self = shift;
1500
1501     my %args = ( Type  => 'Requestor',
1502         PrincipalId    => undef,
1503         Email          => undef,
1504         @_
1505     );
1506
1507     # Load the relevant group. 
1508     my $group = RT::Group->new($self->CurrentUser);
1509     $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->id);
1510
1511     # Find the relevant principal.
1512     if (!$args{PrincipalId} && $args{Email}) {
1513         # Look up the specified user.
1514         my $user = RT::User->new($self->CurrentUser);
1515         $user->LoadByEmail($args{Email});
1516         if ($user->Id) {
1517             $args{PrincipalId} = $user->PrincipalId;
1518         }
1519         else {
1520             # A non-existent user can't be a group member.
1521             return 0;
1522         }
1523     }
1524
1525     # Ask if it has the member in question
1526     return $group->HasMember( $args{'PrincipalId'} );
1527 }
1528
1529 # }}}
1530
1531 # {{{ sub IsRequestor
1532
1533 =head2 IsRequestor PRINCIPAL_ID
1534   
1535 Takes an L<RT::Principal> id.
1536
1537 Returns true if the principal is a requestor of the current ticket.
1538
1539 =cut
1540
1541 sub IsRequestor {
1542     my $self   = shift;
1543     my $person = shift;
1544
1545     return ( $self->IsWatcher( Type => 'Requestor', PrincipalId => $person ) );
1546
1547 };
1548
1549 # }}}
1550
1551 # {{{ sub IsCc
1552
1553 =head2 IsCc PRINCIPAL_ID
1554
1555   Takes an RT::Principal id.
1556   Returns true if the principal is a Cc of the current ticket.
1557
1558
1559 =cut
1560
1561 sub IsCc {
1562     my $self = shift;
1563     my $cc   = shift;
1564
1565     return ( $self->IsWatcher( Type => 'Cc', PrincipalId => $cc ) );
1566
1567 }
1568
1569 # }}}
1570
1571 # {{{ sub IsAdminCc
1572
1573 =head2 IsAdminCc PRINCIPAL_ID
1574
1575   Takes an RT::Principal id.
1576   Returns true if the principal is an AdminCc of the current ticket.
1577
1578 =cut
1579
1580 sub IsAdminCc {
1581     my $self   = shift;
1582     my $person = shift;
1583
1584     return ( $self->IsWatcher( Type => 'AdminCc', PrincipalId => $person ) );
1585
1586 }
1587
1588 # }}}
1589
1590 # {{{ sub IsOwner
1591
1592 =head2 IsOwner
1593
1594   Takes an RT::User object. Returns true if that user is this ticket's owner.
1595 returns undef otherwise
1596
1597 =cut
1598
1599 sub IsOwner {
1600     my $self   = shift;
1601     my $person = shift;
1602
1603     # no ACL check since this is used in acl decisions
1604     # unless ($self->CurrentUserHasRight('ShowTicket')) {
1605     #    return(undef);
1606     #   }    
1607
1608     #Tickets won't yet have owners when they're being created.
1609     unless ( $self->OwnerObj->id ) {
1610         return (undef);
1611     }
1612
1613     if ( $person->id == $self->OwnerObj->id ) {
1614         return (1);
1615     }
1616     else {
1617         return (undef);
1618     }
1619 }
1620
1621 # }}}
1622
1623 # }}}
1624
1625 # }}}
1626
1627
1628 =head2 TransactionAddresses
1629
1630 Returns a composite hashref of the results of L<RT::Transaction/Addresses> for
1631 all this ticket's Create, Comment or Correspond transactions. The keys are
1632 stringified email addresses. Each value is an L<Email::Address> object.
1633
1634 NOTE: For performance reasons, this method might want to skip transactions and go straight for attachments. But to make that work right, we're going to need to go and walk around the access control in Attachment.pm's sub _Value.
1635
1636 =cut
1637
1638
1639 sub TransactionAddresses {
1640     my $self = shift;
1641     my $txns = $self->Transactions;
1642
1643     my %addresses = ();
1644     foreach my $type (qw(Create Comment Correspond)) {
1645     $txns->Limit(FIELD => 'Type', OPERATOR => '=', VALUE => $type , ENTRYAGGREGATOR => 'OR', CASESENSITIVE => 1);
1646         }
1647
1648     while (my $txn = $txns->Next) {
1649         my $txnaddrs = $txn->Addresses; 
1650         foreach my $addrlist ( values %$txnaddrs ) {
1651                 foreach my $addr (@$addrlist) {
1652                     # Skip addresses without a phrase (things that are just raw addresses) if we have a phrase
1653                     next if ($addresses{$addr->address} && $addresses{$addr->address}->phrase && not $addr->phrase);
1654                     # skips "comment-only" addresses
1655                     next unless ($addr->address);
1656                     $addresses{$addr->address} = $addr;
1657                 }
1658         }
1659     }
1660
1661     return \%addresses;
1662
1663 }
1664
1665
1666
1667
1668 # {{{ Routines dealing with queues 
1669
1670 # {{{ sub ValidateQueue
1671
1672 sub ValidateQueue {
1673     my $self  = shift;
1674     my $Value = shift;
1675
1676     if ( !$Value ) {
1677         $RT::Logger->warning( " RT:::Queue::ValidateQueue called with a null value. this isn't ok.");
1678         return (1);
1679     }
1680
1681     my $QueueObj = RT::Queue->new( $self->CurrentUser );
1682     my $id       = $QueueObj->Load($Value);
1683
1684     if ($id) {
1685         return (1);
1686     }
1687     else {
1688         return (undef);
1689     }
1690 }
1691
1692 # }}}
1693
1694 # {{{ sub SetQueue  
1695
1696 sub SetQueue {
1697     my $self     = shift;
1698     my $NewQueue = shift;
1699
1700     #Redundant. ACL gets checked in _Set;
1701     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1702         return ( 0, $self->loc("Permission Denied") );
1703     }
1704
1705     my $NewQueueObj = RT::Queue->new( $self->CurrentUser );
1706     $NewQueueObj->Load($NewQueue);
1707
1708     unless ( $NewQueueObj->Id() ) {
1709         return ( 0, $self->loc("That queue does not exist") );
1710     }
1711
1712     if ( $NewQueueObj->Id == $self->QueueObj->Id ) {
1713         return ( 0, $self->loc('That is the same value') );
1714     }
1715     unless (
1716         $self->CurrentUser->HasRight(
1717             Right    => 'CreateTicket',
1718             Object => $NewQueueObj
1719         )
1720       )
1721     {
1722         return ( 0, $self->loc("You may not create requests in that queue.") );
1723     }
1724
1725     unless (
1726         $self->OwnerObj->HasRight(
1727             Right    => 'OwnTicket',
1728             Object => $NewQueueObj
1729         )
1730       )
1731     {
1732         my $clone = RT::Ticket->new( $RT::SystemUser );
1733         $clone->Load( $self->Id );
1734         unless ( $clone->Id ) {
1735             return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) );
1736         }
1737         my ($status, $msg) = $clone->SetOwner( $RT::Nobody->Id, 'Force' );
1738         $RT::Logger->error("Couldn't set owner on queue change: $msg") unless $status;
1739     }
1740
1741     my ($status, $msg) = $self->_Set( Field => 'Queue', Value => $NewQueueObj->Id() );
1742
1743     if ( $status ) {
1744         # On queue change, change queue for reminders too
1745         my $reminder_collection = $self->Reminders->Collection;
1746         while ( my $reminder = $reminder_collection->Next ) {
1747             my ($status, $msg) = $reminder->SetQueue($NewQueue);
1748             $RT::Logger->error('Queue change failed for reminder #' . $reminder->Id . ': ' . $msg) unless $status;
1749         }
1750     }
1751     
1752     return ($status, $msg);
1753 }
1754
1755 # }}}
1756
1757 # {{{ sub QueueObj
1758
1759 =head2 QueueObj
1760
1761 Takes nothing. returns this ticket's queue object
1762
1763 =cut
1764
1765 sub QueueObj {
1766     my $self = shift;
1767
1768     my $queue_obj = RT::Queue->new( $self->CurrentUser );
1769
1770     #We call __Value so that we can avoid the ACL decision and some deep recursion
1771     my ($result) = $queue_obj->Load( $self->__Value('Queue') );
1772     return ($queue_obj);
1773 }
1774
1775 # }}}
1776
1777 # }}}
1778
1779 # {{{ Date printing routines
1780
1781 # {{{ sub DueObj
1782
1783 =head2 DueObj
1784
1785   Returns an RT::Date object containing this ticket's due date
1786
1787 =cut
1788
1789 sub DueObj {
1790     my $self = shift;
1791
1792     my $time = new RT::Date( $self->CurrentUser );
1793
1794     # -1 is RT::Date slang for never
1795     if ( my $due = $self->Due ) {
1796         $time->Set( Format => 'sql', Value => $due );
1797     }
1798     else {
1799         $time->Set( Format => 'unix', Value => -1 );
1800     }
1801
1802     return $time;
1803 }
1804
1805 # }}}
1806
1807 # {{{ sub DueAsString 
1808
1809 =head2 DueAsString
1810
1811 Returns this ticket's due date as a human readable string
1812
1813 =cut
1814
1815 sub DueAsString {
1816     my $self = shift;
1817     return $self->DueObj->AsString();
1818 }
1819
1820 # }}}
1821
1822 # {{{ sub ResolvedObj
1823
1824 =head2 ResolvedObj
1825
1826   Returns an RT::Date object of this ticket's 'resolved' time.
1827
1828 =cut
1829
1830 sub ResolvedObj {
1831     my $self = shift;
1832
1833     my $time = new RT::Date( $self->CurrentUser );
1834     $time->Set( Format => 'sql', Value => $self->Resolved );
1835     return $time;
1836 }
1837
1838 # }}}
1839
1840 # {{{ sub SetStarted
1841
1842 =head2 SetStarted
1843
1844 Takes a date in ISO format or undef
1845 Returns a transaction id and a message
1846 The client calls "Start" to note that the project was started on the date in $date.
1847 A null date means "now"
1848
1849 =cut
1850
1851 sub SetStarted {
1852     my $self = shift;
1853     my $time = shift || 0;
1854
1855     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1856         return ( 0, $self->loc("Permission Denied") );
1857     }
1858
1859     #We create a date object to catch date weirdness
1860     my $time_obj = new RT::Date( $self->CurrentUser() );
1861     if ( $time ) {
1862         $time_obj->Set( Format => 'ISO', Value => $time );
1863     }
1864     else {
1865         $time_obj->SetToNow();
1866     }
1867
1868     #Now that we're starting, open this ticket
1869     #TODO do we really want to force this as policy? it should be a scrip
1870
1871     #We need $TicketAsSystem, in case the current user doesn't have
1872     #ShowTicket
1873     #
1874     my $TicketAsSystem = new RT::Ticket($RT::SystemUser);
1875     $TicketAsSystem->Load( $self->Id );
1876     if ( $TicketAsSystem->Status eq 'new' ) {
1877         $TicketAsSystem->Open();
1878     }
1879
1880     return ( $self->_Set( Field => 'Started', Value => $time_obj->ISO ) );
1881
1882 }
1883
1884 # }}}
1885
1886 # {{{ sub StartedObj
1887
1888 =head2 StartedObj
1889
1890   Returns an RT::Date object which contains this ticket's 
1891 'Started' time.
1892
1893 =cut
1894
1895 sub StartedObj {
1896     my $self = shift;
1897
1898     my $time = new RT::Date( $self->CurrentUser );
1899     $time->Set( Format => 'sql', Value => $self->Started );
1900     return $time;
1901 }
1902
1903 # }}}
1904
1905 # {{{ sub StartsObj
1906
1907 =head2 StartsObj
1908
1909   Returns an RT::Date object which contains this ticket's 
1910 'Starts' time.
1911
1912 =cut
1913
1914 sub StartsObj {
1915     my $self = shift;
1916
1917     my $time = new RT::Date( $self->CurrentUser );
1918     $time->Set( Format => 'sql', Value => $self->Starts );
1919     return $time;
1920 }
1921
1922 # }}}
1923
1924 # {{{ sub ToldObj
1925
1926 =head2 ToldObj
1927
1928   Returns an RT::Date object which contains this ticket's 
1929 'Told' time.
1930
1931 =cut
1932
1933 sub ToldObj {
1934     my $self = shift;
1935
1936     my $time = new RT::Date( $self->CurrentUser );
1937     $time->Set( Format => 'sql', Value => $self->Told );
1938     return $time;
1939 }
1940
1941 # }}}
1942
1943 # {{{ sub ToldAsString
1944
1945 =head2 ToldAsString
1946
1947 A convenience method that returns ToldObj->AsString
1948
1949 TODO: This should be deprecated
1950
1951 =cut
1952
1953 sub ToldAsString {
1954     my $self = shift;
1955     if ( $self->Told ) {
1956         return $self->ToldObj->AsString();
1957     }
1958     else {
1959         return ("Never");
1960     }
1961 }
1962
1963 # }}}
1964
1965 # {{{ sub TimeWorkedAsString
1966
1967 =head2 TimeWorkedAsString
1968
1969 Returns the amount of time worked on this ticket as a Text String
1970
1971 =cut
1972
1973 sub TimeWorkedAsString {
1974     my $self = shift;
1975     my $value = $self->TimeWorked;
1976
1977     # return the # of minutes worked turned into seconds and written as
1978     # a simple text string, this is not really a date object, but if we
1979     # diff a number of seconds vs the epoch, we'll get a nice description
1980     # of time worked.
1981     return "" unless $value;
1982     return RT::Date->new( $self->CurrentUser )
1983         ->DurationAsString( $value * 60 );
1984 }
1985
1986 # }}}
1987
1988 # {{{ sub TimeLeftAsString
1989
1990 =head2  TimeLeftAsString
1991
1992 Returns the amount of time left on this ticket as a Text String
1993
1994 =cut
1995
1996 sub TimeLeftAsString {
1997     my $self = shift;
1998     my $value = $self->TimeLeft;
1999     return "" unless $value;
2000     return RT::Date->new( $self->CurrentUser )
2001         ->DurationAsString( $value * 60 );
2002 }
2003
2004 # }}}
2005
2006 # {{{ Routines dealing with correspondence/comments
2007
2008 # {{{ sub Comment
2009
2010 =head2 Comment
2011
2012 Comment on this ticket.
2013 Takes a hash with the following attributes:
2014 If MIMEObj is undefined, Content will be used to build a MIME::Entity for this
2015 comment.
2016
2017 MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun
2018
2019 If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed.
2020 They will, however, be prepared and you'll be able to access them through the TransactionObj
2021
2022 Returns: Transaction id, Error Message, Transaction Object
2023 (note the different order from Create()!)
2024
2025 =cut
2026
2027 sub Comment {
2028     my $self = shift;
2029
2030     my %args = ( CcMessageTo  => undef,
2031                  BccMessageTo => undef,
2032                  MIMEObj      => undef,
2033                  Content      => undef,
2034                  TimeTaken => 0,
2035                  DryRun     => 0, 
2036                  @_ );
2037
2038     unless (    ( $self->CurrentUserHasRight('CommentOnTicket') )
2039              or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
2040         return ( 0, $self->loc("Permission Denied"), undef );
2041     }
2042     $args{'NoteType'} = 'Comment';
2043
2044     if ($args{'DryRun'}) {
2045         $RT::Handle->BeginTransaction();
2046         $args{'CommitScrips'} = 0;
2047     }
2048
2049     my @results = $self->_RecordNote(%args);
2050     if ($args{'DryRun'}) {
2051         $RT::Handle->Rollback();
2052     }
2053
2054     return(@results);
2055 }
2056 # }}}
2057
2058 # {{{ sub Correspond
2059
2060 =head2 Correspond
2061
2062 Correspond on this ticket.
2063 Takes a hashref with the following attributes:
2064
2065
2066 MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun
2067
2068 if there's no MIMEObj, Content is used to build a MIME::Entity object
2069
2070 If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed.
2071 They will, however, be prepared and you'll be able to access them through the TransactionObj
2072
2073 Returns: Transaction id, Error Message, Transaction Object
2074 (note the different order from Create()!)
2075
2076
2077 =cut
2078
2079 sub Correspond {
2080     my $self = shift;
2081     my %args = ( CcMessageTo  => undef,
2082                  BccMessageTo => undef,
2083                  MIMEObj      => undef,
2084                  Content      => undef,
2085                  TimeTaken    => 0,
2086                  @_ );
2087
2088     unless (    ( $self->CurrentUserHasRight('ReplyToTicket') )
2089              or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
2090         return ( 0, $self->loc("Permission Denied"), undef );
2091     }
2092
2093     $args{'NoteType'} = 'Correspond'; 
2094     if ($args{'DryRun'}) {
2095         $RT::Handle->BeginTransaction();
2096         $args{'CommitScrips'} = 0;
2097     }
2098
2099     my @results = $self->_RecordNote(%args);
2100
2101     #Set the last told date to now if this isn't mail from the requestor.
2102     #TODO: Note that this will wrongly ack mail from any non-requestor as a "told"
2103     $self->_SetTold unless ( $self->IsRequestor($self->CurrentUser->id));
2104
2105     if ($args{'DryRun'}) {
2106         $RT::Handle->Rollback();
2107     }
2108
2109     return (@results);
2110
2111 }
2112
2113 # }}}
2114
2115 # {{{ sub _RecordNote
2116
2117 =head2 _RecordNote
2118
2119 the meat of both comment and correspond. 
2120
2121 Performs no access control checks. hence, dangerous.
2122
2123 =cut
2124
2125 sub _RecordNote {
2126     my $self = shift;
2127     my %args = ( 
2128         CcMessageTo  => undef,
2129         BccMessageTo => undef,
2130         Encrypt      => undef,
2131         Sign         => undef,
2132         MIMEObj      => undef,
2133         Content      => undef,
2134         NoteType     => 'Correspond',
2135         TimeTaken    => 0,
2136         CommitScrips => 1,
2137         @_
2138     );
2139
2140     unless ( $args{'MIMEObj'} || $args{'Content'} ) {
2141         return ( 0, $self->loc("No message attached"), undef );
2142     }
2143
2144     unless ( $args{'MIMEObj'} ) {
2145         $args{'MIMEObj'} = MIME::Entity->build(
2146             Data => ( ref $args{'Content'}? $args{'Content'}: [ $args{'Content'} ] )
2147         );
2148     }
2149
2150     # convert text parts into utf-8
2151     RT::I18N::SetMIMEEntityToUTF8( $args{'MIMEObj'} );
2152
2153     # If we've been passed in CcMessageTo and BccMessageTo fields,
2154     # add them to the mime object for passing on to the transaction handler
2155     # The "NotifyOtherRecipients" scripAction will look for RT-Send-Cc: and
2156     # RT-Send-Bcc: headers
2157
2158
2159     foreach my $type (qw/Cc Bcc/) {
2160         if ( defined $args{ $type . 'MessageTo' } ) {
2161
2162             my $addresses = join ', ', (
2163                 map { RT::User->CanonicalizeEmailAddress( $_->address ) }
2164                     Email::Address->parse( $args{ $type . 'MessageTo' } ) );
2165             $args{'MIMEObj'}->head->add( 'RT-Send-' . $type, Encode::encode_utf8( $addresses ) );
2166         }
2167     }
2168
2169     foreach my $argument (qw(Encrypt Sign)) {
2170         $args{'MIMEObj'}->head->add(
2171             "X-RT-$argument" => Encode::encode_utf8( $args{ $argument } )
2172         ) if defined $args{ $argument };
2173     }
2174
2175     # If this is from an external source, we need to come up with its
2176     # internal Message-ID now, so all emails sent because of this
2177     # message have a common Message-ID
2178     my $org = RT->Config->Get('Organization');
2179     my $msgid = $args{'MIMEObj'}->head->get('Message-ID');
2180     unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) {
2181         $args{'MIMEObj'}->head->set(
2182             'RT-Message-ID' => RT::Interface::Email::GenMessageId( Ticket => $self )
2183         );
2184     }
2185
2186     #Record the correspondence (write the transaction)
2187     my ( $Trans, $msg, $TransObj ) = $self->_NewTransaction(
2188              Type => $args{'NoteType'},
2189              Data => ( $args{'MIMEObj'}->head->get('subject') || 'No Subject' ),
2190              TimeTaken => $args{'TimeTaken'},
2191              MIMEObj   => $args{'MIMEObj'}, 
2192              CommitScrips => $args{'CommitScrips'},
2193     );
2194
2195     unless ($Trans) {
2196         $RT::Logger->err("$self couldn't init a transaction $msg");
2197         return ( $Trans, $self->loc("Message could not be recorded"), undef );
2198     }
2199
2200     return ( $Trans, $self->loc("Message recorded"), $TransObj );
2201 }
2202
2203 # }}}
2204
2205 # }}}
2206
2207 # {{{ sub _Links 
2208
2209 sub _Links {
2210     my $self = shift;
2211
2212     #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
2213     #tobias meant by $f
2214     my $field = shift;
2215     my $type  = shift || "";
2216
2217     my $cache_key = "$field$type";
2218     return $self->{ $cache_key } if $self->{ $cache_key };
2219
2220     my $links = $self->{ $cache_key }
2221               = RT::Links->new( $self->CurrentUser );
2222     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
2223         $links->Limit( FIELD => 'id', VALUE => 0 );
2224         return $links;
2225     }
2226
2227     # Maybe this ticket is a merge ticket
2228     my $limit_on = 'Local'. $field;
2229     # at least to myself
2230     $links->Limit(
2231         FIELD           => $limit_on,
2232         VALUE           => $self->id,
2233         ENTRYAGGREGATOR => 'OR',
2234     );
2235     $links->Limit(
2236         FIELD           => $limit_on,
2237         VALUE           => $_,
2238         ENTRYAGGREGATOR => 'OR',
2239     ) foreach $self->Merged;
2240     $links->Limit(
2241         FIELD => 'Type',
2242         VALUE => $type,
2243     ) if $type;
2244
2245     return $links;
2246 }
2247
2248 # }}}
2249
2250 # {{{ sub DeleteLink 
2251
2252 =head2 DeleteLink
2253
2254 Delete a link. takes a paramhash of Base, Target, Type, Silent,
2255 SilentBase and SilentTarget. Either Base or Target must be null.
2256 The null value will be replaced with this ticket\'s id.
2257
2258 If Silent is true then no transaction would be recorded, in other
2259 case you can control creation of transactions on both base and
2260 target with SilentBase and SilentTarget respectively. By default
2261 both transactions are created.
2262
2263 =cut 
2264
2265 sub DeleteLink {
2266     my $self = shift;
2267     my %args = (
2268         Base   => undef,
2269         Target => undef,
2270         Type   => undef,
2271         Silent => undef,
2272         SilentBase   => undef,
2273         SilentTarget => undef,
2274         @_
2275     );
2276
2277     unless ( $args{'Target'} || $args{'Base'} ) {
2278         $RT::Logger->error("Base or Target must be specified");
2279         return ( 0, $self->loc('Either base or target must be specified') );
2280     }
2281
2282     #check acls
2283     my $right = 0;
2284     $right++ if $self->CurrentUserHasRight('ModifyTicket');
2285     if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) {
2286         return ( 0, $self->loc("Permission Denied") );
2287     }
2288
2289     # If the other URI is an RT::Ticket, we want to make sure the user
2290     # can modify it too...
2291     my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2292     return (0, $msg) unless $status;
2293     if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2294         $right++;
2295     }
2296     if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) ||
2297          ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) )
2298     {
2299         return ( 0, $self->loc("Permission Denied") );
2300     }
2301
2302     my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
2303     return ( 0, $Msg ) unless $val;
2304
2305     return ( $val, $Msg ) if $args{'Silent'};
2306
2307     my ($direction, $remote_link);
2308
2309     if ( $args{'Base'} ) {
2310         $remote_link = $args{'Base'};
2311         $direction = 'Target';
2312     }
2313     elsif ( $args{'Target'} ) {
2314         $remote_link = $args{'Target'};
2315         $direction = 'Base';
2316     } 
2317
2318     my $remote_uri = RT::URI->new( $self->CurrentUser );
2319     $remote_uri->FromURI( $remote_link );
2320
2321     unless ( $args{ 'Silent'. $direction } ) {
2322         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2323             Type      => 'DeleteLink',
2324             Field     => $LINKDIRMAP{$args{'Type'}}->{$direction},
2325             OldValue  => $remote_uri->URI || $remote_link,
2326             TimeTaken => 0
2327         );
2328         $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
2329     }
2330
2331     if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) {
2332         my $OtherObj = $remote_uri->Object;
2333         my ( $val, $Msg ) = $OtherObj->_NewTransaction(
2334             Type           => 'DeleteLink',
2335             Field          => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2336                                             : $LINKDIRMAP{$args{'Type'}}->{Target},
2337             OldValue       => $self->URI,
2338             ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'),
2339             TimeTaken      => 0,
2340         );
2341         $RT::Logger->error("Couldn't create transaction: $Msg") unless $val;
2342     }
2343
2344     return ( $val, $Msg );
2345 }
2346
2347 # }}}
2348
2349 # {{{ sub AddLink
2350
2351 =head2 AddLink
2352
2353 Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket.
2354
2355 If Silent is true then no transaction would be recorded, in other
2356 case you can control creation of transactions on both base and
2357 target with SilentBase and SilentTarget respectively. By default
2358 both transactions are created.
2359
2360 =cut
2361
2362 sub AddLink {
2363     my $self = shift;
2364     my %args = ( Target       => '',
2365                  Base         => '',
2366                  Type         => '',
2367                  Silent       => undef,
2368                  SilentBase   => undef,
2369                  SilentTarget => undef,
2370                  @_ );
2371
2372     unless ( $args{'Target'} || $args{'Base'} ) {
2373         $RT::Logger->error("Base or Target must be specified");
2374         return ( 0, $self->loc('Either base or target must be specified') );
2375     }
2376
2377     my $right = 0;
2378     $right++ if $self->CurrentUserHasRight('ModifyTicket');
2379     if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) {
2380         return ( 0, $self->loc("Permission Denied") );
2381     }
2382
2383     # If the other URI is an RT::Ticket, we want to make sure the user
2384     # can modify it too...
2385     my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2386     return (0, $msg) unless $status;
2387     if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2388         $right++;
2389     }
2390     if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) ||
2391          ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) )
2392     {
2393         return ( 0, $self->loc("Permission Denied") );
2394     }
2395
2396     return $self->_AddLink(%args);
2397 }
2398
2399 sub __GetTicketFromURI {
2400     my $self = shift;
2401     my %args = ( URI => '', @_ );
2402
2403     # If the other URI is an RT::Ticket, we want to make sure the user
2404     # can modify it too...
2405     my $uri_obj = RT::URI->new( $self->CurrentUser );
2406     $uri_obj->FromURI( $args{'URI'} );
2407
2408     unless ( $uri_obj->Resolver && $uri_obj->Scheme ) {
2409         my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} );
2410         $RT::Logger->warning( $msg );
2411         return( 0, $msg );
2412     }
2413     my $obj = $uri_obj->Resolver->Object;
2414     unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
2415         return (1, 'Found not a ticket', undef);
2416     }
2417     return (1, 'Found ticket', $obj);
2418 }
2419
2420 =head2 _AddLink  
2421
2422 Private non-acled variant of AddLink so that links can be added during create.
2423
2424 =cut
2425
2426 sub _AddLink {
2427     my $self = shift;
2428     my %args = ( Target       => '',
2429                  Base         => '',
2430                  Type         => '',
2431                  Silent       => undef,
2432                  SilentBase   => undef,
2433                  SilentTarget => undef,
2434                  @_ );
2435
2436     my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
2437     return ($val, $msg) if !$val || $exist;
2438     return ($val, $msg) if $args{'Silent'};
2439
2440     my ($direction, $remote_link);
2441     if ( $args{'Target'} ) {
2442         $remote_link  = $args{'Target'};
2443         $direction    = 'Base';
2444     } elsif ( $args{'Base'} ) {
2445         $remote_link  = $args{'Base'};
2446         $direction    = 'Target';
2447     }
2448
2449     my $remote_uri = RT::URI->new( $self->CurrentUser );
2450     $remote_uri->FromURI( $remote_link );
2451
2452     unless ( $args{ 'Silent'. $direction } ) {
2453         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2454             Type      => 'AddLink',
2455             Field     => $LINKDIRMAP{$args{'Type'}}->{$direction},
2456             NewValue  =>  $remote_uri->URI || $remote_link,
2457             TimeTaken => 0
2458         );
2459         $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
2460     }
2461
2462     if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) {
2463         my $OtherObj = $remote_uri->Object;
2464         my ( $val, $msg ) = $OtherObj->_NewTransaction(
2465             Type           => 'AddLink',
2466             Field          => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2467                                             : $LINKDIRMAP{$args{'Type'}}->{Target},
2468             NewValue       => $self->URI,
2469             ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'),
2470             TimeTaken      => 0,
2471         );
2472         $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
2473     }
2474
2475     return ( $val, $msg );
2476 }
2477
2478 # }}}
2479
2480
2481 # {{{ sub MergeInto
2482
2483 =head2 MergeInto
2484
2485 MergeInto take the id of the ticket to merge this ticket into.
2486
2487 =cut
2488
2489 sub MergeInto {
2490     my $self      = shift;
2491     my $ticket_id = shift;
2492
2493     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
2494         return ( 0, $self->loc("Permission Denied") );
2495     }
2496
2497     # Load up the new ticket.
2498     my $MergeInto = RT::Ticket->new($self->CurrentUser);
2499     $MergeInto->Load($ticket_id);
2500
2501     # make sure it exists.
2502     unless ( $MergeInto->Id ) {
2503         return ( 0, $self->loc("New ticket doesn't exist") );
2504     }
2505
2506     # Make sure the current user can modify the new ticket.
2507     unless ( $MergeInto->CurrentUserHasRight('ModifyTicket') ) {
2508         return ( 0, $self->loc("Permission Denied") );
2509     }
2510
2511     delete $MERGE_CACHE{'effective'}{ $self->id };
2512     delete @{ $MERGE_CACHE{'merged'} }{
2513         $ticket_id, $MergeInto->id, $self->id
2514     };
2515
2516     $RT::Handle->BeginTransaction();
2517
2518     # We use EffectiveId here even though it duplicates information from
2519     # the links table becasue of the massive performance hit we'd take
2520     # by trying to do a separate database query for merge info everytime 
2521     # loaded a ticket. 
2522
2523     #update this ticket's effective id to the new ticket's id.
2524     my ( $id_val, $id_msg ) = $self->__Set(
2525         Field => 'EffectiveId',
2526         Value => $MergeInto->Id()
2527     );
2528
2529     unless ($id_val) {
2530         $RT::Handle->Rollback();
2531         return ( 0, $self->loc("Merge failed. Couldn't set EffectiveId") );
2532     }
2533
2534
2535     if ( $self->__Value('Status') ne 'resolved' ) {
2536
2537         my ( $status_val, $status_msg )
2538             = $self->__Set( Field => 'Status', Value => 'resolved' );
2539
2540         unless ($status_val) {
2541             $RT::Handle->Rollback();
2542             $RT::Logger->error(
2543                 $self->loc(
2544                     "[_1] couldn't set status to resolved. RT's Database may be inconsistent.",
2545                     $self
2546                 )
2547             );
2548             return ( 0, $self->loc("Merge failed. Couldn't set Status") );
2549         }
2550     }
2551
2552     # update all the links that point to that old ticket
2553     my $old_links_to = RT::Links->new($self->CurrentUser);
2554     $old_links_to->Limit(FIELD => 'Target', VALUE => $self->URI);
2555
2556     my %old_seen;
2557     while (my $link = $old_links_to->Next) {
2558         if (exists $old_seen{$link->Base."-".$link->Type}) {
2559             $link->Delete;
2560         }   
2561         elsif ($link->Base eq $MergeInto->URI) {
2562             $link->Delete;
2563         } else {
2564             # First, make sure the link doesn't already exist. then move it over.
2565             my $tmp = RT::Link->new($RT::SystemUser);
2566             $tmp->LoadByCols(Base => $link->Base, Type => $link->Type, LocalTarget => $MergeInto->id);
2567             if ($tmp->id)   {
2568                     $link->Delete;
2569             } else { 
2570                 $link->SetTarget($MergeInto->URI);
2571                 $link->SetLocalTarget($MergeInto->id);
2572             }
2573             $old_seen{$link->Base."-".$link->Type} =1;
2574         }
2575
2576     }
2577
2578     my $old_links_from = RT::Links->new($self->CurrentUser);
2579     $old_links_from->Limit(FIELD => 'Base', VALUE => $self->URI);
2580
2581     while (my $link = $old_links_from->Next) {
2582         if (exists $old_seen{$link->Type."-".$link->Target}) {
2583             $link->Delete;
2584         }   
2585         if ($link->Target eq $MergeInto->URI) {
2586             $link->Delete;
2587         } else {
2588             # First, make sure the link doesn't already exist. then move it over.
2589             my $tmp = RT::Link->new($RT::SystemUser);
2590             $tmp->LoadByCols(Target => $link->Target, Type => $link->Type, LocalBase => $MergeInto->id);
2591             if ($tmp->id)   {
2592                     $link->Delete;
2593             } else { 
2594                 $link->SetBase($MergeInto->URI);
2595                 $link->SetLocalBase($MergeInto->id);
2596                 $old_seen{$link->Type."-".$link->Target} =1;
2597             }
2598         }
2599
2600     }
2601
2602     # Update time fields
2603     foreach my $type qw(TimeEstimated TimeWorked TimeLeft) {
2604
2605         my $mutator = "Set$type";
2606         $MergeInto->$mutator(
2607             ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ) );
2608
2609     }
2610 #add all of this ticket's watchers to that ticket.
2611     foreach my $watcher_type qw(Requestors Cc AdminCc) {
2612
2613         my $people = $self->$watcher_type->MembersObj;
2614         my $addwatcher_type =  $watcher_type;
2615         $addwatcher_type  =~ s/s$//;
2616
2617         while ( my $watcher = $people->Next ) {
2618             
2619            my ($val, $msg) =  $MergeInto->_AddWatcher(
2620                 Type        => $addwatcher_type,
2621                 Silent => 1,
2622                 PrincipalId => $watcher->MemberId
2623             );
2624             unless ($val) {
2625                 $RT::Logger->warning($msg);
2626             }
2627     }
2628
2629     }
2630
2631     #find all of the tickets that were merged into this ticket. 
2632     my $old_mergees = new RT::Tickets( $self->CurrentUser );
2633     $old_mergees->Limit(
2634         FIELD    => 'EffectiveId',
2635         OPERATOR => '=',
2636         VALUE    => $self->Id
2637     );
2638
2639     #   update their EffectiveId fields to the new ticket's id
2640     while ( my $ticket = $old_mergees->Next() ) {
2641         my ( $val, $msg ) = $ticket->__Set(
2642             Field => 'EffectiveId',
2643             Value => $MergeInto->Id()
2644         );
2645     }
2646
2647     #make a new link: this ticket is merged into that other ticket.
2648     $self->AddLink( Type   => 'MergedInto', Target => $MergeInto->Id());
2649
2650     $MergeInto->_SetLastUpdated;    
2651
2652     $RT::Handle->Commit();
2653     return ( 1, $self->loc("Merge Successful") );
2654 }
2655
2656 =head2 Merged
2657
2658 Returns list of tickets' ids that's been merged into this ticket.
2659
2660 =cut
2661
2662 sub Merged {
2663     my $self = shift;
2664
2665     my $id = $self->id;
2666     return @{ $MERGE_CACHE{'merged'}{ $id } }
2667         if $MERGE_CACHE{'merged'}{ $id };
2668
2669     my $mergees = RT::Tickets->new( $self->CurrentUser );
2670     $mergees->Limit(
2671         FIELD    => 'EffectiveId',
2672         VALUE    => $id,
2673     );
2674     $mergees->Limit(
2675         FIELD    => 'id',
2676         OPERATOR => '!=',
2677         VALUE    => $id,
2678     );
2679     return @{ $MERGE_CACHE{'merged'}{ $id } ||= [] }
2680         = map $_->id, @{ $mergees->ItemsArrayRef || [] };
2681 }
2682
2683 # }}}
2684
2685 # }}}
2686
2687 # {{{ Routines dealing with ownership
2688
2689 # {{{ sub OwnerObj
2690
2691 =head2 OwnerObj
2692
2693 Takes nothing and returns an RT::User object of 
2694 this ticket's owner
2695
2696 =cut
2697
2698 sub OwnerObj {
2699     my $self = shift;
2700
2701     #If this gets ACLed, we lose on a rights check in User.pm and
2702     #get deep recursion. if we need ACLs here, we need
2703     #an equiv without ACLs
2704
2705     my $owner = new RT::User( $self->CurrentUser );
2706     $owner->Load( $self->__Value('Owner') );
2707
2708     #Return the owner object
2709     return ($owner);
2710 }
2711
2712 # }}}
2713
2714 # {{{ sub OwnerAsString 
2715
2716 =head2 OwnerAsString
2717
2718 Returns the owner's email address
2719
2720 =cut
2721
2722 sub OwnerAsString {
2723     my $self = shift;
2724     return ( $self->OwnerObj->EmailAddress );
2725
2726 }
2727
2728 # }}}
2729
2730 # {{{ sub SetOwner
2731
2732 =head2 SetOwner
2733
2734 Takes two arguments:
2735      the Id or Name of the owner 
2736 and  (optionally) the type of the SetOwner Transaction. It defaults
2737 to 'Give'.  'Steal' is also a valid option.
2738
2739
2740 =cut
2741
2742 sub SetOwner {
2743     my $self     = shift;
2744     my $NewOwner = shift;
2745     my $Type     = shift || "Give";
2746
2747     $RT::Handle->BeginTransaction();
2748
2749     $self->_SetLastUpdated(); # lock the ticket
2750     $self->Load( $self->id ); # in case $self changed while waiting for lock
2751
2752     my $OldOwnerObj = $self->OwnerObj;
2753
2754     my $NewOwnerObj = RT::User->new( $self->CurrentUser );
2755     $NewOwnerObj->Load( $NewOwner );
2756     unless ( $NewOwnerObj->Id ) {
2757         $RT::Handle->Rollback();
2758         return ( 0, $self->loc("That user does not exist") );
2759     }
2760
2761
2762     # must have ModifyTicket rights
2763     # or TakeTicket/StealTicket and $NewOwner is self
2764     # see if it's a take
2765     if ( $OldOwnerObj->Id == $RT::Nobody->Id ) {
2766         unless (    $self->CurrentUserHasRight('ModifyTicket')
2767                  || $self->CurrentUserHasRight('TakeTicket') ) {
2768             $RT::Handle->Rollback();
2769             return ( 0, $self->loc("Permission Denied") );
2770         }
2771     }
2772
2773     # see if it's a steal
2774     elsif (    $OldOwnerObj->Id != $RT::Nobody->Id
2775             && $OldOwnerObj->Id != $self->CurrentUser->id ) {
2776
2777         unless (    $self->CurrentUserHasRight('ModifyTicket')
2778                  || $self->CurrentUserHasRight('StealTicket') ) {
2779             $RT::Handle->Rollback();
2780             return ( 0, $self->loc("Permission Denied") );
2781         }
2782     }
2783     else {
2784         unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
2785             $RT::Handle->Rollback();
2786             return ( 0, $self->loc("Permission Denied") );
2787         }
2788     }
2789
2790     # If we're not stealing and the ticket has an owner and it's not
2791     # the current user
2792     if ( $Type ne 'Steal' and $Type ne 'Force'
2793          and $OldOwnerObj->Id != $RT::Nobody->Id
2794          and $OldOwnerObj->Id != $self->CurrentUser->Id )
2795     {
2796         $RT::Handle->Rollback();
2797         return ( 0, $self->loc("You can only take tickets that are unowned") )
2798             if $NewOwnerObj->id == $self->CurrentUser->id;
2799         return (
2800             0,
2801             $self->loc("You can only reassign tickets that you own or that are unowned" )
2802         );
2803     }
2804
2805     #If we've specified a new owner and that user can't modify the ticket
2806     elsif ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ) {
2807         $RT::Handle->Rollback();
2808         return ( 0, $self->loc("That user may not own tickets in that queue") );
2809     }
2810
2811     # If the ticket has an owner and it's the new owner, we don't need
2812     # To do anything
2813     elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) {
2814         $RT::Handle->Rollback();
2815         return ( 0, $self->loc("That user already owns that ticket") );
2816     }
2817
2818     # Delete the owner in the owner group, then add a new one
2819     # TODO: is this safe? it's not how we really want the API to work
2820     # for most things, but it's fast.
2821     my ( $del_id, $del_msg );
2822     for my $owner (@{$self->OwnerGroup->MembersObj->ItemsArrayRef}) {
2823         ($del_id, $del_msg) = $owner->Delete();
2824         last unless ($del_id);
2825     }
2826
2827     unless ($del_id) {
2828         $RT::Handle->Rollback();
2829         return ( 0, $self->loc("Could not change owner: [_1]", $del_msg) );
2830     }
2831
2832     my ( $add_id, $add_msg ) = $self->OwnerGroup->_AddMember(
2833                                        PrincipalId => $NewOwnerObj->PrincipalId,
2834                                        InsideTransaction => 1 );
2835     unless ($add_id) {
2836         $RT::Handle->Rollback();
2837         return ( 0, $self->loc("Could not change owner: [_1]", $add_msg ) );
2838     }
2839
2840     # We call set twice with slightly different arguments, so
2841     # as to not have an SQL transaction span two RT transactions
2842
2843     my ( $val, $msg ) = $self->_Set(
2844                       Field             => 'Owner',
2845                       RecordTransaction => 0,
2846                       Value             => $NewOwnerObj->Id,
2847                       TimeTaken         => 0,
2848                       TransactionType   => $Type,
2849                       CheckACL          => 0,                  # don't check acl
2850     );
2851
2852     unless ($val) {
2853         $RT::Handle->Rollback;
2854         return ( 0, $self->loc("Could not change owner: [_1]", $msg) );
2855     }
2856
2857     ($val, $msg) = $self->_NewTransaction(
2858         Type      => $Type,
2859         Field     => 'Owner',
2860         NewValue  => $NewOwnerObj->Id,
2861         OldValue  => $OldOwnerObj->Id,
2862         TimeTaken => 0,
2863     );
2864
2865     if ( $val ) {
2866         $msg = $self->loc( "Owner changed from [_1] to [_2]",
2867                            $OldOwnerObj->Name, $NewOwnerObj->Name );
2868     }
2869     else {
2870         $RT::Handle->Rollback();
2871         return ( 0, $msg );
2872     }
2873
2874     $RT::Handle->Commit();
2875
2876     return ( $val, $msg );
2877 }
2878
2879 # }}}
2880
2881 # {{{ sub Take
2882
2883 =head2 Take
2884
2885 A convenince method to set the ticket's owner to the current user
2886
2887 =cut
2888
2889 sub Take {
2890     my $self = shift;
2891     return ( $self->SetOwner( $self->CurrentUser->Id, 'Take' ) );
2892 }
2893
2894 # }}}
2895
2896 # {{{ sub Untake
2897
2898 =head2 Untake
2899
2900 Convenience method to set the owner to 'nobody' if the current user is the owner.
2901
2902 =cut
2903
2904 sub Untake {
2905     my $self = shift;
2906     return ( $self->SetOwner( $RT::Nobody->UserObj->Id, 'Untake' ) );
2907 }
2908
2909 # }}}
2910
2911 # {{{ sub Steal 
2912
2913 =head2 Steal
2914
2915 A convenience method to change the owner of the current ticket to the
2916 current user. Even if it's owned by another user.
2917
2918 =cut
2919
2920 sub Steal {
2921     my $self = shift;
2922
2923     if ( $self->IsOwner( $self->CurrentUser ) ) {
2924         return ( 0, $self->loc("You already own this ticket") );
2925     }
2926     else {
2927         return ( $self->SetOwner( $self->CurrentUser->Id, 'Steal' ) );
2928
2929     }
2930
2931 }
2932
2933 # }}}
2934
2935 # }}}
2936
2937 # {{{ Routines dealing with status
2938
2939 # {{{ sub ValidateStatus 
2940
2941 =head2 ValidateStatus STATUS
2942
2943 Takes a string. Returns true if that status is a valid status for this ticket.
2944 Returns false otherwise.
2945
2946 =cut
2947
2948 sub ValidateStatus {
2949     my $self   = shift;
2950     my $status = shift;
2951
2952     #Make sure the status passed in is valid
2953     unless ( $self->QueueObj->IsValidStatus($status) ) {
2954         return (undef);
2955     }
2956
2957     return (1);
2958
2959 }
2960
2961 # }}}
2962
2963 # {{{ sub SetStatus
2964
2965 =head2 SetStatus STATUS
2966
2967 Set this ticket\'s status. STATUS can be one of: new, open, stalled, resolved, rejected or deleted.
2968
2969 Alternatively, you can pass in a list of named parameters (Status => STATUS, Force => FORCE).  If FORCE is true, ignore unresolved dependencies and force a status change.
2970
2971
2972
2973 =cut
2974
2975 sub SetStatus {
2976     my $self   = shift;
2977     my %args;
2978
2979     if (@_ == 1) {
2980     $args{Status} = shift;
2981     }
2982     else {
2983     %args = (@_);
2984     }
2985
2986     #Check ACL
2987     if ( $args{Status} eq 'deleted') {
2988             unless ($self->CurrentUserHasRight('DeleteTicket')) {
2989             return ( 0, $self->loc('Permission Denied') );
2990        }
2991     } else {
2992             unless ($self->CurrentUserHasRight('ModifyTicket')) {
2993             return ( 0, $self->loc('Permission Denied') );
2994        }
2995     }
2996
2997     if (!$args{Force} && ($args{'Status'} eq 'resolved') && $self->HasUnresolvedDependencies) {
2998         return (0, $self->loc('That ticket has unresolved dependencies'));
2999     }
3000
3001     my $now = RT::Date->new( $self->CurrentUser );
3002     $now->SetToNow();
3003
3004     #If we're changing the status from new, record that we've started
3005     if ( $self->Status eq 'new' && $args{Status} ne 'new' ) {
3006
3007         #Set the Started time to "now"
3008         $self->_Set( Field             => 'Started',
3009                      Value             => $now->ISO,
3010                      RecordTransaction => 0 );
3011     }
3012
3013     #When we close a ticket, set the 'Resolved' attribute to now.
3014     # It's misnamed, but that's just historical.
3015     if ( $self->QueueObj->IsInactiveStatus($args{Status}) ) {
3016         $self->_Set( Field             => 'Resolved',
3017                      Value             => $now->ISO,
3018                      RecordTransaction => 0 );
3019     }
3020
3021     #Actually update the status
3022    my ($val, $msg)= $self->_Set( Field           => 'Status',
3023                           Value           => $args{Status},
3024                           TimeTaken       => 0,
3025                           CheckACL      => 0,
3026                           TransactionType => 'Status'  );
3027
3028     return($val,$msg);
3029 }
3030
3031 # }}}
3032
3033 # {{{ sub Delete
3034
3035 =head2 Delete
3036
3037 Takes no arguments. Marks this ticket for garbage collection
3038
3039 =cut
3040
3041 sub Delete {
3042     my $self = shift;
3043     return ( $self->SetStatus('deleted') );
3044
3045     # TODO: garbage collection
3046 }
3047
3048 # }}}
3049
3050 # {{{ sub Stall
3051
3052 =head2 Stall
3053
3054 Sets this ticket's status to stalled
3055
3056 =cut
3057
3058 sub Stall {
3059     my $self = shift;
3060     return ( $self->SetStatus('stalled') );
3061 }
3062
3063 # }}}
3064
3065 # {{{ sub Reject
3066
3067 =head2 Reject
3068
3069 Sets this ticket's status to rejected
3070
3071 =cut
3072
3073 sub Reject {
3074     my $self = shift;
3075     return ( $self->SetStatus('rejected') );
3076 }
3077
3078 # }}}
3079
3080 # {{{ sub Open
3081
3082 =head2 Open
3083
3084 Sets this ticket\'s status to Open
3085
3086 =cut
3087
3088 sub Open {
3089     my $self = shift;
3090     return ( $self->SetStatus('open') );
3091 }
3092
3093 # }}}
3094
3095 # {{{ sub Resolve
3096
3097 =head2 Resolve
3098
3099 Sets this ticket\'s status to Resolved
3100
3101 =cut
3102
3103 sub Resolve {
3104     my $self = shift;
3105     return ( $self->SetStatus('resolved') );
3106 }
3107
3108 # }}}
3109
3110 # }}}
3111
3112     
3113 # {{{ Actions + Routines dealing with transactions
3114
3115 # {{{ sub SetTold and _SetTold
3116
3117 =head2 SetTold ISO  [TIMETAKEN]
3118
3119 Updates the told and records a transaction
3120
3121 =cut
3122
3123 sub SetTold {
3124     my $self = shift;
3125     my $told;
3126     $told = shift if (@_);
3127     my $timetaken = shift || 0;
3128
3129     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
3130         return ( 0, $self->loc("Permission Denied") );
3131     }
3132
3133     my $datetold = new RT::Date( $self->CurrentUser );
3134     if ($told) {
3135         $datetold->Set( Format => 'iso',
3136                         Value  => $told );
3137     }
3138     else {
3139         $datetold->SetToNow();
3140     }
3141
3142     return ( $self->_Set( Field           => 'Told',
3143                           Value           => $datetold->ISO,
3144                           TimeTaken       => $timetaken,
3145                           TransactionType => 'Told' ) );
3146 }
3147
3148 =head2 _SetTold
3149
3150 Updates the told without a transaction or acl check. Useful when we're sending replies.
3151
3152 =cut
3153
3154 sub _SetTold {
3155     my $self = shift;
3156
3157     my $now = new RT::Date( $self->CurrentUser );
3158     $now->SetToNow();
3159
3160     #use __Set to get no ACLs ;)
3161     return ( $self->__Set( Field => 'Told',
3162                            Value => $now->ISO ) );
3163 }
3164
3165 =head2 SeenUpTo
3166
3167
3168 =cut
3169
3170 sub SeenUpTo {
3171     my $self = shift;
3172     my $uid = $self->CurrentUser->id;
3173     my $attr = $self->FirstAttribute( "User-". $uid ."-SeenUpTo" );
3174     return if $attr && $attr->Content gt $self->LastUpdated;
3175
3176     my $txns = $self->Transactions;
3177     $txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
3178     $txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
3179     $txns->Limit( FIELD => 'Creator', OPERATOR => '!=', VALUE => $uid );
3180     $txns->Limit(
3181         FIELD => 'Created',
3182         OPERATOR => '>',
3183         VALUE => $attr->Content
3184     ) if $attr;
3185     $txns->RowsPerPage(1);
3186     return $txns->First;
3187 }
3188
3189 # }}}
3190
3191 =head2 TransactionBatch
3192
3193 Returns an array reference of all transactions created on this ticket during
3194 this ticket object's lifetime or since last application of a batch, or undef
3195 if there were none.
3196
3197 Only works when the C<UseTransactionBatch> config option is set to true.
3198
3199 =cut
3200
3201 sub TransactionBatch {
3202     my $self = shift;
3203     return $self->{_TransactionBatch};
3204 }
3205
3206 =head2 ApplyTransactionBatch
3207
3208 Applies scrips on the current batch of transactions and shinks it. Usually
3209 batch is applied when object is destroyed, but in some cases it's too late.
3210
3211 =cut
3212
3213 sub ApplyTransactionBatch {
3214     my $self = shift;
3215
3216     my $batch = $self->TransactionBatch;
3217     return unless $batch && @$batch;
3218
3219     $self->_ApplyTransactionBatch;
3220
3221     $self->{_TransactionBatch} = [];
3222 }
3223
3224 sub _ApplyTransactionBatch {
3225     my $self = shift;
3226     my $batch = $self->TransactionBatch;
3227
3228     my %seen;
3229     my $types = join ',', grep !$seen{$_}++, grep defined, map $_->Type, grep defined, @{$batch};
3230
3231     require RT::Scrips;
3232     RT::Scrips->new($RT::SystemUser)->Apply(
3233         Stage          => 'TransactionBatch',
3234         TicketObj      => $self,
3235         TransactionObj => $batch->[0],
3236         Type           => $types,
3237     );
3238
3239     # Entry point of the rule system
3240     my $rules = RT::Ruleset->FindAllRules(
3241         Stage          => 'TransactionBatch',
3242         TicketObj      => $self,
3243         TransactionObj => $batch->[0],
3244         Type           => $types,
3245     );
3246     RT::Ruleset->CommitRules($rules);
3247 }
3248
3249 sub DESTROY {
3250     my $self = shift;
3251
3252     # DESTROY methods need to localize $@, or it may unset it.  This
3253     # causes $m->abort to not bubble all of the way up.  See perlbug
3254     # http://rt.perl.org/rt3/Ticket/Display.html?id=17650
3255     local $@;
3256
3257     # The following line eliminates reentrancy.
3258     # It protects against the fact that perl doesn't deal gracefully
3259     # when an object's refcount is changed in its destructor.
3260     return if $self->{_Destroyed}++;
3261
3262     my $batch = $self->TransactionBatch;
3263     return unless $batch && @$batch;
3264
3265     return $self->_ApplyTransactionBatch;
3266 }
3267
3268 # }}}
3269
3270 # {{{ PRIVATE UTILITY METHODS. Mostly needed so Ticket can be a DBIx::Record
3271
3272 # {{{ sub _OverlayAccessible
3273
3274 sub _OverlayAccessible {
3275     {
3276         EffectiveId       => { 'read' => 1,  'write' => 1,  'public' => 1 },
3277           Queue           => { 'read' => 1,  'write' => 1 },
3278           Requestors      => { 'read' => 1,  'write' => 1 },
3279           Owner           => { 'read' => 1,  'write' => 1 },
3280           Subject         => { 'read' => 1,  'write' => 1 },
3281           InitialPriority => { 'read' => 1,  'write' => 1 },
3282           FinalPriority   => { 'read' => 1,  'write' => 1 },
3283           Priority        => { 'read' => 1,  'write' => 1 },
3284           Status          => { 'read' => 1,  'write' => 1 },
3285           TimeEstimated      => { 'read' => 1,  'write' => 1 },
3286           TimeWorked      => { 'read' => 1,  'write' => 1 },
3287           TimeLeft        => { 'read' => 1,  'write' => 1 },
3288           Told            => { 'read' => 1,  'write' => 1 },
3289           Resolved        => { 'read' => 1 },
3290           Type            => { 'read' => 1 },
3291           Starts        => { 'read' => 1, 'write' => 1 },
3292           Started       => { 'read' => 1, 'write' => 1 },
3293           Due           => { 'read' => 1, 'write' => 1 },
3294           Creator       => { 'read' => 1, 'auto'  => 1 },
3295           Created       => { 'read' => 1, 'auto'  => 1 },
3296           LastUpdatedBy => { 'read' => 1, 'auto'  => 1 },
3297           LastUpdated   => { 'read' => 1, 'auto'  => 1 }
3298     };
3299
3300 }
3301
3302 # }}}
3303
3304 # {{{ sub _Set
3305
3306 sub _Set {
3307     my $self = shift;
3308
3309     my %args = ( Field             => undef,
3310                  Value             => undef,
3311                  TimeTaken         => 0,
3312                  RecordTransaction => 1,
3313                  UpdateTicket      => 1,
3314                  CheckACL          => 1,
3315                  TransactionType   => 'Set',
3316                  @_ );
3317
3318     if ($args{'CheckACL'}) {
3319       unless ( $self->CurrentUserHasRight('ModifyTicket')) {
3320           return ( 0, $self->loc("Permission Denied"));
3321       }
3322    }
3323
3324     unless ($args{'UpdateTicket'} || $args{'RecordTransaction'}) {
3325         $RT::Logger->error("Ticket->_Set called without a mandate to record an update or update the ticket");
3326         return(0, $self->loc("Internal Error"));
3327     }
3328
3329     #if the user is trying to modify the record
3330
3331     #Take care of the old value we really don't want to get in an ACL loop.
3332     # so ask the super::_Value
3333     my $Old = $self->SUPER::_Value("$args{'Field'}");
3334     
3335     my ($ret, $msg);
3336     if ( $args{'UpdateTicket'}  ) {
3337
3338         #Set the new value
3339         ( $ret, $msg ) = $self->SUPER::_Set( Field => $args{'Field'},
3340                                                 Value => $args{'Value'} );
3341     
3342         #If we can't actually set the field to the value, don't record
3343         # a transaction. instead, get out of here.
3344         return ( 0, $msg ) unless $ret;
3345     }
3346
3347     if ( $args{'RecordTransaction'} == 1 ) {
3348
3349         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
3350                                                Type => $args{'TransactionType'},
3351                                                Field     => $args{'Field'},
3352                                                NewValue  => $args{'Value'},
3353                                                OldValue  => $Old,
3354                                                TimeTaken => $args{'TimeTaken'},
3355         );
3356         return ( $Trans, scalar $TransObj->BriefDescription );
3357     }
3358     else {
3359         return ( $ret, $msg );
3360     }
3361 }
3362
3363 # }}}
3364
3365 # {{{ sub _Value 
3366
3367 =head2 _Value
3368
3369 Takes the name of a table column.
3370 Returns its value as a string, if the user passes an ACL check
3371
3372 =cut
3373
3374 sub _Value {
3375
3376     my $self  = shift;
3377     my $field = shift;
3378
3379     #if the field is public, return it.
3380     if ( $self->_Accessible( $field, 'public' ) ) {
3381
3382         #$RT::Logger->debug("Skipping ACL check for $field");
3383         return ( $self->SUPER::_Value($field) );
3384
3385     }
3386
3387     #If the current user doesn't have ACLs, don't let em at it.  
3388
3389     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
3390         return (undef);
3391     }
3392     return ( $self->SUPER::_Value($field) );
3393
3394 }
3395
3396 # }}}
3397
3398 # {{{ sub _UpdateTimeTaken
3399
3400 =head2 _UpdateTimeTaken
3401
3402 This routine will increment the timeworked counter. it should
3403 only be called from _NewTransaction 
3404
3405 =cut
3406
3407 sub _UpdateTimeTaken {
3408     my $self    = shift;
3409     my $Minutes = shift;
3410     my ($Total);
3411
3412     $Total = $self->SUPER::_Value("TimeWorked");
3413     $Total = ( $Total || 0 ) + ( $Minutes || 0 );
3414     $self->SUPER::_Set(
3415         Field => "TimeWorked",
3416         Value => $Total
3417     );
3418
3419     return ($Total);
3420 }
3421
3422 # }}}
3423
3424 # }}}
3425
3426 # {{{ Routines dealing with ACCESS CONTROL
3427
3428 # {{{ sub CurrentUserHasRight 
3429
3430 =head2 CurrentUserHasRight
3431
3432   Takes the textual name of a Ticket scoped right (from RT::ACE) and returns
3433 1 if the user has that right. It returns 0 if the user doesn't have that right.
3434
3435 =cut
3436
3437 sub CurrentUserHasRight {
3438     my $self  = shift;
3439     my $right = shift;
3440
3441     return $self->CurrentUser->PrincipalObj->HasRight(
3442         Object => $self,
3443         Right  => $right,
3444     )
3445 }
3446
3447 # }}}
3448
3449 # {{{ sub HasRight 
3450
3451 =head2 HasRight
3452
3453  Takes a paramhash with the attributes 'Right' and 'Principal'
3454   'Right' is a ticket-scoped textual right from RT::ACE 
3455   'Principal' is an RT::User object
3456
3457   Returns 1 if the principal has the right. Returns undef if not.
3458
3459 =cut
3460
3461 sub HasRight {
3462     my $self = shift;
3463     my %args = (
3464         Right     => undef,
3465         Principal => undef,
3466         @_
3467     );
3468
3469     unless ( ( defined $args{'Principal'} ) and ( ref( $args{'Principal'} ) ) )
3470     {
3471         Carp::cluck("Principal attrib undefined for Ticket::HasRight");
3472         $RT::Logger->crit("Principal attrib undefined for Ticket::HasRight");
3473         return(undef);
3474     }
3475
3476     return (
3477         $args{'Principal'}->HasRight(
3478             Object => $self,
3479             Right     => $args{'Right'}
3480           )
3481     );
3482 }
3483
3484 # }}}
3485
3486 # }}}
3487
3488 =head2 Reminders
3489
3490 Return the Reminders object for this ticket. (It's an RT::Reminders object.)
3491 It isn't acutally a searchbuilder collection itself.
3492
3493 =cut
3494
3495 sub Reminders {
3496     my $self = shift;
3497     
3498     unless ($self->{'__reminders'}) {
3499         $self->{'__reminders'} = RT::Reminders->new($self->CurrentUser);
3500         $self->{'__reminders'}->Ticket($self->id);
3501     }
3502     return $self->{'__reminders'};
3503
3504 }
3505
3506
3507
3508 # {{{ sub Transactions 
3509
3510 =head2 Transactions
3511
3512   Returns an RT::Transactions object of all transactions on this ticket
3513
3514 =cut
3515
3516 sub Transactions {
3517     my $self = shift;
3518
3519     my $transactions = RT::Transactions->new( $self->CurrentUser );
3520
3521     #If the user has no rights, return an empty object
3522     if ( $self->CurrentUserHasRight('ShowTicket') ) {
3523         $transactions->LimitToTicket($self->id);
3524
3525         # if the user may not see comments do not return them
3526         unless ( $self->CurrentUserHasRight('ShowTicketComments') ) {
3527             $transactions->Limit(
3528                 SUBCLAUSE => 'acl',
3529                 FIELD    => 'Type',
3530                 OPERATOR => '!=',
3531                 VALUE    => "Comment"
3532             );
3533             $transactions->Limit(
3534                 SUBCLAUSE => 'acl',
3535                 FIELD    => 'Type',
3536                 OPERATOR => '!=',
3537                 VALUE    => "CommentEmailRecord",
3538                 ENTRYAGGREGATOR => 'AND'
3539             );
3540
3541         }
3542     } else {
3543         $transactions->Limit(
3544             SUBCLAUSE => 'acl',
3545             FIELD    => 'id',
3546             VALUE    => 0,
3547             ENTRYAGGREGATOR => 'AND'
3548         );
3549     }
3550
3551     return ($transactions);
3552 }
3553
3554 # }}}
3555
3556
3557 # {{{ TransactionCustomFields
3558
3559 =head2 TransactionCustomFields
3560
3561     Returns the custom fields that transactions on tickets will have.
3562
3563 =cut
3564
3565 sub TransactionCustomFields {
3566     my $self = shift;
3567     return $self->QueueObj->TicketTransactionCustomFields;
3568 }
3569
3570 # }}}
3571
3572 # {{{ sub CustomFieldValues
3573
3574 =head2 CustomFieldValues
3575
3576 # Do name => id mapping (if needed) before falling back to
3577 # RT::Record's CustomFieldValues
3578
3579 See L<RT::Record>
3580
3581 =cut
3582
3583 sub CustomFieldValues {
3584     my $self  = shift;
3585     my $field = shift;
3586
3587     return $self->SUPER::CustomFieldValues( $field ) if !$field || $field =~ /^\d+$/;
3588
3589     my $cf = RT::CustomField->new( $self->CurrentUser );
3590     $cf->SetContextObject( $self );
3591     $cf->LoadByNameAndQueue( Name => $field, Queue => $self->Queue );
3592     unless ( $cf->id ) {
3593         $cf->LoadByNameAndQueue( Name => $field, Queue => 0 );
3594     }
3595
3596     # If we didn't find a valid cfid, give up.
3597     return RT::ObjectCustomFieldValues->new( $self->CurrentUser ) unless $cf->id;
3598
3599     return $self->SUPER::CustomFieldValues( $cf->id );
3600 }
3601
3602 # }}}
3603
3604 # {{{ sub CustomFieldLookupType
3605
3606 =head2 CustomFieldLookupType
3607
3608 Returns the RT::Ticket lookup type, which can be passed to 
3609 RT::CustomField->Create() via the 'LookupType' hash key.
3610
3611 =cut
3612
3613 # }}}
3614
3615 sub CustomFieldLookupType {
3616     "RT::Queue-RT::Ticket";
3617 }
3618
3619 =head2 ACLEquivalenceObjects
3620
3621 This method returns a list of objects for which a user's rights also apply
3622 to this ticket. Generally, this is only the ticket's queue, but some RT 
3623 extensions may make other objects available too.
3624
3625 This method is called from L<RT::Principal/HasRight>.
3626
3627 =cut
3628
3629 sub ACLEquivalenceObjects {
3630     my $self = shift;
3631     return $self->QueueObj;
3632
3633 }
3634
3635
3636 1;
3637
3638 =head1 AUTHOR
3639
3640 Jesse Vincent, jesse@bestpractical.com
3641
3642 =head1 SEE ALSO
3643
3644 RT
3645
3646 =cut
3647