3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
5 # (Except where explictly superceded by other copyright notices)
7 # This work is made available to you under the terms of Version 2 of
8 # the GNU General Public License. A copy of that license should have
9 # been provided with this software, but in any event can be snarfed
12 # This work is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # Unless otherwise specified, all modifications, corrections or
18 # extensions to this work which alter its source code become the
19 # property of Best Practical Solutions, LLC when submitted for
20 # inclusion in the work.
24 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
26 ## This is a library of static subs to be used by the Mason web
36 use_ok(RT::Interface::Web);
43 package RT::Interface::Web;
50 # {{{ sub NewApacheHandler
52 =head2 NewApacheHandler
54 Takes extra options to pass to HTML::Mason::ApacheHandler->new
55 Returns a new Mason::ApacheHandler object
59 sub NewApacheHandler {
60 require HTML::Mason::ApacheHandler;
61 my $ah = new HTML::Mason::ApacheHandler(
64 [ local => $RT::MasonLocalComponentRoot ],
65 [ standard => $RT::MasonComponentRoot ]
68 default_escape_flags => 'h',
69 allow_globals => [qw(%session)],
70 data_dir => "$RT::MasonDataDir",
74 $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
81 # {{{ sub NewCGIHandler
85 Returns a new Mason::CGIHandler object
94 my $handler = HTML::Mason::CGIHandler->new(
96 [ local => $RT::MasonLocalComponentRoot ],
97 [ standard => $RT::MasonComponentRoot ]
99 data_dir => "$RT::MasonDataDir",
100 default_escape_flags => 'h',
101 allow_globals => [qw(%session)]
105 $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
116 =head2 EscapeUTF8 SCALARREF
118 does a css-busting but minimalist escaping of whatever html you're passing in.
129 $val =~ s/\(/(/g;
130 $val =~ s/\)/)/g;
134 Encode::_utf8_on($$ref);
141 package HTML::Mason::Commands;
143 use vars qw/$r $m %session/;
150 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
151 with whatever it's called with. If there is no $session{'CurrentUser'},
152 it creates a temporary user, so we have something to get a localisation handle
159 if ($session{'CurrentUser'} &&
160 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
161 return($session{'CurrentUser'}->loc(@_));
164 my $u = RT::CurrentUser->new($RT::SystemUser);
165 return ($u->loc(@_));
174 =head2 loc_fuzzy STRING
176 loc_fuzzy is for handling localizations of messages that may already
177 contain interpolated variables, typically returned from libraries
178 outside RT's control. It takes the message string and extracts the
179 variable array automatically by matching against the candidate entries
180 inside the lexicon file.
187 if ($session{'CurrentUser'} &&
188 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
189 return($session{'CurrentUser'}->loc_fuzzy($msg));
192 my $u = RT::CurrentUser->new($RT::SystemUser);
193 return ($u->loc_fuzzy($msg));
201 # Error - calls Error and aborts
204 if ($session{'ErrorDocument'} &&
205 $session{'ErrorDocumentType'}) {
206 $r->content_type($session{'ErrorDocumentType'});
207 $m->comp($session{'ErrorDocument'} , Why => shift);
211 $m->comp("/Elements/Error" , Why => shift);
218 # {{{ sub CreateTicket
220 =head2 CreateTicket ARGS
222 Create a new ticket, using Mason's %ARGS. returns @results.
231 my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
233 my $Queue = new RT::Queue( $session{'CurrentUser'} );
234 unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
235 Abort('Queue not found');
238 unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
239 Abort('You have no permission to create tickets in that queue.');
242 my $due = new RT::Date( $session{'CurrentUser'} );
243 $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
244 my $starts = new RT::Date( $session{'CurrentUser'} );
245 $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
247 my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} );
248 my @Cc = split ( /\s*,\s*/, $ARGS{'Cc'} );
249 my @AdminCc = split ( /\s*,\s*/, $ARGS{'AdminCc'} );
251 my $MIMEObj = MakeMIMEEntity(
252 Subject => $ARGS{'Subject'},
253 From => $ARGS{'From'},
255 Body => $ARGS{'Content'},
258 if ($ARGS{'Attachments'}) {
259 $MIMEObj->make_multipart;
260 $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}};
264 Queue => $ARGS{'Queue'},
265 Owner => $ARGS{'Owner'},
266 InitialPriority => $ARGS{'InitialPriority'},
267 FinalPriority => $ARGS{'FinalPriority'},
268 TimeLeft => $ARGS{'TimeLeft'},
269 TimeEstimated => $ARGS{'TimeEstimated'},
270 TimeWorked => $ARGS{'TimeWorked'},
271 Requestor => \@Requestors,
273 AdminCc => \@AdminCc,
274 Subject => $ARGS{'Subject'},
275 Status => $ARGS{'Status'},
277 Starts => $starts->ISO,
280 foreach my $arg (%ARGS) {
281 if ($arg =~ /^CustomField-(\d+)(.*?)$/) {
282 next if ($arg =~ /-Magic$/);
283 $create_args{"CustomField-".$1} = $ARGS{"$arg"};
286 my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
287 unless ( $id && $Trans ) {
290 my @linktypes = qw( DependsOn MemberOf RefersTo );
292 foreach my $linktype (@linktypes) {
293 foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) {
294 $luri =~ s/\s*$//; # Strip trailing whitespace
295 my ( $val, $msg ) = $Ticket->AddLink(
299 push ( @Actions, $msg ) unless ($val);
302 foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) {
303 my ( $val, $msg ) = $Ticket->AddLink(
308 push ( @Actions, $msg ) unless ($val);
312 push ( @Actions, split("\n", $ErrMsg) );
313 unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
314 Abort( "No permission to view newly created ticket #"
315 . $Ticket->id . "." );
317 return ( $Ticket, @Actions );
323 # {{{ sub LoadTicket - loads a ticket
327 Takes a ticket id as its only variable. if it's handed an array, it takes
330 Returns an RT::Ticket object as the current user.
337 if ( ref($id) eq "ARRAY" ) {
342 Abort("No ticket specified");
345 my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
347 unless ( $Ticket->id ) {
348 Abort("Could not load ticket $id");
355 # {{{ sub ProcessUpdateMessage
357 sub ProcessUpdateMessage {
359 #TODO document what else this takes.
367 #Make the update content have no 'weird' newlines in it
368 if ( $args{ARGSRef}->{'UpdateContent'} ) {
371 $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
373 $args{ARGSRef}->{'UpdateSubject'} = undef;
376 my $Message = MakeMIMEEntity(
377 Subject => $args{ARGSRef}->{'UpdateSubject'},
378 Body => $args{ARGSRef}->{'UpdateContent'},
381 if ($args{ARGSRef}->{'UpdateAttachments'}) {
382 $Message->make_multipart;
383 $Message->add_part($_) foreach values %{$args{ARGSRef}->{'UpdateAttachments'}};
386 ## TODO: Implement public comments
387 if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
388 my ( $Transaction, $Description ) = $args{TicketObj}->Comment(
389 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
390 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
392 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
394 push ( @{ $args{Actions} }, $Description );
396 elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
397 my ( $Transaction, $Description ) = $args{TicketObj}->Correspond(
398 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
399 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
401 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
403 push ( @{ $args{Actions} }, $Description );
406 push ( @{ $args{'Actions'} },
407 loc("Update type was neither correspondence nor comment.").
409 loc("Update not recorded.")
417 # {{{ sub MakeMIMEEntity
419 =head2 MakeMIMEEntity PARAMHASH
421 Takes a paramhash Subject, Body and AttachmentFieldName.
423 Returns a MIME::Entity.
429 #TODO document what else this takes.
435 AttachmentFieldName => undef,
436 map Encode::encode_utf8($_), @_,
439 #Make the update content have no 'weird' newlines in it
441 $args{'Body'} =~ s/\r\n/\n/gs;
444 # MIME::Head is not happy in utf-8 domain. This only happens
445 # when processing an incoming email (so far observed).
448 $Message = MIME::Entity->build(
449 Subject => $args{'Subject'} || "",
450 From => $args{'From'},
452 Data => [ $args{'Body'} ]
456 my $cgi_object = $m->cgi_object;
458 if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
462 use File::Temp qw(tempfile tempdir);
464 #foreach my $filehandle (@filenames) {
466 my ( $fh, $temp_file ) = tempfile();
468 binmode $fh; #thank you, windows
470 while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
474 my $uploadinfo = $cgi_object->uploadInfo($filehandle);
476 # Prefer the cached name first over CGI.pm stringification.
477 my $filename = $RT::Mason::CGI::Filename;
478 $filename = "$filehandle" unless defined($filename);
480 $filename =~ s#^.*[\\/]##;
484 Filename => $filename,
485 Type => $uploadinfo->{'Content-Type'},
493 $Message->make_singlepart();
494 RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
502 # {{{ sub ProcessSearchQuery
504 =head2 ProcessSearchQuery
506 Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
508 TODO Doc exactly what comes in the paramhash
513 sub ProcessSearchQuery {
516 ## TODO: The only parameter here is %ARGS. Maybe it would be
517 ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
518 ## instead of $args{ARGS}->{...} ? :)
520 #Searches are sticky.
521 if ( defined $session{'tickets'} ) {
523 # Reset the old search
524 $session{'tickets'}->GotoFirstItem;
529 $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
532 #Import a bookmarked search if we have one
533 if ( defined $args{ARGS}->{'Bookmark'} ) {
534 $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
537 # {{{ Goto next/prev page
538 if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
539 $session{'tickets'}->NextPage;
541 elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
542 $session{'tickets'}->PrevPage;
544 elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
545 $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
550 # {{{ Deal with limiting the search
552 if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
553 $session{'tickets_refresh_interval'} =
554 $args{ARGS}->{'RefreshSearchInterval'};
557 if ( $args{ARGS}->{'TicketsSortBy'} ) {
558 $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
559 $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
560 $session{'tickets'}->OrderBy(
561 FIELD => $args{ARGS}->{'TicketsSortBy'},
562 ORDER => $args{ARGS}->{'TicketsSortOrder'}
568 # {{{ Set the query limit
569 if ( defined $args{ARGS}->{'RowsPerPage'} ) {
571 "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
573 $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
574 $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
579 if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
580 $session{'tickets'}->LimitPriority(
581 VALUE => $args{ARGS}->{'ValueOfPriority'},
582 OPERATOR => $args{ARGS}->{'PriorityOp'}
588 if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
589 $session{'tickets'}->LimitOwner(
590 VALUE => $args{ARGS}->{'ValueOfOwner'},
591 OPERATOR => $args{ARGS}->{'OwnerOp'}
596 # {{{ Limit requestor email
598 if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) {
599 my $alias = $session{'tickets'}->LimitRequestor(
600 VALUE => $args{ARGS}->{'ValueOfRequestor'},
601 OPERATOR => $args{ARGS}->{'RequestorOp'},
608 if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
609 $session{'tickets'}->LimitQueue(
610 VALUE => $args{ARGS}->{'ValueOfQueue'},
611 OPERATOR => $args{ARGS}->{'QueueOp'}
617 if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
618 if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
619 foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
620 $session{'tickets'}->LimitStatus(
622 OPERATOR => $args{ARGS}->{'StatusOp'},
627 $session{'tickets'}->LimitStatus(
628 VALUE => $args{ARGS}->{'ValueOfStatus'},
629 OPERATOR => $args{ARGS}->{'StatusOp'},
637 if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
638 my $val = $args{ARGS}->{'ValueOfSubject'};
639 if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
642 $session{'tickets'}->LimitSubject(
644 OPERATOR => $args{ARGS}->{'SubjectOp'},
650 if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
651 my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
652 $args{ARGS}->{'DateType'} =~ s/_Date$//;
654 if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
655 $session{'tickets'}->LimitTransactionDate(
657 OPERATOR => $args{ARGS}->{'DateOp'},
661 $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
663 OPERATOR => $args{ARGS}->{'DateOp'},
670 if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
671 my $val = $args{ARGS}->{'ValueOfAttachmentField'};
672 if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
675 $session{'tickets'}->Limit(
676 FIELD => $args{ARGS}->{'AttachmentField'},
678 OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
684 # {{{ Limit CustomFields
686 foreach my $arg ( keys %{ $args{ARGS} } ) {
688 if ( $arg =~ /^CustomField(\d+)$/ ) {
694 next unless ( $args{ARGS}->{$arg} );
696 my $form = $args{ARGS}->{$arg};
697 my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
698 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
700 if ($oper =~ /like/i) {
701 $value = "%".$value."%";
703 if ( $value =~ /^null$/i ) {
705 #Don't quote the string 'null'
708 # Convert the operator to something apropriate for nulls
709 $oper = 'IS' if ( $oper eq '=' );
710 $oper = 'IS NOT' if ( $oper eq '!=' );
712 $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
714 QUOTEVALUE => $quote,
726 # {{{ sub ParseDateToISO
728 =head2 ParseDateToISO
730 Takes a date in an arbitrary format.
731 Returns an ISO date and time in GMT
738 my $date_obj = RT::Date->new($session{'CurrentUser'});
743 return ( $date_obj->ISO );
749 # TODO: This might eventually read the cookies, user configuration
750 # information from the DB, queue configuration information from the
756 return $args->{$key} || $RT::WebOptions{$key};
761 # {{{ sub ProcessACLChanges
763 sub ProcessACLChanges {
766 my %ARGS = %$ARGSref;
768 my ( $ACL, @results );
771 foreach my $arg (keys %ARGS) {
772 if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
773 my $principal_id = $1;
774 my $object_type = $2;
776 my $rights = $ARGS{$arg};
778 my $principal = RT::Principal->new($session{'CurrentUser'});
779 $principal->Load($principal_id);
783 if ($object_type eq 'RT::Queue') {
784 $obj = RT::Queue->new($session{'CurrentUser'});
785 $obj->Load($object_id);
786 } elsif ($object_type eq 'RT::Group') {
787 $obj = RT::Group->new($session{'CurrentUser'});
788 $obj->Load($object_id);
790 } elsif ($object_type eq 'RT::System') {
793 push (@results, loc("System Error").
794 loc("Rights could not be granted for [_1]", $object_type));
798 my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
799 foreach my $right (@rights) {
800 next unless ($right);
801 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
802 push (@results, $msg);
805 elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
806 my $principal_id = $1;
807 my $object_type = $2;
811 my $principal = RT::Principal->new($session{'CurrentUser'});
812 $principal->Load($principal_id);
813 next unless ($right);
816 if ($object_type eq 'RT::Queue') {
817 $obj = RT::Queue->new($session{'CurrentUser'});
818 $obj->Load($object_id);
819 } elsif ($object_type eq 'RT::Group') {
820 $obj = RT::Group->new($session{'CurrentUser'});
821 $obj->Load($object_id);
823 } elsif ($object_type eq 'RT::System') {
826 push (@results, loc("System Error").
827 loc("Rights could not be revoked for [_1]", $object_type));
830 my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
831 push (@results, $msg);
843 # {{{ sub UpdateRecordObj
845 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
847 @attribs is a list of ticket fields to check and update if they differ from the B<Object>'s current values. ARGSRef is a ref to HTML::Mason's %ARGS.
849 Returns an array of success/failure messages
853 sub UpdateRecordObject {
856 AttributesRef => undef,
858 AttributePrefix => undef,
864 my $object = $args{'Object'};
865 my $attributes = $args{'AttributesRef'};
866 my $ARGSRef = $args{'ARGSRef'};
867 foreach my $attribute (@$attributes) {
869 if ( defined $ARGSRef->{$attribute} ) {
870 $value = $ARGSRef->{$attribute};
873 defined( $args{'AttributePrefix'} )
875 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
878 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
884 $value =~ s/\r\n/\n/gs;
886 if ($value ne $object->$attribute()){
888 my $method = "Set$attribute";
889 my ( $code, $msg ) = $object->$method($value);
891 push @results, loc($attribute) . ': ' . loc_fuzzy($msg);
893 "[_1] could not be set to [_2].", # loc
894 "That is already the current value", # loc
895 "No value sent to _Set!\n", # loc
896 "Illegal value for [_1]", # loc
897 "The new value has been set.", # loc
898 "No column specified", # loc
899 "Immutable field", # loc
900 "Nonexistant field?", # loc
901 "Invalid data", # loc
902 "Couldn't find row", # loc
903 "Missing a primary key?: [_1]", # loc
904 "Found Object", # loc
913 # {{{ Sub ProcessCustomFieldUpdates
915 sub ProcessCustomFieldUpdates {
917 CustomFieldObj => undef,
922 my $Object = $args{'CustomFieldObj'};
923 my $ARGSRef = $args{'ARGSRef'};
925 my @attribs = qw( Name Type Description Queue SortOrder);
926 my @results = UpdateRecordObject(
927 AttributesRef => \@attribs,
932 if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
934 my ( $addval, $addmsg ) = $Object->AddValue(
936 $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
937 Description => $ARGSRef->{ "CustomField-"
939 . "-AddValue-Description" },
940 SortOrder => $ARGSRef->{ "CustomField-"
942 . "-AddValue-SortOrder" },
944 push ( @results, $addmsg );
946 my @delete_values = (
947 ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
949 ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
950 : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
951 foreach my $id (@delete_values) {
952 next unless defined $id;
953 my ( $err, $msg ) = $Object->DeleteValue($id);
954 push ( @results, $msg );
961 # {{{ sub ProcessTicketBasics
963 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
965 Returns an array of results messages.
969 sub ProcessTicketBasics {
977 my $TicketObj = $args{'TicketObj'};
978 my $ARGSRef = $args{'ARGSRef'};
980 # {{{ Set basic fields
992 if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
993 my $tempqueue = RT::Queue->new($RT::SystemUser);
994 $tempqueue->Load( $ARGSRef->{'Queue'} );
995 if ( $tempqueue->id ) {
996 $ARGSRef->{'Queue'} = $tempqueue->Id();
1000 my @results = UpdateRecordObject(
1001 AttributesRef => \@attribs,
1002 Object => $TicketObj,
1006 # We special case owner changing, so we can use ForceOwnerChange
1007 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1009 if ( $ARGSRef->{'ForceOwnerChange'} ) {
1010 $ChownType = "Force";
1013 $ChownType = "Give";
1017 $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1018 push ( @results, $msg );
1028 # {{{ Sub ProcessTicketCustomFieldUpdates
1030 sub ProcessTicketCustomFieldUpdates {
1038 my $ARGSRef = $args{'ARGSRef'};
1040 # Build up a list of tickets that we want to work with
1042 my %custom_fields_to_mod;
1043 foreach my $arg ( keys %{$ARGSRef} ) {
1044 if ( $arg =~ /^Ticket-(\d+)-CustomField-(\d+)-/ ) {
1046 # For each of those tickets, find out what custom fields we want to work with.
1047 $custom_fields_to_mod{$1}{$2} = 1;
1051 # For each of those tickets
1052 foreach my $tick ( keys %custom_fields_to_mod ) {
1053 my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
1054 $Ticket->Load($tick);
1056 # For each custom field
1057 foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) {
1059 my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
1060 $CustomFieldObj->LoadById($cf);
1062 foreach my $arg ( keys %{$ARGSRef} ) {
1063 # since http won't pass in a form element with a null value, we need
1065 if ($arg =~ /^(.*?)-Values-Magic$/ ) {
1066 # We don't care about the magic, if there's really a values element;
1067 next if (exists $ARGSRef->{$1.'-Values'}) ;
1069 $arg = $1."-Values";
1070 $ARGSRef->{$1."-Values"} = undef;
1073 next unless ( $arg =~ /^Ticket-$tick-CustomField-$cf-/ );
1075 ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' )
1076 ? @{ $ARGSRef->{$arg} }
1077 : ( $ARGSRef->{$arg} );
1078 if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
1079 foreach my $value (@values) {
1080 next unless ($value);
1081 my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1085 push ( @results, $msg );
1088 elsif ( $arg =~ /-DeleteValues$/ ) {
1089 foreach my $value (@values) {
1090 next unless ($value);
1091 my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
1095 push ( @results, $msg );
1098 elsif ( $arg =~ /-Values$/ and $CustomFieldObj->Type !~ /Entry/) {
1099 my $cf_values = $Ticket->CustomFieldValues($cf);
1102 foreach my $value (@values) {
1103 next unless ($value);
1105 # build up a hash of values that the new set has
1106 $values_hash{$value} = 1;
1108 unless ( $cf_values->HasEntry($value) ) {
1109 my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1113 push ( @results, $msg );
1117 while ( my $cf_value = $cf_values->Next ) {
1118 unless ( $values_hash{ $cf_value->Content } == 1 ) {
1119 my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
1121 Value => $cf_value->Content
1123 push ( @results, $msg);
1129 elsif ( $arg =~ /-Values$/ ) {
1130 my $cf_values = $Ticket->CustomFieldValues($cf);
1132 # keep everything up to the point of difference, delete the rest
1134 foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1135 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1144 # now add/replace extra things, if any
1145 foreach my $value (@values) {
1146 my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1150 push ( @results, $msg );
1154 push ( @results, "User asked for an unknown update type for custom field " . $cf->Name . " for ticket " . $Ticket->id );
1164 # {{{ sub ProcessTicketWatchers
1166 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1168 Returns an array of results messages.
1172 sub ProcessTicketWatchers {
1180 my $Ticket = $args{'TicketObj'};
1181 my $ARGSRef = $args{'ARGSRef'};
1183 # {{{ Munge watchers
1185 foreach my $key ( keys %$ARGSRef ) {
1187 # {{{ Delete deletable watchers
1188 if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ ) ) {
1189 my ( $code, $msg ) =
1190 $Ticket->DeleteWatcher(PrincipalId => $2,
1192 push @results, $msg;
1195 # Delete watchers in the simple style demanded by the bulk manipulator
1196 elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1197 my ( $code, $msg ) = $Ticket->DeleteWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1198 push @results, $msg;
1203 # Add new wathchers by email address
1204 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1205 and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1208 #They're in this order because otherwise $1 gets clobbered :/
1209 my ( $code, $msg ) = $Ticket->AddWatcher(
1210 Type => $ARGSRef->{$key},
1211 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1213 push @results, $msg;
1216 #Add requestors in the simple style demanded by the bulk manipulator
1217 elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1218 my ( $code, $msg ) = $Ticket->AddWatcher(
1220 Email => $ARGSRef->{$key}
1222 push @results, $msg;
1225 # Add new watchers by owner
1226 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1227 and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
1229 #They're in this order because otherwise $1 gets clobbered :/
1230 my ( $code, $msg ) =
1231 $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1232 push @results, $msg;
1243 # {{{ sub ProcessTicketDates
1245 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1247 Returns an array of results messages.
1251 sub ProcessTicketDates {
1258 my $Ticket = $args{'TicketObj'};
1259 my $ARGSRef = $args{'ARGSRef'};
1263 # {{{ Set date fields
1264 my @date_fields = qw(
1272 #Run through each field in this list. update the value if apropriate
1273 foreach my $field (@date_fields) {
1276 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1278 #If it's something other than just whitespace
1279 if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1281 Format => 'unknown',
1282 Value => $ARGSRef->{ $field . '_Date' }
1284 my $obj = $field . "Obj";
1285 if ( ( defined $DateObj->Unix )
1286 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1288 my $method = "Set$field";
1289 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1290 push @results, "$msg";
1301 # {{{ sub ProcessTicketLinks
1303 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1305 Returns an array of results messages.
1309 sub ProcessTicketLinks {
1310 my %args = ( TicketObj => undef,
1314 my $Ticket = $args{'TicketObj'};
1315 my $ARGSRef = $args{'ARGSRef'};
1319 # Delete links that are gone gone gone.
1320 foreach my $arg ( keys %$ARGSRef ) {
1321 if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1327 "Trying to delete: Base: $base Target: $target Type $type";
1328 my ( $val, $msg ) = $Ticket->DeleteLink( Base => $base,
1330 Target => $target );
1332 push @results, $msg;
1338 my @linktypes = qw( DependsOn MemberOf RefersTo );
1340 foreach my $linktype (@linktypes) {
1341 if ( $ARGSRef->{ $Ticket->Id . "-$linktype" } ) {
1342 for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) {
1343 $luri =~ s/\s*$//; # Strip trailing whitespace
1344 my ( $val, $msg ) = $Ticket->AddLink( Target => $luri,
1345 Type => $linktype );
1346 push @results, $msg;
1349 if ( $ARGSRef->{ "$linktype-" . $Ticket->Id } ) {
1351 for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) {
1352 my ( $val, $msg ) = $Ticket->AddLink( Base => $luri,
1353 Type => $linktype );
1355 push @results, $msg;
1360 #Merge if we need to
1361 if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1363 $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1364 push @results, $msg;
1372 eval "require RT::Interface::Web_Vendor";
1373 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1374 eval "require RT::Interface::Web_Local";
1375 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});