import rt 3.8.8
[freeside.git] / rt / lib / RT / Ticket_Overlay.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2
3 # COPYRIGHT:
4
5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
6 #                                          <jesse@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   Parent => 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     my $watcher;
948     foreach $watcher ( @{ $args{'Cc'} } ) {
949         $self->_AddWatcher( Type => 'Cc', Email => $watcher, Silent => 1 );
950     }
951     foreach $watcher ( @{ $args{'AdminCc'} } ) {
952         $self->_AddWatcher( Type => 'AdminCc', Email => $watcher,
953             Silent => 1 );
954     }
955     foreach $watcher ( @{ $args{'Requestor'} } ) {
956         $self->_AddWatcher( Type => 'Requestor', Email => $watcher,
957             Silent => 1 );
958     }
959
960     return ( $self->Id, $ErrStr );
961 }
962
963 # }}}
964
965 # {{{ Routines dealing with watchers.
966
967 # {{{ _CreateTicketGroups 
968
969 =head2 _CreateTicketGroups
970
971 Create the ticket groups and links for this ticket. 
972 This routine expects to be called from Ticket->Create _inside of a transaction_
973
974 It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner.
975
976 It will return true on success and undef on failure.
977
978
979 =cut
980
981
982 sub _CreateTicketGroups {
983     my $self = shift;
984     
985     my @types = qw(Requestor Owner Cc AdminCc);
986
987     foreach my $type (@types) {
988         my $type_obj = RT::Group->new($self->CurrentUser);
989         my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role',
990                                                        Instance => $self->Id, 
991                                                        Type => $type);
992         unless ($id) {
993             $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ".
994                                $self->Id.": ".$msg);     
995             return(undef);
996         }
997      }
998     return(1);
999     
1000 }
1001
1002 # }}}
1003
1004 # {{{ sub OwnerGroup
1005
1006 =head2 OwnerGroup
1007
1008 A constructor which returns an RT::Group object containing the owner of this ticket.
1009
1010 =cut
1011
1012 sub OwnerGroup {
1013     my $self = shift;
1014     my $owner_obj = RT::Group->new($self->CurrentUser);
1015     $owner_obj->LoadTicketRoleGroup( Ticket => $self->Id,  Type => 'Owner');
1016     return ($owner_obj);
1017 }
1018
1019 # }}}
1020
1021
1022 # {{{ sub AddWatcher
1023
1024 =head2 AddWatcher
1025
1026 AddWatcher takes a parameter hash. The keys are as follows:
1027
1028 Type        One of Requestor, Cc, AdminCc
1029
1030 PrincipalId The RT::Principal id of the user or group that's being added as a watcher
1031
1032 Email       The email address of the new watcher. If a user with this 
1033             email address can't be found, a new nonprivileged user will be created.
1034
1035 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.
1036
1037 =cut
1038
1039 sub AddWatcher {
1040     my $self = shift;
1041     my %args = (
1042         Type  => undef,
1043         PrincipalId => undef,
1044         Email => undef,
1045         @_
1046     );
1047
1048     # ModifyTicket works in any case
1049     return $self->_AddWatcher( %args )
1050         if $self->CurrentUserHasRight('ModifyTicket');
1051     if ( $args{'Email'} ) {
1052         my ($addr) = RT::EmailParser->ParseEmailAddress( $args{'Email'} );
1053         return (0, $self->loc("Couldn't parse address from '[_1]' string", $args{'Email'} ))
1054             unless $addr;
1055
1056         if ( lc $self->CurrentUser->UserObj->EmailAddress
1057             eq lc RT::User->CanonicalizeEmailAddress( $addr->address ) )
1058         {
1059             $args{'PrincipalId'} = $self->CurrentUser->id;
1060             delete $args{'Email'};
1061         }
1062     }
1063
1064     # If the watcher isn't the current user then the current user has no right
1065     # bail
1066     unless ( $args{'PrincipalId'} && $self->CurrentUser->id == $args{'PrincipalId'} ) {
1067         return ( 0, $self->loc("Permission Denied") );
1068     }
1069
1070     #  If it's an AdminCc and they don't have 'WatchAsAdminCc', bail
1071     if ( $args{'Type'} eq 'AdminCc' ) {
1072         unless ( $self->CurrentUserHasRight('WatchAsAdminCc') ) {
1073             return ( 0, $self->loc('Permission Denied') );
1074         }
1075     }
1076
1077     #  If it's a Requestor or Cc and they don't have 'Watch', bail
1078     elsif ( $args{'Type'} eq 'Cc' || $args{'Type'} eq 'Requestor' ) {
1079         unless ( $self->CurrentUserHasRight('Watch') ) {
1080             return ( 0, $self->loc('Permission Denied') );
1081         }
1082     }
1083     else {
1084         $RT::Logger->warning( "AddWatcher got passed a bogus type");
1085         return ( 0, $self->loc('Error in parameters to Ticket->AddWatcher') );
1086     }
1087
1088     return $self->_AddWatcher( %args );
1089 }
1090
1091 #This contains the meat of AddWatcher. but can be called from a routine like
1092 # Create, which doesn't need the additional acl check
1093 sub _AddWatcher {
1094     my $self = shift;
1095     my %args = (
1096         Type   => undef,
1097         Silent => undef,
1098         PrincipalId => undef,
1099         Email => undef,
1100         @_
1101     );
1102
1103
1104     my $principal = RT::Principal->new($self->CurrentUser);
1105     if ($args{'Email'}) {
1106         if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) {
1107             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'})));
1108         }
1109         my $user = RT::User->new($RT::SystemUser);
1110         my ($pid, $msg) = $user->LoadOrCreateByEmail( $args{'Email'} );
1111         $args{'PrincipalId'} = $pid if $pid; 
1112     }
1113     if ($args{'PrincipalId'}) {
1114         $principal->Load($args{'PrincipalId'});
1115         if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) {
1116             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'})))
1117                 if RT::EmailParser->IsRTAddress( $email );
1118
1119         }
1120     } 
1121
1122  
1123     # If we can't find this watcher, we need to bail.
1124     unless ($principal->Id) {
1125             $RT::Logger->error("Could not load create a user with the email address '".$args{'Email'}. "' to add as a watcher for ticket ".$self->Id);
1126         return(0, $self->loc("Could not find or create that user"));
1127     }
1128
1129
1130     my $group = RT::Group->new($self->CurrentUser);
1131     $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->Id);
1132     unless ($group->id) {
1133         return(0,$self->loc("Group not found"));
1134     }
1135
1136     if ( $group->HasMember( $principal)) {
1137
1138         return ( 0, $self->loc('That principal is already a [_1] for this ticket', $self->loc($args{'Type'})) );
1139     }
1140
1141
1142     my ( $m_id, $m_msg ) = $group->_AddMember( PrincipalId => $principal->Id,
1143                                                InsideTransaction => 1 );
1144     unless ($m_id) {
1145         $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg);
1146
1147         return ( 0, $self->loc('Could not make that principal a [_1] for this ticket', $self->loc($args{'Type'})) );
1148     }
1149
1150     unless ( $args{'Silent'} ) {
1151         $self->_NewTransaction(
1152             Type     => 'AddWatcher',
1153             NewValue => $principal->Id,
1154             Field    => $args{'Type'}
1155         );
1156     }
1157
1158         return ( 1, $self->loc('Added principal as a [_1] for this ticket', $self->loc($args{'Type'})) );
1159 }
1160
1161 # }}}
1162
1163
1164 # {{{ sub DeleteWatcher
1165
1166 =head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS }
1167
1168
1169 Deletes a Ticket watcher.  Takes two arguments:
1170
1171 Type  (one of Requestor,Cc,AdminCc)
1172
1173 and one of
1174
1175 PrincipalId (an RT::Principal Id of the watcher you want to remove)
1176     OR
1177 Email (the email address of an existing wathcer)
1178
1179
1180 =cut
1181
1182
1183 sub DeleteWatcher {
1184     my $self = shift;
1185
1186     my %args = ( Type        => undef,
1187                  PrincipalId => undef,
1188                  Email       => undef,
1189                  @_ );
1190
1191     unless ( $args{'PrincipalId'} || $args{'Email'} ) {
1192         return ( 0, $self->loc("No principal specified") );
1193     }
1194     my $principal = RT::Principal->new( $self->CurrentUser );
1195     if ( $args{'PrincipalId'} ) {
1196
1197         $principal->Load( $args{'PrincipalId'} );
1198     }
1199     else {
1200         my $user = RT::User->new( $self->CurrentUser );
1201         $user->LoadByEmail( $args{'Email'} );
1202         $principal->Load( $user->Id );
1203     }
1204
1205     # If we can't find this watcher, we need to bail.
1206     unless ( $principal->Id ) {
1207         return ( 0, $self->loc("Could not find that principal") );
1208     }
1209
1210     my $group = RT::Group->new( $self->CurrentUser );
1211     $group->LoadTicketRoleGroup( Type => $args{'Type'}, Ticket => $self->Id );
1212     unless ( $group->id ) {
1213         return ( 0, $self->loc("Group not found") );
1214     }
1215
1216     # {{{ Check ACLS
1217     #If the watcher we're trying to add is for the current user
1218     if ( $self->CurrentUser->PrincipalId == $principal->id ) {
1219
1220         #  If it's an AdminCc and they don't have
1221         #   'WatchAsAdminCc' or 'ModifyTicket', bail
1222         if ( $args{'Type'} eq 'AdminCc' ) {
1223             unless (    $self->CurrentUserHasRight('ModifyTicket')
1224                      or $self->CurrentUserHasRight('WatchAsAdminCc') ) {
1225                 return ( 0, $self->loc('Permission Denied') );
1226             }
1227         }
1228
1229         #  If it's a Requestor or Cc and they don't have
1230         #   'Watch' or 'ModifyTicket', bail
1231         elsif ( ( $args{'Type'} eq 'Cc' ) or ( $args{'Type'} eq 'Requestor' ) )
1232         {
1233             unless (    $self->CurrentUserHasRight('ModifyTicket')
1234                      or $self->CurrentUserHasRight('Watch') ) {
1235                 return ( 0, $self->loc('Permission Denied') );
1236             }
1237         }
1238         else {
1239             $RT::Logger->warn("$self -> DeleteWatcher got passed a bogus type");
1240             return ( 0,
1241                      $self->loc('Error in parameters to Ticket->DeleteWatcher') );
1242         }
1243     }
1244
1245     # If the watcher isn't the current user
1246     # and the current user  doesn't have 'ModifyTicket' bail
1247     else {
1248         unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1249             return ( 0, $self->loc("Permission Denied") );
1250         }
1251     }
1252
1253     # }}}
1254
1255     # see if this user is already a watcher.
1256
1257     unless ( $group->HasMember($principal) ) {
1258         return ( 0,
1259                  $self->loc( 'That principal is not a [_1] for this ticket',
1260                              $args{'Type'} ) );
1261     }
1262
1263     my ( $m_id, $m_msg ) = $group->_DeleteMember( $principal->Id );
1264     unless ($m_id) {
1265         $RT::Logger->error( "Failed to delete "
1266                             . $principal->Id
1267                             . " as a member of group "
1268                             . $group->Id . ": "
1269                             . $m_msg );
1270
1271         return (0,
1272                 $self->loc(
1273                     'Could not remove that principal as a [_1] for this ticket',
1274                     $args{'Type'} ) );
1275     }
1276
1277     unless ( $args{'Silent'} ) {
1278         $self->_NewTransaction( Type     => 'DelWatcher',
1279                                 OldValue => $principal->Id,
1280                                 Field    => $args{'Type'} );
1281     }
1282
1283     return ( 1,
1284              $self->loc( "[_1] is no longer a [_2] for this ticket.",
1285                          $principal->Object->Name,
1286                          $args{'Type'} ) );
1287 }
1288
1289
1290
1291 # }}}
1292
1293
1294 =head2 SquelchMailTo [EMAIL]
1295
1296 Takes an optional email address to never email about updates to this ticket.
1297
1298
1299 Returns an array of the RT::Attribute objects for this ticket's 'SquelchMailTo' attributes.
1300
1301
1302 =cut
1303
1304 sub SquelchMailTo {
1305     my $self = shift;
1306     if (@_) {
1307         unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1308             return undef;
1309         }
1310     } else {
1311         unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1312             return undef;
1313         }
1314
1315     }
1316     return $self->_SquelchMailTo(@_);
1317 }
1318
1319 sub _SquelchMailTo {
1320     my $self = shift;
1321     if (@_) {
1322         my $attr = shift;
1323         $self->AddAttribute( Name => 'SquelchMailTo', Content => $attr )
1324             unless grep { $_->Content eq $attr }
1325                 $self->Attributes->Named('SquelchMailTo');
1326     }
1327     my @attributes = $self->Attributes->Named('SquelchMailTo');
1328     return (@attributes);
1329 }
1330
1331
1332 =head2 UnsquelchMailTo ADDRESS
1333
1334 Takes an address and removes it from this ticket's "SquelchMailTo" list. If an address appears multiple times, each instance is removed.
1335
1336 Returns a tuple of (status, message)
1337
1338 =cut
1339
1340 sub UnsquelchMailTo {
1341     my $self = shift;
1342
1343     my $address = shift;
1344     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1345         return ( 0, $self->loc("Permission Denied") );
1346     }
1347
1348     my ($val, $msg) = $self->Attributes->DeleteEntry ( Name => 'SquelchMailTo', Content => $address);
1349     return ($val, $msg);
1350 }
1351
1352
1353 # {{{ a set of  [foo]AsString subs that will return the various sorts of watchers for a ticket/queue as a comma delineated string
1354
1355 =head2 RequestorAddresses
1356
1357  B<Returns> String: All Ticket Requestor email addresses as a string.
1358
1359 =cut
1360
1361 sub RequestorAddresses {
1362     my $self = shift;
1363
1364     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1365         return undef;
1366     }
1367
1368     return ( $self->Requestors->MemberEmailAddressesAsString );
1369 }
1370
1371
1372 =head2 AdminCcAddresses
1373
1374 returns String: All Ticket AdminCc email addresses as a string
1375
1376 =cut
1377
1378 sub AdminCcAddresses {
1379     my $self = shift;
1380
1381     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1382         return undef;
1383     }
1384
1385     return ( $self->AdminCc->MemberEmailAddressesAsString )
1386
1387 }
1388
1389 =head2 CcAddresses
1390
1391 returns String: All Ticket Ccs as a string of email addresses
1392
1393 =cut
1394
1395 sub CcAddresses {
1396     my $self = shift;
1397
1398     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1399         return undef;
1400     }
1401     return ( $self->Cc->MemberEmailAddressesAsString);
1402
1403 }
1404
1405 # }}}
1406
1407 # {{{ Routines that return RT::Watchers objects of Requestors, Ccs and AdminCcs
1408
1409 # {{{ sub Requestors
1410
1411 =head2 Requestors
1412
1413 Takes nothing.
1414 Returns this ticket's Requestors as an RT::Group object
1415
1416 =cut
1417
1418 sub Requestors {
1419     my $self = shift;
1420
1421     my $group = RT::Group->new($self->CurrentUser);
1422     if ( $self->CurrentUserHasRight('ShowTicket') ) {
1423         $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id);
1424     }
1425     return ($group);
1426
1427 }
1428
1429 # }}}
1430
1431 # {{{ sub Cc
1432
1433 =head2 Cc
1434
1435 Takes nothing.
1436 Returns an RT::Group object which contains this ticket's Ccs.
1437 If the user doesn't have "ShowTicket" permission, returns an empty group
1438
1439 =cut
1440
1441 sub Cc {
1442     my $self = shift;
1443
1444     my $group = RT::Group->new($self->CurrentUser);
1445     if ( $self->CurrentUserHasRight('ShowTicket') ) {
1446         $group->LoadTicketRoleGroup(Type => 'Cc', Ticket => $self->Id);
1447     }
1448     return ($group);
1449
1450 }
1451
1452 # }}}
1453
1454 # {{{ sub AdminCc
1455
1456 =head2 AdminCc
1457
1458 Takes nothing.
1459 Returns an RT::Group object which contains this ticket's AdminCcs.
1460 If the user doesn't have "ShowTicket" permission, returns an empty group
1461
1462 =cut
1463
1464 sub AdminCc {
1465     my $self = shift;
1466
1467     my $group = RT::Group->new($self->CurrentUser);
1468     if ( $self->CurrentUserHasRight('ShowTicket') ) {
1469         $group->LoadTicketRoleGroup(Type => 'AdminCc', Ticket => $self->Id);
1470     }
1471     return ($group);
1472
1473 }
1474
1475 # }}}
1476
1477 # }}}
1478
1479 # {{{ IsWatcher,IsRequestor,IsCc, IsAdminCc
1480
1481 # {{{ sub IsWatcher
1482 # a generic routine to be called by IsRequestor, IsCc and IsAdminCc
1483
1484 =head2 IsWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL }
1485
1486 Takes a param hash with the attributes Type and either PrincipalId or Email
1487
1488 Type is one of Requestor, Cc, AdminCc and Owner
1489
1490 PrincipalId is an RT::Principal id, and Email is an email address.
1491
1492 Returns true if the specified principal (or the one corresponding to the
1493 specified address) is a member of the group Type for this ticket.
1494
1495 XX TODO: This should be Memoized. 
1496
1497 =cut
1498
1499 sub IsWatcher {
1500     my $self = shift;
1501
1502     my %args = ( Type  => 'Requestor',
1503         PrincipalId    => undef,
1504         Email          => undef,
1505         @_
1506     );
1507
1508     # Load the relevant group. 
1509     my $group = RT::Group->new($self->CurrentUser);
1510     $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->id);
1511
1512     # Find the relevant principal.
1513     if (!$args{PrincipalId} && $args{Email}) {
1514         # Look up the specified user.
1515         my $user = RT::User->new($self->CurrentUser);
1516         $user->LoadByEmail($args{Email});
1517         if ($user->Id) {
1518             $args{PrincipalId} = $user->PrincipalId;
1519         }
1520         else {
1521             # A non-existent user can't be a group member.
1522             return 0;
1523         }
1524     }
1525
1526     # Ask if it has the member in question
1527     return $group->HasMember( $args{'PrincipalId'} );
1528 }
1529
1530 # }}}
1531
1532 # {{{ sub IsRequestor
1533
1534 =head2 IsRequestor PRINCIPAL_ID
1535   
1536 Takes an L<RT::Principal> id.
1537
1538 Returns true if the principal is a requestor of the current ticket.
1539
1540 =cut
1541
1542 sub IsRequestor {
1543     my $self   = shift;
1544     my $person = shift;
1545
1546     return ( $self->IsWatcher( Type => 'Requestor', PrincipalId => $person ) );
1547
1548 };
1549
1550 # }}}
1551
1552 # {{{ sub IsCc
1553
1554 =head2 IsCc PRINCIPAL_ID
1555
1556   Takes an RT::Principal id.
1557   Returns true if the principal is a Cc of the current ticket.
1558
1559
1560 =cut
1561
1562 sub IsCc {
1563     my $self = shift;
1564     my $cc   = shift;
1565
1566     return ( $self->IsWatcher( Type => 'Cc', PrincipalId => $cc ) );
1567
1568 }
1569
1570 # }}}
1571
1572 # {{{ sub IsAdminCc
1573
1574 =head2 IsAdminCc PRINCIPAL_ID
1575
1576   Takes an RT::Principal id.
1577   Returns true if the principal is an AdminCc of the current ticket.
1578
1579 =cut
1580
1581 sub IsAdminCc {
1582     my $self   = shift;
1583     my $person = shift;
1584
1585     return ( $self->IsWatcher( Type => 'AdminCc', PrincipalId => $person ) );
1586
1587 }
1588
1589 # }}}
1590
1591 # {{{ sub IsOwner
1592
1593 =head2 IsOwner
1594
1595   Takes an RT::User object. Returns true if that user is this ticket's owner.
1596 returns undef otherwise
1597
1598 =cut
1599
1600 sub IsOwner {
1601     my $self   = shift;
1602     my $person = shift;
1603
1604     # no ACL check since this is used in acl decisions
1605     # unless ($self->CurrentUserHasRight('ShowTicket')) {
1606     #    return(undef);
1607     #   }    
1608
1609     #Tickets won't yet have owners when they're being created.
1610     unless ( $self->OwnerObj->id ) {
1611         return (undef);
1612     }
1613
1614     if ( $person->id == $self->OwnerObj->id ) {
1615         return (1);
1616     }
1617     else {
1618         return (undef);
1619     }
1620 }
1621
1622 # }}}
1623
1624 # }}}
1625
1626 # }}}
1627
1628
1629 =head2 TransactionAddresses
1630
1631 Returns a composite hashref of the results of L<RT::Transaction/Addresses> for
1632 all this ticket's Create, Comment or Correspond transactions. The keys are
1633 stringified email addresses. Each value is an L<Email::Address> object.
1634
1635 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.
1636
1637 =cut
1638
1639
1640 sub TransactionAddresses {
1641     my $self = shift;
1642     my $txns = $self->Transactions;
1643
1644     my %addresses = ();
1645     foreach my $type (qw(Create Comment Correspond)) {
1646     $txns->Limit(FIELD => 'Type', OPERATOR => '=', VALUE => $type , ENTRYAGGREGATOR => 'OR', CASESENSITIVE => 1);
1647         }
1648
1649     while (my $txn = $txns->Next) {
1650         my $txnaddrs = $txn->Addresses; 
1651         foreach my $addrlist ( values %$txnaddrs ) {
1652                 foreach my $addr (@$addrlist) {
1653                     # Skip addresses without a phrase (things that are just raw addresses) if we have a phrase
1654                     next if ($addresses{$addr->address} && $addresses{$addr->address}->phrase && not $addr->phrase);
1655                     # skips "comment-only" addresses
1656                     next unless ($addr->address);
1657                     $addresses{$addr->address} = $addr;
1658                 }
1659         }
1660     }
1661
1662     return \%addresses;
1663
1664 }
1665
1666
1667
1668
1669 # {{{ Routines dealing with queues 
1670
1671 # {{{ sub ValidateQueue
1672
1673 sub ValidateQueue {
1674     my $self  = shift;
1675     my $Value = shift;
1676
1677     if ( !$Value ) {
1678         $RT::Logger->warning( " RT:::Queue::ValidateQueue called with a null value. this isn't ok.");
1679         return (1);
1680     }
1681
1682     my $QueueObj = RT::Queue->new( $self->CurrentUser );
1683     my $id       = $QueueObj->Load($Value);
1684
1685     if ($id) {
1686         return (1);
1687     }
1688     else {
1689         return (undef);
1690     }
1691 }
1692
1693 # }}}
1694
1695 # {{{ sub SetQueue  
1696
1697 sub SetQueue {
1698     my $self     = shift;
1699     my $NewQueue = shift;
1700
1701     #Redundant. ACL gets checked in _Set;
1702     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1703         return ( 0, $self->loc("Permission Denied") );
1704     }
1705
1706     my $NewQueueObj = RT::Queue->new( $self->CurrentUser );
1707     $NewQueueObj->Load($NewQueue);
1708
1709     unless ( $NewQueueObj->Id() ) {
1710         return ( 0, $self->loc("That queue does not exist") );
1711     }
1712
1713     if ( $NewQueueObj->Id == $self->QueueObj->Id ) {
1714         return ( 0, $self->loc('That is the same value') );
1715     }
1716     unless (
1717         $self->CurrentUser->HasRight(
1718             Right    => 'CreateTicket',
1719             Object => $NewQueueObj
1720         )
1721       )
1722     {
1723         return ( 0, $self->loc("You may not create requests in that queue.") );
1724     }
1725
1726     unless (
1727         $self->OwnerObj->HasRight(
1728             Right    => 'OwnTicket',
1729             Object => $NewQueueObj
1730         )
1731       )
1732     {
1733         my $clone = RT::Ticket->new( $RT::SystemUser );
1734         $clone->Load( $self->Id );
1735         unless ( $clone->Id ) {
1736             return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) );
1737         }
1738         my ($status, $msg) = $clone->SetOwner( $RT::Nobody->Id, 'Force' );
1739         $RT::Logger->error("Couldn't set owner on queue change: $msg") unless $status;
1740     }
1741
1742     my ($status, $msg) = $self->_Set( Field => 'Queue', Value => $NewQueueObj->Id() );
1743
1744     if ( $status ) {
1745         # On queue change, change queue for reminders too
1746         my $reminder_collection = $self->Reminders->Collection;
1747         while ( my $reminder = $reminder_collection->Next ) {
1748             my ($status, $msg) = $reminder->SetQueue($NewQueue);
1749             $RT::Logger->error('Queue change failed for reminder #' . $reminder->Id . ': ' . $msg) unless $status;
1750         }
1751     }
1752     
1753     return ($status, $msg);
1754 }
1755
1756 # }}}
1757
1758 # {{{ sub QueueObj
1759
1760 =head2 QueueObj
1761
1762 Takes nothing. returns this ticket's queue object
1763
1764 =cut
1765
1766 sub QueueObj {
1767     my $self = shift;
1768
1769     my $queue_obj = RT::Queue->new( $self->CurrentUser );
1770
1771     #We call __Value so that we can avoid the ACL decision and some deep recursion
1772     my ($result) = $queue_obj->Load( $self->__Value('Queue') );
1773     return ($queue_obj);
1774 }
1775
1776 # }}}
1777
1778 # }}}
1779
1780 # {{{ Date printing routines
1781
1782 # {{{ sub DueObj
1783
1784 =head2 DueObj
1785
1786   Returns an RT::Date object containing this ticket's due date
1787
1788 =cut
1789
1790 sub DueObj {
1791     my $self = shift;
1792
1793     my $time = new RT::Date( $self->CurrentUser );
1794
1795     # -1 is RT::Date slang for never
1796     if ( my $due = $self->Due ) {
1797         $time->Set( Format => 'sql', Value => $due );
1798     }
1799     else {
1800         $time->Set( Format => 'unix', Value => -1 );
1801     }
1802
1803     return $time;
1804 }
1805
1806 # }}}
1807
1808 # {{{ sub DueAsString 
1809
1810 =head2 DueAsString
1811
1812 Returns this ticket's due date as a human readable string
1813
1814 =cut
1815
1816 sub DueAsString {
1817     my $self = shift;
1818     return $self->DueObj->AsString();
1819 }
1820
1821 # }}}
1822
1823 # {{{ sub ResolvedObj
1824
1825 =head2 ResolvedObj
1826
1827   Returns an RT::Date object of this ticket's 'resolved' time.
1828
1829 =cut
1830
1831 sub ResolvedObj {
1832     my $self = shift;
1833
1834     my $time = new RT::Date( $self->CurrentUser );
1835     $time->Set( Format => 'sql', Value => $self->Resolved );
1836     return $time;
1837 }
1838
1839 # }}}
1840
1841 # {{{ sub SetStarted
1842
1843 =head2 SetStarted
1844
1845 Takes a date in ISO format or undef
1846 Returns a transaction id and a message
1847 The client calls "Start" to note that the project was started on the date in $date.
1848 A null date means "now"
1849
1850 =cut
1851
1852 sub SetStarted {
1853     my $self = shift;
1854     my $time = shift || 0;
1855
1856     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
1857         return ( 0, $self->loc("Permission Denied") );
1858     }
1859
1860     #We create a date object to catch date weirdness
1861     my $time_obj = new RT::Date( $self->CurrentUser() );
1862     if ( $time ) {
1863         $time_obj->Set( Format => 'ISO', Value => $time );
1864     }
1865     else {
1866         $time_obj->SetToNow();
1867     }
1868
1869     #Now that we're starting, open this ticket
1870     #TODO do we really want to force this as policy? it should be a scrip
1871
1872     #We need $TicketAsSystem, in case the current user doesn't have
1873     #ShowTicket
1874     #
1875     my $TicketAsSystem = new RT::Ticket($RT::SystemUser);
1876     $TicketAsSystem->Load( $self->Id );
1877     if ( $TicketAsSystem->Status eq 'new' ) {
1878         $TicketAsSystem->Open();
1879     }
1880
1881     return ( $self->_Set( Field => 'Started', Value => $time_obj->ISO ) );
1882
1883 }
1884
1885 # }}}
1886
1887 # {{{ sub StartedObj
1888
1889 =head2 StartedObj
1890
1891   Returns an RT::Date object which contains this ticket's 
1892 'Started' time.
1893
1894 =cut
1895
1896 sub StartedObj {
1897     my $self = shift;
1898
1899     my $time = new RT::Date( $self->CurrentUser );
1900     $time->Set( Format => 'sql', Value => $self->Started );
1901     return $time;
1902 }
1903
1904 # }}}
1905
1906 # {{{ sub StartsObj
1907
1908 =head2 StartsObj
1909
1910   Returns an RT::Date object which contains this ticket's 
1911 'Starts' time.
1912
1913 =cut
1914
1915 sub StartsObj {
1916     my $self = shift;
1917
1918     my $time = new RT::Date( $self->CurrentUser );
1919     $time->Set( Format => 'sql', Value => $self->Starts );
1920     return $time;
1921 }
1922
1923 # }}}
1924
1925 # {{{ sub ToldObj
1926
1927 =head2 ToldObj
1928
1929   Returns an RT::Date object which contains this ticket's 
1930 'Told' time.
1931
1932 =cut
1933
1934 sub ToldObj {
1935     my $self = shift;
1936
1937     my $time = new RT::Date( $self->CurrentUser );
1938     $time->Set( Format => 'sql', Value => $self->Told );
1939     return $time;
1940 }
1941
1942 # }}}
1943
1944 # {{{ sub ToldAsString
1945
1946 =head2 ToldAsString
1947
1948 A convenience method that returns ToldObj->AsString
1949
1950 TODO: This should be deprecated
1951
1952 =cut
1953
1954 sub ToldAsString {
1955     my $self = shift;
1956     if ( $self->Told ) {
1957         return $self->ToldObj->AsString();
1958     }
1959     else {
1960         return ("Never");
1961     }
1962 }
1963
1964 # }}}
1965
1966 # {{{ sub TimeWorkedAsString
1967
1968 =head2 TimeWorkedAsString
1969
1970 Returns the amount of time worked on this ticket as a Text String
1971
1972 =cut
1973
1974 sub TimeWorkedAsString {
1975     my $self = shift;
1976     my $value = $self->TimeWorked;
1977
1978     # return the # of minutes worked turned into seconds and written as
1979     # a simple text string, this is not really a date object, but if we
1980     # diff a number of seconds vs the epoch, we'll get a nice description
1981     # of time worked.
1982     return "" unless $value;
1983     return RT::Date->new( $self->CurrentUser )
1984         ->DurationAsString( $value * 60 );
1985 }
1986
1987 # }}}
1988
1989 # {{{ sub TimeLeftAsString
1990
1991 =head2  TimeLeftAsString
1992
1993 Returns the amount of time left on this ticket as a Text String
1994
1995 =cut
1996
1997 sub TimeLeftAsString {
1998     my $self = shift;
1999     my $value = $self->TimeLeft;
2000     return "" unless $value;
2001     return RT::Date->new( $self->CurrentUser )
2002         ->DurationAsString( $value * 60 );
2003 }
2004
2005 # }}}
2006
2007 # {{{ Routines dealing with correspondence/comments
2008
2009 # {{{ sub Comment
2010
2011 =head2 Comment
2012
2013 Comment on this ticket.
2014 Takes a hash with the following attributes:
2015 If MIMEObj is undefined, Content will be used to build a MIME::Entity for this
2016 comment.
2017
2018 MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun
2019
2020 If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed.
2021 They will, however, be prepared and you'll be able to access them through the TransactionObj
2022
2023 Returns: Transaction id, Error Message, Transaction Object
2024 (note the different order from Create()!)
2025
2026 =cut
2027
2028 sub Comment {
2029     my $self = shift;
2030
2031     my %args = ( CcMessageTo  => undef,
2032                  BccMessageTo => undef,
2033                  MIMEObj      => undef,
2034                  Content      => undef,
2035                  TimeTaken => 0,
2036                  DryRun     => 0, 
2037                  @_ );
2038
2039     unless (    ( $self->CurrentUserHasRight('CommentOnTicket') )
2040              or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
2041         return ( 0, $self->loc("Permission Denied"), undef );
2042     }
2043     $args{'NoteType'} = 'Comment';
2044
2045     if ($args{'DryRun'}) {
2046         $RT::Handle->BeginTransaction();
2047         $args{'CommitScrips'} = 0;
2048     }
2049
2050     my @results = $self->_RecordNote(%args);
2051     if ($args{'DryRun'}) {
2052         $RT::Handle->Rollback();
2053     }
2054
2055     return(@results);
2056 }
2057 # }}}
2058
2059 # {{{ sub Correspond
2060
2061 =head2 Correspond
2062
2063 Correspond on this ticket.
2064 Takes a hashref with the following attributes:
2065
2066
2067 MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun
2068
2069 if there's no MIMEObj, Content is used to build a MIME::Entity object
2070
2071 If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed.
2072 They will, however, be prepared and you'll be able to access them through the TransactionObj
2073
2074 Returns: Transaction id, Error Message, Transaction Object
2075 (note the different order from Create()!)
2076
2077
2078 =cut
2079
2080 sub Correspond {
2081     my $self = shift;
2082     my %args = ( CcMessageTo  => undef,
2083                  BccMessageTo => undef,
2084                  MIMEObj      => undef,
2085                  Content      => undef,
2086                  TimeTaken    => 0,
2087                  @_ );
2088
2089     unless (    ( $self->CurrentUserHasRight('ReplyToTicket') )
2090              or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
2091         return ( 0, $self->loc("Permission Denied"), undef );
2092     }
2093
2094     $args{'NoteType'} = 'Correspond'; 
2095     if ($args{'DryRun'}) {
2096         $RT::Handle->BeginTransaction();
2097         $args{'CommitScrips'} = 0;
2098     }
2099
2100     my @results = $self->_RecordNote(%args);
2101
2102     #Set the last told date to now if this isn't mail from the requestor.
2103     #TODO: Note that this will wrongly ack mail from any non-requestor as a "told"
2104     $self->_SetTold unless ( $self->IsRequestor($self->CurrentUser->id));
2105
2106     if ($args{'DryRun'}) {
2107         $RT::Handle->Rollback();
2108     }
2109
2110     return (@results);
2111
2112 }
2113
2114 # }}}
2115
2116 # {{{ sub _RecordNote
2117
2118 =head2 _RecordNote
2119
2120 the meat of both comment and correspond. 
2121
2122 Performs no access control checks. hence, dangerous.
2123
2124 =cut
2125
2126 sub _RecordNote {
2127     my $self = shift;
2128     my %args = ( 
2129         CcMessageTo  => undef,
2130         BccMessageTo => undef,
2131         Encrypt      => undef,
2132         Sign         => undef,
2133         MIMEObj      => undef,
2134         Content      => undef,
2135         NoteType     => 'Correspond',
2136         TimeTaken    => 0,
2137         CommitScrips => 1,
2138         @_
2139     );
2140
2141     unless ( $args{'MIMEObj'} || $args{'Content'} ) {
2142         return ( 0, $self->loc("No message attached"), undef );
2143     }
2144
2145     unless ( $args{'MIMEObj'} ) {
2146         $args{'MIMEObj'} = MIME::Entity->build(
2147             Data => ( ref $args{'Content'}? $args{'Content'}: [ $args{'Content'} ] )
2148         );
2149     }
2150
2151     # convert text parts into utf-8
2152     RT::I18N::SetMIMEEntityToUTF8( $args{'MIMEObj'} );
2153
2154     # If we've been passed in CcMessageTo and BccMessageTo fields,
2155     # add them to the mime object for passing on to the transaction handler
2156     # The "NotifyOtherRecipients" scripAction will look for RT-Send-Cc: and
2157     # RT-Send-Bcc: headers
2158
2159
2160     foreach my $type (qw/Cc Bcc/) {
2161         if ( defined $args{ $type . 'MessageTo' } ) {
2162
2163             my $addresses = join ', ', (
2164                 map { RT::User->CanonicalizeEmailAddress( $_->address ) }
2165                     Email::Address->parse( $args{ $type . 'MessageTo' } ) );
2166             $args{'MIMEObj'}->head->add( 'RT-Send-' . $type, Encode::encode_utf8( $addresses ) );
2167         }
2168     }
2169
2170     foreach my $argument (qw(Encrypt Sign)) {
2171         $args{'MIMEObj'}->head->add(
2172             "X-RT-$argument" => Encode::encode_utf8( $args{ $argument } )
2173         ) if defined $args{ $argument };
2174     }
2175
2176     # If this is from an external source, we need to come up with its
2177     # internal Message-ID now, so all emails sent because of this
2178     # message have a common Message-ID
2179     my $org = RT->Config->Get('Organization');
2180     my $msgid = $args{'MIMEObj'}->head->get('Message-ID');
2181     unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) {
2182         $args{'MIMEObj'}->head->set(
2183             'RT-Message-ID' => RT::Interface::Email::GenMessageId( Ticket => $self )
2184         );
2185     }
2186
2187     #Record the correspondence (write the transaction)
2188     my ( $Trans, $msg, $TransObj ) = $self->_NewTransaction(
2189              Type => $args{'NoteType'},
2190              Data => ( $args{'MIMEObj'}->head->get('subject') || 'No Subject' ),
2191              TimeTaken => $args{'TimeTaken'},
2192              MIMEObj   => $args{'MIMEObj'}, 
2193              CommitScrips => $args{'CommitScrips'},
2194     );
2195
2196     unless ($Trans) {
2197         $RT::Logger->err("$self couldn't init a transaction $msg");
2198         return ( $Trans, $self->loc("Message could not be recorded"), undef );
2199     }
2200
2201     return ( $Trans, $self->loc("Message recorded"), $TransObj );
2202 }
2203
2204 # }}}
2205
2206 # }}}
2207
2208 # {{{ sub _Links 
2209
2210 sub _Links {
2211     my $self = shift;
2212
2213     #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
2214     #tobias meant by $f
2215     my $field = shift;
2216     my $type  = shift || "";
2217
2218     my $cache_key = "$field$type";
2219     return $self->{ $cache_key } if $self->{ $cache_key };
2220
2221     my $links = $self->{ $cache_key }
2222               = RT::Links->new( $self->CurrentUser );
2223     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
2224         $links->Limit( FIELD => 'id', VALUE => 0 );
2225         return $links;
2226     }
2227
2228     # Maybe this ticket is a merge ticket
2229     my $limit_on = 'Local'. $field;
2230     # at least to myself
2231     $links->Limit(
2232         FIELD           => $limit_on,
2233         VALUE           => $self->id,
2234         ENTRYAGGREGATOR => 'OR',
2235     );
2236     $links->Limit(
2237         FIELD           => $limit_on,
2238         VALUE           => $_,
2239         ENTRYAGGREGATOR => 'OR',
2240     ) foreach $self->Merged;
2241     $links->Limit(
2242         FIELD => 'Type',
2243         VALUE => $type,
2244     ) if $type;
2245
2246     return $links;
2247 }
2248
2249 # }}}
2250
2251 # {{{ sub DeleteLink 
2252
2253 =head2 DeleteLink
2254
2255 Delete a link. takes a paramhash of Base, Target, Type, Silent,
2256 SilentBase and SilentTarget. Either Base or Target must be null.
2257 The null value will be replaced with this ticket\'s id.
2258
2259 If Silent is true then no transaction would be recorded, in other
2260 case you can control creation of transactions on both base and
2261 target with SilentBase and SilentTarget respectively. By default
2262 both transactions are created.
2263
2264 =cut 
2265
2266 sub DeleteLink {
2267     my $self = shift;
2268     my %args = (
2269         Base   => undef,
2270         Target => undef,
2271         Type   => undef,
2272         Silent => undef,
2273         SilentBase   => undef,
2274         SilentTarget => undef,
2275         @_
2276     );
2277
2278     unless ( $args{'Target'} || $args{'Base'} ) {
2279         $RT::Logger->error("Base or Target must be specified");
2280         return ( 0, $self->loc('Either base or target must be specified') );
2281     }
2282
2283     #check acls
2284     my $right = 0;
2285     $right++ if $self->CurrentUserHasRight('ModifyTicket');
2286     if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) {
2287         return ( 0, $self->loc("Permission Denied") );
2288     }
2289
2290     # If the other URI is an RT::Ticket, we want to make sure the user
2291     # can modify it too...
2292     my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2293     return (0, $msg) unless $status;
2294     if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2295         $right++;
2296     }
2297     if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) ||
2298          ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) )
2299     {
2300         return ( 0, $self->loc("Permission Denied") );
2301     }
2302
2303     my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
2304     return ( 0, $Msg ) unless $val;
2305
2306     return ( $val, $Msg ) if $args{'Silent'};
2307
2308     my ($direction, $remote_link);
2309
2310     if ( $args{'Base'} ) {
2311         $remote_link = $args{'Base'};
2312         $direction = 'Target';
2313     }
2314     elsif ( $args{'Target'} ) {
2315         $remote_link = $args{'Target'};
2316         $direction = 'Base';
2317     } 
2318
2319     my $remote_uri = RT::URI->new( $self->CurrentUser );
2320     $remote_uri->FromURI( $remote_link );
2321
2322     unless ( $args{ 'Silent'. $direction } ) {
2323         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2324             Type      => 'DeleteLink',
2325             Field     => $LINKDIRMAP{$args{'Type'}}->{$direction},
2326             OldValue  => $remote_uri->URI || $remote_link,
2327             TimeTaken => 0
2328         );
2329         $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
2330     }
2331
2332     if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) {
2333         my $OtherObj = $remote_uri->Object;
2334         my ( $val, $Msg ) = $OtherObj->_NewTransaction(
2335             Type           => 'DeleteLink',
2336             Field          => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2337                                             : $LINKDIRMAP{$args{'Type'}}->{Target},
2338             OldValue       => $self->URI,
2339             ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'),
2340             TimeTaken      => 0,
2341         );
2342         $RT::Logger->error("Couldn't create transaction: $Msg") unless $val;
2343     }
2344
2345     return ( $val, $Msg );
2346 }
2347
2348 # }}}
2349
2350 # {{{ sub AddLink
2351
2352 =head2 AddLink
2353
2354 Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket.
2355
2356 If Silent is true then no transaction would be recorded, in other
2357 case you can control creation of transactions on both base and
2358 target with SilentBase and SilentTarget respectively. By default
2359 both transactions are created.
2360
2361 =cut
2362
2363 sub AddLink {
2364     my $self = shift;
2365     my %args = ( Target       => '',
2366                  Base         => '',
2367                  Type         => '',
2368                  Silent       => undef,
2369                  SilentBase   => undef,
2370                  SilentTarget => undef,
2371                  @_ );
2372
2373     unless ( $args{'Target'} || $args{'Base'} ) {
2374         $RT::Logger->error("Base or Target must be specified");
2375         return ( 0, $self->loc('Either base or target must be specified') );
2376     }
2377
2378     my $right = 0;
2379     $right++ if $self->CurrentUserHasRight('ModifyTicket');
2380     if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) {
2381         return ( 0, $self->loc("Permission Denied") );
2382     }
2383
2384     # If the other URI is an RT::Ticket, we want to make sure the user
2385     # can modify it too...
2386     my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2387     return (0, $msg) unless $status;
2388     if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2389         $right++;
2390     }
2391     if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) ||
2392          ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) )
2393     {
2394         return ( 0, $self->loc("Permission Denied") );
2395     }
2396
2397     return $self->_AddLink(%args);
2398 }
2399
2400 sub __GetTicketFromURI {
2401     my $self = shift;
2402     my %args = ( URI => '', @_ );
2403
2404     # If the other URI is an RT::Ticket, we want to make sure the user
2405     # can modify it too...
2406     my $uri_obj = RT::URI->new( $self->CurrentUser );
2407     $uri_obj->FromURI( $args{'URI'} );
2408
2409     unless ( $uri_obj->Resolver && $uri_obj->Scheme ) {
2410         my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} );
2411         $RT::Logger->warning( $msg );
2412         return( 0, $msg );
2413     }
2414     my $obj = $uri_obj->Resolver->Object;
2415     unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
2416         return (1, 'Found not a ticket', undef);
2417     }
2418     return (1, 'Found ticket', $obj);
2419 }
2420
2421 =head2 _AddLink  
2422
2423 Private non-acled variant of AddLink so that links can be added during create.
2424
2425 =cut
2426
2427 sub _AddLink {
2428     my $self = shift;
2429     my %args = ( Target       => '',
2430                  Base         => '',
2431                  Type         => '',
2432                  Silent       => undef,
2433                  SilentBase   => undef,
2434                  SilentTarget => undef,
2435                  @_ );
2436
2437     my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
2438     return ($val, $msg) if !$val || $exist;
2439     return ($val, $msg) if $args{'Silent'};
2440
2441     my ($direction, $remote_link);
2442     if ( $args{'Target'} ) {
2443         $remote_link  = $args{'Target'};
2444         $direction    = 'Base';
2445     } elsif ( $args{'Base'} ) {
2446         $remote_link  = $args{'Base'};
2447         $direction    = 'Target';
2448     }
2449
2450     my $remote_uri = RT::URI->new( $self->CurrentUser );
2451     $remote_uri->FromURI( $remote_link );
2452
2453     unless ( $args{ 'Silent'. $direction } ) {
2454         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2455             Type      => 'AddLink',
2456             Field     => $LINKDIRMAP{$args{'Type'}}->{$direction},
2457             NewValue  =>  $remote_uri->URI || $remote_link,
2458             TimeTaken => 0
2459         );
2460         $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
2461     }
2462
2463     if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) {
2464         my $OtherObj = $remote_uri->Object;
2465         my ( $val, $msg ) = $OtherObj->_NewTransaction(
2466             Type           => 'AddLink',
2467             Field          => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2468                                             : $LINKDIRMAP{$args{'Type'}}->{Target},
2469             NewValue       => $self->URI,
2470             ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'),
2471             TimeTaken      => 0,
2472         );
2473         $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
2474     }
2475
2476     return ( $val, $msg );
2477 }
2478
2479 # }}}
2480
2481
2482 # {{{ sub MergeInto
2483
2484 =head2 MergeInto
2485
2486 MergeInto take the id of the ticket to merge this ticket into.
2487
2488 =cut
2489
2490 sub MergeInto {
2491     my $self      = shift;
2492     my $ticket_id = shift;
2493
2494     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
2495         return ( 0, $self->loc("Permission Denied") );
2496     }
2497
2498     # Load up the new ticket.
2499     my $MergeInto = RT::Ticket->new($self->CurrentUser);
2500     $MergeInto->Load($ticket_id);
2501
2502     # make sure it exists.
2503     unless ( $MergeInto->Id ) {
2504         return ( 0, $self->loc("New ticket doesn't exist") );
2505     }
2506
2507     # Make sure the current user can modify the new ticket.
2508     unless ( $MergeInto->CurrentUserHasRight('ModifyTicket') ) {
2509         return ( 0, $self->loc("Permission Denied") );
2510     }
2511
2512     delete $MERGE_CACHE{'effective'}{ $self->id };
2513     delete @{ $MERGE_CACHE{'merged'} }{
2514         $ticket_id, $MergeInto->id, $self->id
2515     };
2516
2517     $RT::Handle->BeginTransaction();
2518
2519     # We use EffectiveId here even though it duplicates information from
2520     # the links table becasue of the massive performance hit we'd take
2521     # by trying to do a separate database query for merge info everytime 
2522     # loaded a ticket. 
2523
2524     #update this ticket's effective id to the new ticket's id.
2525     my ( $id_val, $id_msg ) = $self->__Set(
2526         Field => 'EffectiveId',
2527         Value => $MergeInto->Id()
2528     );
2529
2530     unless ($id_val) {
2531         $RT::Handle->Rollback();
2532         return ( 0, $self->loc("Merge failed. Couldn't set EffectiveId") );
2533     }
2534
2535
2536     if ( $self->__Value('Status') ne 'resolved' ) {
2537
2538         my ( $status_val, $status_msg )
2539             = $self->__Set( Field => 'Status', Value => 'resolved' );
2540
2541         unless ($status_val) {
2542             $RT::Handle->Rollback();
2543             $RT::Logger->error(
2544                 $self->loc(
2545                     "[_1] couldn't set status to resolved. RT's Database may be inconsistent.",
2546                     $self
2547                 )
2548             );
2549             return ( 0, $self->loc("Merge failed. Couldn't set Status") );
2550         }
2551     }
2552
2553     # update all the links that point to that old ticket
2554     my $old_links_to = RT::Links->new($self->CurrentUser);
2555     $old_links_to->Limit(FIELD => 'Target', VALUE => $self->URI);
2556
2557     my %old_seen;
2558     while (my $link = $old_links_to->Next) {
2559         if (exists $old_seen{$link->Base."-".$link->Type}) {
2560             $link->Delete;
2561         }   
2562         elsif ($link->Base eq $MergeInto->URI) {
2563             $link->Delete;
2564         } else {
2565             # First, make sure the link doesn't already exist. then move it over.
2566             my $tmp = RT::Link->new($RT::SystemUser);
2567             $tmp->LoadByCols(Base => $link->Base, Type => $link->Type, LocalTarget => $MergeInto->id);
2568             if ($tmp->id)   {
2569                     $link->Delete;
2570             } else { 
2571                 $link->SetTarget($MergeInto->URI);
2572                 $link->SetLocalTarget($MergeInto->id);
2573             }
2574             $old_seen{$link->Base."-".$link->Type} =1;
2575         }
2576
2577     }
2578
2579     my $old_links_from = RT::Links->new($self->CurrentUser);
2580     $old_links_from->Limit(FIELD => 'Base', VALUE => $self->URI);
2581
2582     while (my $link = $old_links_from->Next) {
2583         if (exists $old_seen{$link->Type."-".$link->Target}) {
2584             $link->Delete;
2585         }   
2586         if ($link->Target eq $MergeInto->URI) {
2587             $link->Delete;
2588         } else {
2589             # First, make sure the link doesn't already exist. then move it over.
2590             my $tmp = RT::Link->new($RT::SystemUser);
2591             $tmp->LoadByCols(Target => $link->Target, Type => $link->Type, LocalBase => $MergeInto->id);
2592             if ($tmp->id)   {
2593                     $link->Delete;
2594             } else { 
2595                 $link->SetBase($MergeInto->URI);
2596                 $link->SetLocalBase($MergeInto->id);
2597                 $old_seen{$link->Type."-".$link->Target} =1;
2598             }
2599         }
2600
2601     }
2602
2603     # Update time fields
2604     foreach my $type qw(TimeEstimated TimeWorked TimeLeft) {
2605
2606         my $mutator = "Set$type";
2607         $MergeInto->$mutator(
2608             ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ) );
2609
2610     }
2611 #add all of this ticket's watchers to that ticket.
2612     foreach my $watcher_type qw(Requestors Cc AdminCc) {
2613
2614         my $people = $self->$watcher_type->MembersObj;
2615         my $addwatcher_type =  $watcher_type;
2616         $addwatcher_type  =~ s/s$//;
2617
2618         while ( my $watcher = $people->Next ) {
2619             
2620            my ($val, $msg) =  $MergeInto->_AddWatcher(
2621                 Type        => $addwatcher_type,
2622                 Silent => 1,
2623                 PrincipalId => $watcher->MemberId
2624             );
2625             unless ($val) {
2626                 $RT::Logger->warning($msg);
2627             }
2628     }
2629
2630     }
2631
2632     #find all of the tickets that were merged into this ticket. 
2633     my $old_mergees = new RT::Tickets( $self->CurrentUser );
2634     $old_mergees->Limit(
2635         FIELD    => 'EffectiveId',
2636         OPERATOR => '=',
2637         VALUE    => $self->Id
2638     );
2639
2640     #   update their EffectiveId fields to the new ticket's id
2641     while ( my $ticket = $old_mergees->Next() ) {
2642         my ( $val, $msg ) = $ticket->__Set(
2643             Field => 'EffectiveId',
2644             Value => $MergeInto->Id()
2645         );
2646     }
2647
2648     #make a new link: this ticket is merged into that other ticket.
2649     $self->AddLink( Type   => 'MergedInto', Target => $MergeInto->Id());
2650
2651     $MergeInto->_SetLastUpdated;    
2652
2653     $RT::Handle->Commit();
2654     return ( 1, $self->loc("Merge Successful") );
2655 }
2656
2657 =head2 Merged
2658
2659 Returns list of tickets' ids that's been merged into this ticket.
2660
2661 =cut
2662
2663 sub Merged {
2664     my $self = shift;
2665
2666     my $id = $self->id;
2667     return @{ $MERGE_CACHE{'merged'}{ $id } }
2668         if $MERGE_CACHE{'merged'}{ $id };
2669
2670     my $mergees = RT::Tickets->new( $self->CurrentUser );
2671     $mergees->Limit(
2672         FIELD    => 'EffectiveId',
2673         VALUE    => $id,
2674     );
2675     $mergees->Limit(
2676         FIELD    => 'id',
2677         OPERATOR => '!=',
2678         VALUE    => $id,
2679     );
2680     return @{ $MERGE_CACHE{'merged'}{ $id } ||= [] }
2681         = map $_->id, @{ $mergees->ItemsArrayRef || [] };
2682 }
2683
2684 # }}}
2685
2686 # }}}
2687
2688 # {{{ Routines dealing with ownership
2689
2690 # {{{ sub OwnerObj
2691
2692 =head2 OwnerObj
2693
2694 Takes nothing and returns an RT::User object of 
2695 this ticket's owner
2696
2697 =cut
2698
2699 sub OwnerObj {
2700     my $self = shift;
2701
2702     #If this gets ACLed, we lose on a rights check in User.pm and
2703     #get deep recursion. if we need ACLs here, we need
2704     #an equiv without ACLs
2705
2706     my $owner = new RT::User( $self->CurrentUser );
2707     $owner->Load( $self->__Value('Owner') );
2708
2709     #Return the owner object
2710     return ($owner);
2711 }
2712
2713 # }}}
2714
2715 # {{{ sub OwnerAsString 
2716
2717 =head2 OwnerAsString
2718
2719 Returns the owner's email address
2720
2721 =cut
2722
2723 sub OwnerAsString {
2724     my $self = shift;
2725     return ( $self->OwnerObj->EmailAddress );
2726
2727 }
2728
2729 # }}}
2730
2731 # {{{ sub SetOwner
2732
2733 =head2 SetOwner
2734
2735 Takes two arguments:
2736      the Id or Name of the owner 
2737 and  (optionally) the type of the SetOwner Transaction. It defaults
2738 to 'Give'.  'Steal' is also a valid option.
2739
2740
2741 =cut
2742
2743 sub SetOwner {
2744     my $self     = shift;
2745     my $NewOwner = shift;
2746     my $Type     = shift || "Give";
2747
2748     $RT::Handle->BeginTransaction();
2749
2750     $self->_SetLastUpdated(); # lock the ticket
2751     $self->Load( $self->id ); # in case $self changed while waiting for lock
2752
2753     my $OldOwnerObj = $self->OwnerObj;
2754
2755     my $NewOwnerObj = RT::User->new( $self->CurrentUser );
2756     $NewOwnerObj->Load( $NewOwner );
2757     unless ( $NewOwnerObj->Id ) {
2758         $RT::Handle->Rollback();
2759         return ( 0, $self->loc("That user does not exist") );
2760     }
2761
2762
2763     # must have ModifyTicket rights
2764     # or TakeTicket/StealTicket and $NewOwner is self
2765     # see if it's a take
2766     if ( $OldOwnerObj->Id == $RT::Nobody->Id ) {
2767         unless (    $self->CurrentUserHasRight('ModifyTicket')
2768                  || $self->CurrentUserHasRight('TakeTicket') ) {
2769             $RT::Handle->Rollback();
2770             return ( 0, $self->loc("Permission Denied") );
2771         }
2772     }
2773
2774     # see if it's a steal
2775     elsif (    $OldOwnerObj->Id != $RT::Nobody->Id
2776             && $OldOwnerObj->Id != $self->CurrentUser->id ) {
2777
2778         unless (    $self->CurrentUserHasRight('ModifyTicket')
2779                  || $self->CurrentUserHasRight('StealTicket') ) {
2780             $RT::Handle->Rollback();
2781             return ( 0, $self->loc("Permission Denied") );
2782         }
2783     }
2784     else {
2785         unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
2786             $RT::Handle->Rollback();
2787             return ( 0, $self->loc("Permission Denied") );
2788         }
2789     }
2790
2791     # If we're not stealing and the ticket has an owner and it's not
2792     # the current user
2793     if ( $Type ne 'Steal' and $Type ne 'Force'
2794          and $OldOwnerObj->Id != $RT::Nobody->Id
2795          and $OldOwnerObj->Id != $self->CurrentUser->Id )
2796     {
2797         $RT::Handle->Rollback();
2798         return ( 0, $self->loc("You can only take tickets that are unowned") )
2799             if $NewOwnerObj->id == $self->CurrentUser->id;
2800         return (
2801             0,
2802             $self->loc("You can only reassign tickets that you own or that are unowned" )
2803         );
2804     }
2805
2806     #If we've specified a new owner and that user can't modify the ticket
2807     elsif ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ) {
2808         $RT::Handle->Rollback();
2809         return ( 0, $self->loc("That user may not own tickets in that queue") );
2810     }
2811
2812     # If the ticket has an owner and it's the new owner, we don't need
2813     # To do anything
2814     elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) {
2815         $RT::Handle->Rollback();
2816         return ( 0, $self->loc("That user already owns that ticket") );
2817     }
2818
2819     # Delete the owner in the owner group, then add a new one
2820     # TODO: is this safe? it's not how we really want the API to work
2821     # for most things, but it's fast.
2822     my ( $del_id, $del_msg );
2823     for my $owner (@{$self->OwnerGroup->MembersObj->ItemsArrayRef}) {
2824         ($del_id, $del_msg) = $owner->Delete();
2825         last unless ($del_id);
2826     }
2827
2828     unless ($del_id) {
2829         $RT::Handle->Rollback();
2830         return ( 0, $self->loc("Could not change owner: [_1]", $del_msg) );
2831     }
2832
2833     my ( $add_id, $add_msg ) = $self->OwnerGroup->_AddMember(
2834                                        PrincipalId => $NewOwnerObj->PrincipalId,
2835                                        InsideTransaction => 1 );
2836     unless ($add_id) {
2837         $RT::Handle->Rollback();
2838         return ( 0, $self->loc("Could not change owner: [_1]", $add_msg ) );
2839     }
2840
2841     # We call set twice with slightly different arguments, so
2842     # as to not have an SQL transaction span two RT transactions
2843
2844     my ( $val, $msg ) = $self->_Set(
2845                       Field             => 'Owner',
2846                       RecordTransaction => 0,
2847                       Value             => $NewOwnerObj->Id,
2848                       TimeTaken         => 0,
2849                       TransactionType   => $Type,
2850                       CheckACL          => 0,                  # don't check acl
2851     );
2852
2853     unless ($val) {
2854         $RT::Handle->Rollback;
2855         return ( 0, $self->loc("Could not change owner: [_1]", $msg) );
2856     }
2857
2858     ($val, $msg) = $self->_NewTransaction(
2859         Type      => $Type,
2860         Field     => 'Owner',
2861         NewValue  => $NewOwnerObj->Id,
2862         OldValue  => $OldOwnerObj->Id,
2863         TimeTaken => 0,
2864     );
2865
2866     if ( $val ) {
2867         $msg = $self->loc( "Owner changed from [_1] to [_2]",
2868                            $OldOwnerObj->Name, $NewOwnerObj->Name );
2869     }
2870     else {
2871         $RT::Handle->Rollback();
2872         return ( 0, $msg );
2873     }
2874
2875     $RT::Handle->Commit();
2876
2877     return ( $val, $msg );
2878 }
2879
2880 # }}}
2881
2882 # {{{ sub Take
2883
2884 =head2 Take
2885
2886 A convenince method to set the ticket's owner to the current user
2887
2888 =cut
2889
2890 sub Take {
2891     my $self = shift;
2892     return ( $self->SetOwner( $self->CurrentUser->Id, 'Take' ) );
2893 }
2894
2895 # }}}
2896
2897 # {{{ sub Untake
2898
2899 =head2 Untake
2900
2901 Convenience method to set the owner to 'nobody' if the current user is the owner.
2902
2903 =cut
2904
2905 sub Untake {
2906     my $self = shift;
2907     return ( $self->SetOwner( $RT::Nobody->UserObj->Id, 'Untake' ) );
2908 }
2909
2910 # }}}
2911
2912 # {{{ sub Steal 
2913
2914 =head2 Steal
2915
2916 A convenience method to change the owner of the current ticket to the
2917 current user. Even if it's owned by another user.
2918
2919 =cut
2920
2921 sub Steal {
2922     my $self = shift;
2923
2924     if ( $self->IsOwner( $self->CurrentUser ) ) {
2925         return ( 0, $self->loc("You already own this ticket") );
2926     }
2927     else {
2928         return ( $self->SetOwner( $self->CurrentUser->Id, 'Steal' ) );
2929
2930     }
2931
2932 }
2933
2934 # }}}
2935
2936 # }}}
2937
2938 # {{{ Routines dealing with status
2939
2940 # {{{ sub ValidateStatus 
2941
2942 =head2 ValidateStatus STATUS
2943
2944 Takes a string. Returns true if that status is a valid status for this ticket.
2945 Returns false otherwise.
2946
2947 =cut
2948
2949 sub ValidateStatus {
2950     my $self   = shift;
2951     my $status = shift;
2952
2953     #Make sure the status passed in is valid
2954     unless ( $self->QueueObj->IsValidStatus($status) ) {
2955         return (undef);
2956     }
2957
2958     return (1);
2959
2960 }
2961
2962 # }}}
2963
2964 # {{{ sub SetStatus
2965
2966 =head2 SetStatus STATUS
2967
2968 Set this ticket\'s status. STATUS can be one of: new, open, stalled, resolved, rejected or deleted.
2969
2970 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.
2971
2972
2973
2974 =cut
2975
2976 sub SetStatus {
2977     my $self   = shift;
2978     my %args;
2979
2980     if (@_ == 1) {
2981     $args{Status} = shift;
2982     }
2983     else {
2984     %args = (@_);
2985     }
2986
2987     #Check ACL
2988     if ( $args{Status} eq 'deleted') {
2989             unless ($self->CurrentUserHasRight('DeleteTicket')) {
2990             return ( 0, $self->loc('Permission Denied') );
2991        }
2992     } else {
2993             unless ($self->CurrentUserHasRight('ModifyTicket')) {
2994             return ( 0, $self->loc('Permission Denied') );
2995        }
2996     }
2997
2998     if (!$args{Force} && ($args{'Status'} eq 'resolved') && $self->HasUnresolvedDependencies) {
2999         return (0, $self->loc('That ticket has unresolved dependencies'));
3000     }
3001
3002     my $now = RT::Date->new( $self->CurrentUser );
3003     $now->SetToNow();
3004
3005     #If we're changing the status from new, record that we've started
3006     if ( $self->Status eq 'new' && $args{Status} ne 'new' ) {
3007
3008         #Set the Started time to "now"
3009         $self->_Set( Field             => 'Started',
3010                      Value             => $now->ISO,
3011                      RecordTransaction => 0 );
3012     }
3013
3014     #When we close a ticket, set the 'Resolved' attribute to now.
3015     # It's misnamed, but that's just historical.
3016     if ( $self->QueueObj->IsInactiveStatus($args{Status}) ) {
3017         $self->_Set( Field             => 'Resolved',
3018                      Value             => $now->ISO,
3019                      RecordTransaction => 0 );
3020     }
3021
3022     #Actually update the status
3023    my ($val, $msg)= $self->_Set( Field           => 'Status',
3024                           Value           => $args{Status},
3025                           TimeTaken       => 0,
3026                           CheckACL      => 0,
3027                           TransactionType => 'Status'  );
3028
3029     return($val,$msg);
3030 }
3031
3032 # }}}
3033
3034 # {{{ sub Delete
3035
3036 =head2 Delete
3037
3038 Takes no arguments. Marks this ticket for garbage collection
3039
3040 =cut
3041
3042 sub Delete {
3043     my $self = shift;
3044     return ( $self->SetStatus('deleted') );
3045
3046     # TODO: garbage collection
3047 }
3048
3049 # }}}
3050
3051 # {{{ sub Stall
3052
3053 =head2 Stall
3054
3055 Sets this ticket's status to stalled
3056
3057 =cut
3058
3059 sub Stall {
3060     my $self = shift;
3061     return ( $self->SetStatus('stalled') );
3062 }
3063
3064 # }}}
3065
3066 # {{{ sub Reject
3067
3068 =head2 Reject
3069
3070 Sets this ticket's status to rejected
3071
3072 =cut
3073
3074 sub Reject {
3075     my $self = shift;
3076     return ( $self->SetStatus('rejected') );
3077 }
3078
3079 # }}}
3080
3081 # {{{ sub Open
3082
3083 =head2 Open
3084
3085 Sets this ticket\'s status to Open
3086
3087 =cut
3088
3089 sub Open {
3090     my $self = shift;
3091     return ( $self->SetStatus('open') );
3092 }
3093
3094 # }}}
3095
3096 # {{{ sub Resolve
3097
3098 =head2 Resolve
3099
3100 Sets this ticket\'s status to Resolved
3101
3102 =cut
3103
3104 sub Resolve {
3105     my $self = shift;
3106     return ( $self->SetStatus('resolved') );
3107 }
3108
3109 # }}}
3110
3111 # }}}
3112
3113     
3114 # {{{ Actions + Routines dealing with transactions
3115
3116 # {{{ sub SetTold and _SetTold
3117
3118 =head2 SetTold ISO  [TIMETAKEN]
3119
3120 Updates the told and records a transaction
3121
3122 =cut
3123
3124 sub SetTold {
3125     my $self = shift;
3126     my $told;
3127     $told = shift if (@_);
3128     my $timetaken = shift || 0;
3129
3130     unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
3131         return ( 0, $self->loc("Permission Denied") );
3132     }
3133
3134     my $datetold = new RT::Date( $self->CurrentUser );
3135     if ($told) {
3136         $datetold->Set( Format => 'iso',
3137                         Value  => $told );
3138     }
3139     else {
3140         $datetold->SetToNow();
3141     }
3142
3143     return ( $self->_Set( Field           => 'Told',
3144                           Value           => $datetold->ISO,
3145                           TimeTaken       => $timetaken,
3146                           TransactionType => 'Told' ) );
3147 }
3148
3149 =head2 _SetTold
3150
3151 Updates the told without a transaction or acl check. Useful when we're sending replies.
3152
3153 =cut
3154
3155 sub _SetTold {
3156     my $self = shift;
3157
3158     my $now = new RT::Date( $self->CurrentUser );
3159     $now->SetToNow();
3160
3161     #use __Set to get no ACLs ;)
3162     return ( $self->__Set( Field => 'Told',
3163                            Value => $now->ISO ) );
3164 }
3165
3166 =head2 SeenUpTo
3167
3168
3169 =cut
3170
3171 sub SeenUpTo {
3172     my $self = shift;
3173     my $uid = $self->CurrentUser->id;
3174     my $attr = $self->FirstAttribute( "User-". $uid ."-SeenUpTo" );
3175     return if $attr && $attr->Content gt $self->LastUpdated;
3176
3177     my $txns = $self->Transactions;
3178     $txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
3179     $txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
3180     $txns->Limit( FIELD => 'Creator', OPERATOR => '!=', VALUE => $uid );
3181     $txns->Limit(
3182         FIELD => 'Created',
3183         OPERATOR => '>',
3184         VALUE => $attr->Content
3185     ) if $attr;
3186     $txns->RowsPerPage(1);
3187     return $txns->First;
3188 }
3189
3190 # }}}
3191
3192 =head2 TransactionBatch
3193
3194 Returns an array reference of all transactions created on this ticket during
3195 this ticket object's lifetime or since last application of a batch, or undef
3196 if there were none.
3197
3198 Only works when the C<UseTransactionBatch> config option is set to true.
3199
3200 =cut
3201
3202 sub TransactionBatch {
3203     my $self = shift;
3204     return $self->{_TransactionBatch};
3205 }
3206
3207 =head2 ApplyTransactionBatch
3208
3209 Applies scrips on the current batch of transactions and shinks it. Usually
3210 batch is applied when object is destroyed, but in some cases it's too late.
3211
3212 =cut
3213
3214 sub ApplyTransactionBatch {
3215     my $self = shift;
3216
3217     my $batch = $self->TransactionBatch;
3218     return unless $batch && @$batch;
3219
3220     $self->_ApplyTransactionBatch;
3221
3222     $self->{_TransactionBatch} = [];
3223 }
3224
3225 sub _ApplyTransactionBatch {
3226     my $self = shift;
3227     my $batch = $self->TransactionBatch;
3228
3229     my %seen;
3230     my $types = join ',', grep !$seen{$_}++, grep defined, map $_->Type, grep defined, @{$batch};
3231
3232     require RT::Scrips;
3233     RT::Scrips->new($RT::SystemUser)->Apply(
3234         Stage          => 'TransactionBatch',
3235         TicketObj      => $self,
3236         TransactionObj => $batch->[0],
3237         Type           => $types,
3238     );
3239
3240     # Entry point of the rule system
3241     my $rules = RT::Ruleset->FindAllRules(
3242         Stage          => 'TransactionBatch',
3243         TicketObj      => $self,
3244         TransactionObj => $batch->[0],
3245         Type           => $types,
3246     );
3247     RT::Ruleset->CommitRules($rules);
3248 }
3249
3250 sub DESTROY {
3251     my $self = shift;
3252
3253     # DESTROY methods need to localize $@, or it may unset it.  This
3254     # causes $m->abort to not bubble all of the way up.  See perlbug
3255     # http://rt.perl.org/rt3/Ticket/Display.html?id=17650
3256     local $@;
3257
3258     # The following line eliminates reentrancy.
3259     # It protects against the fact that perl doesn't deal gracefully
3260     # when an object's refcount is changed in its destructor.
3261     return if $self->{_Destroyed}++;
3262
3263     my $batch = $self->TransactionBatch;
3264     return unless $batch && @$batch;
3265
3266     return $self->_ApplyTransactionBatch;
3267 }
3268
3269 # }}}
3270
3271 # {{{ PRIVATE UTILITY METHODS. Mostly needed so Ticket can be a DBIx::Record
3272
3273 # {{{ sub _OverlayAccessible
3274
3275 sub _OverlayAccessible {
3276     {
3277         EffectiveId       => { 'read' => 1,  'write' => 1,  'public' => 1 },
3278           Queue           => { 'read' => 1,  'write' => 1 },
3279           Requestors      => { 'read' => 1,  'write' => 1 },
3280           Owner           => { 'read' => 1,  'write' => 1 },
3281           Subject         => { 'read' => 1,  'write' => 1 },
3282           InitialPriority => { 'read' => 1,  'write' => 1 },
3283           FinalPriority   => { 'read' => 1,  'write' => 1 },
3284           Priority        => { 'read' => 1,  'write' => 1 },
3285           Status          => { 'read' => 1,  'write' => 1 },
3286           TimeEstimated      => { 'read' => 1,  'write' => 1 },
3287           TimeWorked      => { 'read' => 1,  'write' => 1 },
3288           TimeLeft        => { 'read' => 1,  'write' => 1 },
3289           Told            => { 'read' => 1,  'write' => 1 },
3290           Resolved        => { 'read' => 1 },
3291           Type            => { 'read' => 1 },
3292           Starts        => { 'read' => 1, 'write' => 1 },
3293           Started       => { 'read' => 1, 'write' => 1 },
3294           Due           => { 'read' => 1, 'write' => 1 },
3295           Creator       => { 'read' => 1, 'auto'  => 1 },
3296           Created       => { 'read' => 1, 'auto'  => 1 },
3297           LastUpdatedBy => { 'read' => 1, 'auto'  => 1 },
3298           LastUpdated   => { 'read' => 1, 'auto'  => 1 }
3299     };
3300
3301 }
3302
3303 # }}}
3304
3305 # {{{ sub _Set
3306
3307 sub _Set {
3308     my $self = shift;
3309
3310     my %args = ( Field             => undef,
3311                  Value             => undef,
3312                  TimeTaken         => 0,
3313                  RecordTransaction => 1,
3314                  UpdateTicket      => 1,
3315                  CheckACL          => 1,
3316                  TransactionType   => 'Set',
3317                  @_ );
3318
3319     if ($args{'CheckACL'}) {
3320       unless ( $self->CurrentUserHasRight('ModifyTicket')) {
3321           return ( 0, $self->loc("Permission Denied"));
3322       }
3323    }
3324
3325     unless ($args{'UpdateTicket'} || $args{'RecordTransaction'}) {
3326         $RT::Logger->error("Ticket->_Set called without a mandate to record an update or update the ticket");
3327         return(0, $self->loc("Internal Error"));
3328     }
3329
3330     #if the user is trying to modify the record
3331
3332     #Take care of the old value we really don't want to get in an ACL loop.
3333     # so ask the super::_Value
3334     my $Old = $self->SUPER::_Value("$args{'Field'}");
3335     
3336     my ($ret, $msg);
3337     if ( $args{'UpdateTicket'}  ) {
3338
3339         #Set the new value
3340         ( $ret, $msg ) = $self->SUPER::_Set( Field => $args{'Field'},
3341                                                 Value => $args{'Value'} );
3342     
3343         #If we can't actually set the field to the value, don't record
3344         # a transaction. instead, get out of here.
3345         return ( 0, $msg ) unless $ret;
3346     }
3347
3348     if ( $args{'RecordTransaction'} == 1 ) {
3349
3350         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
3351                                                Type => $args{'TransactionType'},
3352                                                Field     => $args{'Field'},
3353                                                NewValue  => $args{'Value'},
3354                                                OldValue  => $Old,
3355                                                TimeTaken => $args{'TimeTaken'},
3356         );
3357         return ( $Trans, scalar $TransObj->BriefDescription );
3358     }
3359     else {
3360         return ( $ret, $msg );
3361     }
3362 }
3363
3364 # }}}
3365
3366 # {{{ sub _Value 
3367
3368 =head2 _Value
3369
3370 Takes the name of a table column.
3371 Returns its value as a string, if the user passes an ACL check
3372
3373 =cut
3374
3375 sub _Value {
3376
3377     my $self  = shift;
3378     my $field = shift;
3379
3380     #if the field is public, return it.
3381     if ( $self->_Accessible( $field, 'public' ) ) {
3382
3383         #$RT::Logger->debug("Skipping ACL check for $field");
3384         return ( $self->SUPER::_Value($field) );
3385
3386     }
3387
3388     #If the current user doesn't have ACLs, don't let em at it.  
3389
3390     unless ( $self->CurrentUserHasRight('ShowTicket') ) {
3391         return (undef);
3392     }
3393     return ( $self->SUPER::_Value($field) );
3394
3395 }
3396
3397 # }}}
3398
3399 # {{{ sub _UpdateTimeTaken
3400
3401 =head2 _UpdateTimeTaken
3402
3403 This routine will increment the timeworked counter. it should
3404 only be called from _NewTransaction 
3405
3406 =cut
3407
3408 sub _UpdateTimeTaken {
3409     my $self    = shift;
3410     my $Minutes = shift;
3411     my ($Total);
3412
3413     $Total = $self->SUPER::_Value("TimeWorked");
3414     $Total = ( $Total || 0 ) + ( $Minutes || 0 );
3415     $self->SUPER::_Set(
3416         Field => "TimeWorked",
3417         Value => $Total
3418     );
3419
3420     return ($Total);
3421 }
3422
3423 # }}}
3424
3425 # }}}
3426
3427 # {{{ Routines dealing with ACCESS CONTROL
3428
3429 # {{{ sub CurrentUserHasRight 
3430
3431 =head2 CurrentUserHasRight
3432
3433   Takes the textual name of a Ticket scoped right (from RT::ACE) and returns
3434 1 if the user has that right. It returns 0 if the user doesn't have that right.
3435
3436 =cut
3437
3438 sub CurrentUserHasRight {
3439     my $self  = shift;
3440     my $right = shift;
3441
3442     return $self->CurrentUser->PrincipalObj->HasRight(
3443         Object => $self,
3444         Right  => $right,
3445     )
3446 }
3447
3448 # }}}
3449
3450 # {{{ sub HasRight 
3451
3452 =head2 HasRight
3453
3454  Takes a paramhash with the attributes 'Right' and 'Principal'
3455   'Right' is a ticket-scoped textual right from RT::ACE 
3456   'Principal' is an RT::User object
3457
3458   Returns 1 if the principal has the right. Returns undef if not.
3459
3460 =cut
3461
3462 sub HasRight {
3463     my $self = shift;
3464     my %args = (
3465         Right     => undef,
3466         Principal => undef,
3467         @_
3468     );
3469
3470     unless ( ( defined $args{'Principal'} ) and ( ref( $args{'Principal'} ) ) )
3471     {
3472         Carp::cluck("Principal attrib undefined for Ticket::HasRight");
3473         $RT::Logger->crit("Principal attrib undefined for Ticket::HasRight");
3474         return(undef);
3475     }
3476
3477     return (
3478         $args{'Principal'}->HasRight(
3479             Object => $self,
3480             Right     => $args{'Right'}
3481           )
3482     );
3483 }
3484
3485 # }}}
3486
3487 # }}}
3488
3489 =head2 Reminders
3490
3491 Return the Reminders object for this ticket. (It's an RT::Reminders object.)
3492 It isn't acutally a searchbuilder collection itself.
3493
3494 =cut
3495
3496 sub Reminders {
3497     my $self = shift;
3498     
3499     unless ($self->{'__reminders'}) {
3500         $self->{'__reminders'} = RT::Reminders->new($self->CurrentUser);
3501         $self->{'__reminders'}->Ticket($self->id);
3502     }
3503     return $self->{'__reminders'};
3504
3505 }
3506
3507
3508
3509 # {{{ sub Transactions 
3510
3511 =head2 Transactions
3512
3513   Returns an RT::Transactions object of all transactions on this ticket
3514
3515 =cut
3516
3517 sub Transactions {
3518     my $self = shift;
3519
3520     my $transactions = RT::Transactions->new( $self->CurrentUser );
3521
3522     #If the user has no rights, return an empty object
3523     if ( $self->CurrentUserHasRight('ShowTicket') ) {
3524         $transactions->LimitToTicket($self->id);
3525
3526         # if the user may not see comments do not return them
3527         unless ( $self->CurrentUserHasRight('ShowTicketComments') ) {
3528             $transactions->Limit(
3529                 SUBCLAUSE => 'acl',
3530                 FIELD    => 'Type',
3531                 OPERATOR => '!=',
3532                 VALUE    => "Comment"
3533             );
3534             $transactions->Limit(
3535                 SUBCLAUSE => 'acl',
3536                 FIELD    => 'Type',
3537                 OPERATOR => '!=',
3538                 VALUE    => "CommentEmailRecord",
3539                 ENTRYAGGREGATOR => 'AND'
3540             );
3541
3542         }
3543     } else {
3544         $transactions->Limit(
3545             SUBCLAUSE => 'acl',
3546             FIELD    => 'id',
3547             VALUE    => 0,
3548             ENTRYAGGREGATOR => 'AND'
3549         );
3550     }
3551
3552     return ($transactions);
3553 }
3554
3555 # }}}
3556
3557
3558 # {{{ TransactionCustomFields
3559
3560 =head2 TransactionCustomFields
3561
3562     Returns the custom fields that transactions on tickets will have.
3563
3564 =cut
3565
3566 sub TransactionCustomFields {
3567     my $self = shift;
3568     return $self->QueueObj->TicketTransactionCustomFields;
3569 }
3570
3571 # }}}
3572
3573 # {{{ sub CustomFieldValues
3574
3575 =head2 CustomFieldValues
3576
3577 # Do name => id mapping (if needed) before falling back to
3578 # RT::Record's CustomFieldValues
3579
3580 See L<RT::Record>
3581
3582 =cut
3583
3584 sub CustomFieldValues {
3585     my $self  = shift;
3586     my $field = shift;
3587
3588     return $self->SUPER::CustomFieldValues( $field ) if !$field || $field =~ /^\d+$/;
3589
3590     my $cf = RT::CustomField->new( $self->CurrentUser );
3591     $cf->SetContextObject( $self );
3592     $cf->LoadByNameAndQueue( Name => $field, Queue => $self->Queue );
3593     unless ( $cf->id ) {
3594         $cf->LoadByNameAndQueue( Name => $field, Queue => 0 );
3595     }
3596
3597     # If we didn't find a valid cfid, give up.
3598     return RT::ObjectCustomFieldValues->new( $self->CurrentUser ) unless $cf->id;
3599
3600     return $self->SUPER::CustomFieldValues( $cf->id );
3601 }
3602
3603 # }}}
3604
3605 # {{{ sub CustomFieldLookupType
3606
3607 =head2 CustomFieldLookupType
3608
3609 Returns the RT::Ticket lookup type, which can be passed to 
3610 RT::CustomField->Create() via the 'LookupType' hash key.
3611
3612 =cut
3613
3614 # }}}
3615
3616 sub CustomFieldLookupType {
3617     "RT::Queue-RT::Ticket";
3618 }
3619
3620 =head2 ACLEquivalenceObjects
3621
3622 This method returns a list of objects for which a user's rights also apply
3623 to this ticket. Generally, this is only the ticket's queue, but some RT 
3624 extensions may make other objects available too.
3625
3626 This method is called from L<RT::Principal/HasRight>.
3627
3628 =cut
3629
3630 sub ACLEquivalenceObjects {
3631     my $self = shift;
3632     return $self->QueueObj;
3633
3634 }
3635
3636
3637 1;
3638
3639 =head1 AUTHOR
3640
3641 Jesse Vincent, jesse@bestpractical.com
3642
3643 =head1 SEE ALSO
3644
3645 RT
3646
3647 =cut
3648