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