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",
75 $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
82 # {{{ sub NewCGIHandler
86 Returns a new Mason::CGIHandler object
95 my $handler = HTML::Mason::CGIHandler->new(
97 [ local => $RT::MasonLocalComponentRoot ],
98 [ standard => $RT::MasonComponentRoot ]
100 data_dir => "$RT::MasonDataDir",
101 default_escape_flags => 'h',
102 allow_globals => [qw(%session)],
107 $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
118 =head2 EscapeUTF8 SCALARREF
120 does a css-busting but minimalist escaping of whatever html you're passing in.
131 $val =~ s/\(/(/g;
132 $val =~ s/\)/)/g;
136 Encode::_utf8_on($$ref);
142 # {{{ WebCanonicalizeInfo
144 =head2 WebCanonicalizeInfo();
146 Different web servers set different environmental varibles. This
147 function must return something suitable for REMOTE_USER. By default,
148 just downcase $ENV{'REMOTE_USER'}
152 sub WebCanonicalizeInfo {
155 if ( defined $ENV{'REMOTE_USER'} ) {
156 $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) );
164 # {{{ WebExternalAutoInfo
166 =head2 WebExternalAutoInfo($user);
168 Returns a hash of user attributes, used when WebExternalAuto is set.
172 sub WebExternalAutoInfo {
177 $user_info{'Privileged'} = 1;
179 if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
180 # Populate fields with information from Unix /etc/passwd
182 my ($comments, $realname) = (getpwnam($user))[5, 6];
183 $user_info{'Comments'} = $comments if defined $comments;
184 $user_info{'RealName'} = $realname if defined $realname;
186 elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
187 # Populate fields with information from NT domain controller
190 # and return the wad of stuff
197 package HTML::Mason::Commands;
199 use vars qw/$r $m %session/;
206 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
207 with whatever it's called with. If there is no $session{'CurrentUser'},
208 it creates a temporary user, so we have something to get a localisation handle
215 if ($session{'CurrentUser'} &&
216 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
217 return($session{'CurrentUser'}->loc(@_));
219 elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
220 return ($u->loc(@_));
223 # pathetic case -- SystemUser is gone.
233 =head2 loc_fuzzy STRING
235 loc_fuzzy is for handling localizations of messages that may already
236 contain interpolated variables, typically returned from libraries
237 outside RT's control. It takes the message string and extracts the
238 variable array automatically by matching against the candidate entries
239 inside the lexicon file.
246 if ($session{'CurrentUser'} &&
247 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
248 return($session{'CurrentUser'}->loc_fuzzy($msg));
251 my $u = RT::CurrentUser->new($RT::SystemUser->Id);
252 return ($u->loc_fuzzy($msg));
260 # Error - calls Error and aborts
263 if ($session{'ErrorDocument'} &&
264 $session{'ErrorDocumentType'}) {
265 $r->content_type($session{'ErrorDocumentType'});
266 $m->comp($session{'ErrorDocument'} , Why => shift);
270 $m->comp("/Elements/Error" , Why => shift);
277 # {{{ sub CreateTicket
279 =head2 CreateTicket ARGS
281 Create a new ticket, using Mason's %ARGS. returns @results.
290 my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
292 my $Queue = new RT::Queue( $session{'CurrentUser'} );
293 unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
294 Abort('Queue not found');
297 unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
298 Abort('You have no permission to create tickets in that queue.');
301 my $due = new RT::Date( $session{'CurrentUser'} );
302 $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
303 my $starts = new RT::Date( $session{'CurrentUser'} );
304 $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
306 my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} );
307 my @Cc = split ( /\s*,\s*/, $ARGS{'Cc'} );
308 my @AdminCc = split ( /\s*,\s*/, $ARGS{'AdminCc'} );
310 my $MIMEObj = MakeMIMEEntity(
311 Subject => $ARGS{'Subject'},
312 From => $ARGS{'From'},
314 Body => $ARGS{'Content'},
317 if ($ARGS{'Attachments'}) {
318 $MIMEObj->make_multipart;
319 $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}};
323 Queue => $ARGS{'Queue'},
324 Owner => $ARGS{'Owner'},
325 InitialPriority => $ARGS{'InitialPriority'},
326 FinalPriority => $ARGS{'FinalPriority'},
327 TimeLeft => $ARGS{'TimeLeft'},
328 TimeEstimated => $ARGS{'TimeEstimated'},
329 TimeWorked => $ARGS{'TimeWorked'},
330 Requestor => \@Requestors,
332 AdminCc => \@AdminCc,
333 Subject => $ARGS{'Subject'},
334 Status => $ARGS{'Status'},
336 Starts => $starts->ISO,
339 foreach my $arg (%ARGS) {
340 if ($arg =~ /^CustomField-(\d+)(.*?)$/) {
341 next if ($arg =~ /-Magic$/);
342 $create_args{"CustomField-".$1} = $ARGS{"$arg"};
345 my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
346 unless ( $id && $Trans ) {
349 my @linktypes = qw( DependsOn MemberOf RefersTo );
351 foreach my $linktype (@linktypes) {
352 foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) {
353 $luri =~ s/\s*$//; # Strip trailing whitespace
354 my ( $val, $msg ) = $Ticket->AddLink(
358 push ( @Actions, $msg ) unless ($val);
361 foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) {
362 my ( $val, $msg ) = $Ticket->AddLink(
367 push ( @Actions, $msg ) unless ($val);
371 push ( @Actions, split("\n", $ErrMsg) );
372 unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
373 Abort( "No permission to view newly created ticket #"
374 . $Ticket->id . "." );
376 return ( $Ticket, @Actions );
382 # {{{ sub LoadTicket - loads a ticket
386 Takes a ticket id as its only variable. if it's handed an array, it takes
389 Returns an RT::Ticket object as the current user.
396 if ( ref($id) eq "ARRAY" ) {
401 Abort("No ticket specified");
404 my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
406 unless ( $Ticket->id ) {
407 Abort("Could not load ticket $id");
414 # {{{ sub ProcessUpdateMessage
416 sub ProcessUpdateMessage {
418 #TODO document what else this takes.
426 #Make the update content have no 'weird' newlines in it
427 if ( $args{ARGSRef}->{'UpdateContent'} ||
428 $args{ARGSRef}->{'UpdateAttachments'}) {
431 $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
433 $args{ARGSRef}->{'UpdateSubject'} = undef;
436 my $Message = MakeMIMEEntity(
437 Subject => $args{ARGSRef}->{'UpdateSubject'},
438 Body => $args{ARGSRef}->{'UpdateContent'},
441 if ($args{ARGSRef}->{'UpdateAttachments'}) {
442 $Message->make_multipart;
443 $Message->add_part($_) foreach values %{$args{ARGSRef}->{'UpdateAttachments'}};
446 ## TODO: Implement public comments
447 if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
448 my ( $Transaction, $Description ) = $args{TicketObj}->Comment(
449 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
450 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
452 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
454 push ( @{ $args{Actions} }, $Description );
456 elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
457 my ( $Transaction, $Description ) = $args{TicketObj}->Correspond(
458 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
459 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
461 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
463 push ( @{ $args{Actions} }, $Description );
466 push ( @{ $args{'Actions'} },
467 loc("Update type was neither correspondence nor comment.").
469 loc("Update not recorded.")
477 # {{{ sub MakeMIMEEntity
479 =head2 MakeMIMEEntity PARAMHASH
481 Takes a paramhash Subject, Body and AttachmentFieldName.
483 Returns a MIME::Entity.
489 #TODO document what else this takes.
495 AttachmentFieldName => undef,
496 # map Encode::encode_utf8($_), @_,
500 #Make the update content have no 'weird' newlines in it
502 $args{'Body'} =~ s/\r\n/\n/gs;
505 # MIME::Head is not happy in utf-8 domain. This only happens
506 # when processing an incoming email (so far observed).
509 $Message = MIME::Entity->build(
510 Subject => $args{'Subject'} || "",
511 From => $args{'From'},
514 Data => [ $args{'Body'} ]
518 my $cgi_object = $m->cgi_object;
520 if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
524 use File::Temp qw(tempfile tempdir);
526 #foreach my $filehandle (@filenames) {
528 my ( $fh, $temp_file );
530 # on NFS and NTFS, it is possible that tempfile() conflicts
531 # with other processes, causing a race condition. we try to
532 # accommodate this by pausing and retrying.
533 last if ($fh, $temp_file) = eval { tempfile() };
537 binmode $fh; #thank you, windows
539 while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
543 my $uploadinfo = $cgi_object->uploadInfo($filehandle);
545 # Prefer the cached name first over CGI.pm stringification.
546 my $filename = $RT::Mason::CGI::Filename;
547 $filename = "$filehandle" unless defined($filename);
549 $filename =~ s#^.*[\\/]##;
553 Filename => Encode::decode_utf8($filename),
554 Type => $uploadinfo->{'Content-Type'},
562 $Message->make_singlepart();
563 RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
571 # {{{ sub ProcessSearchQuery
573 =head2 ProcessSearchQuery
575 Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
577 TODO Doc exactly what comes in the paramhash
582 sub ProcessSearchQuery {
585 ## TODO: The only parameter here is %ARGS. Maybe it would be
586 ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
587 ## instead of $args{ARGS}->{...} ? :)
589 #Searches are sticky.
590 if ( defined $session{'tickets'} ) {
592 # Reset the old search
593 $session{'tickets'}->GotoFirstItem;
598 $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
601 #Import a bookmarked search if we have one
602 if ( defined $args{ARGS}->{'Bookmark'} ) {
603 $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
606 # {{{ Goto next/prev page
607 if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
608 $session{'tickets'}->NextPage;
610 elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
611 $session{'tickets'}->PrevPage;
613 elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
614 $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
619 # {{{ Deal with limiting the search
621 if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
622 $session{'tickets_refresh_interval'} =
623 $args{ARGS}->{'RefreshSearchInterval'};
626 if ( $args{ARGS}->{'TicketsSortBy'} ) {
627 $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
628 $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
629 $session{'tickets'}->OrderBy(
630 FIELD => $args{ARGS}->{'TicketsSortBy'},
631 ORDER => $args{ARGS}->{'TicketsSortOrder'}
637 # {{{ Set the query limit
638 if ( defined $args{ARGS}->{'RowsPerPage'} ) {
640 "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
642 $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
643 $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
648 if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
649 $session{'tickets'}->LimitPriority(
650 VALUE => $args{ARGS}->{'ValueOfPriority'},
651 OPERATOR => $args{ARGS}->{'PriorityOp'}
657 if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
658 $session{'tickets'}->LimitOwner(
659 VALUE => $args{ARGS}->{'ValueOfOwner'},
660 OPERATOR => $args{ARGS}->{'OwnerOp'}
665 # {{{ Limit requestor email
666 if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
667 $session{'tickets'}->LimitWatcher(
668 TYPE => $args{ARGS}->{'WatcherRole'},
669 VALUE => $args{ARGS}->{'ValueOfWatcherRole'},
670 OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
677 if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
678 $session{'tickets'}->LimitQueue(
679 VALUE => $args{ARGS}->{'ValueOfQueue'},
680 OPERATOR => $args{ARGS}->{'QueueOp'}
686 if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
687 if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
688 foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
689 $session{'tickets'}->LimitStatus(
691 OPERATOR => $args{ARGS}->{'StatusOp'},
696 $session{'tickets'}->LimitStatus(
697 VALUE => $args{ARGS}->{'ValueOfStatus'},
698 OPERATOR => $args{ARGS}->{'StatusOp'},
706 if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
707 my $val = $args{ARGS}->{'ValueOfSubject'};
708 if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
711 $session{'tickets'}->LimitSubject(
713 OPERATOR => $args{ARGS}->{'SubjectOp'},
719 if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
720 my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
721 $args{ARGS}->{'DateType'} =~ s/_Date$//;
723 if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
724 $session{'tickets'}->LimitTransactionDate(
726 OPERATOR => $args{ARGS}->{'DateOp'},
730 $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
732 OPERATOR => $args{ARGS}->{'DateOp'},
739 if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
740 my $val = $args{ARGS}->{'ValueOfAttachmentField'};
741 if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
744 $session{'tickets'}->Limit(
745 FIELD => $args{ARGS}->{'AttachmentField'},
747 OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
753 # {{{ Limit CustomFields
755 foreach my $arg ( keys %{ $args{ARGS} } ) {
757 if ( $arg =~ /^CustomField(\d+)$/ ) {
763 next unless ( $args{ARGS}->{$arg} );
765 my $form = $args{ARGS}->{$arg};
766 my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
767 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
769 if ($oper =~ /like/i) {
770 $value = "%".$value."%";
772 if ( $value =~ /^null$/i ) {
774 #Don't quote the string 'null'
777 # Convert the operator to something apropriate for nulls
778 $oper = 'IS' if ( $oper eq '=' );
779 $oper = 'IS NOT' if ( $oper eq '!=' );
781 $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
783 QUOTEVALUE => $quote,
795 # {{{ sub ParseDateToISO
797 =head2 ParseDateToISO
799 Takes a date in an arbitrary format.
800 Returns an ISO date and time in GMT
807 my $date_obj = RT::Date->new($session{'CurrentUser'});
812 return ( $date_obj->ISO );
818 # TODO: This might eventually read the cookies, user configuration
819 # information from the DB, queue configuration information from the
825 return $args->{$key} || $RT::WebOptions{$key};
830 # {{{ sub ProcessACLChanges
832 sub ProcessACLChanges {
835 my %ARGS = %$ARGSref;
837 my ( $ACL, @results );
840 foreach my $arg (keys %ARGS) {
841 if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
842 my $principal_id = $1;
843 my $object_type = $2;
845 my $rights = $ARGS{$arg};
847 my $principal = RT::Principal->new($session{'CurrentUser'});
848 $principal->Load($principal_id);
852 if ($object_type eq 'RT::System') {
854 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
855 $obj = $object_type->new($session{'CurrentUser'});
856 $obj->Load($object_id);
858 push (@results, loc("System Error"). ': '.
859 loc("Rights could not be granted for [_1]", $object_type));
863 my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
864 foreach my $right (@rights) {
865 next unless ($right);
866 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
867 push (@results, $msg);
870 elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
871 my $principal_id = $1;
872 my $object_type = $2;
876 my $principal = RT::Principal->new($session{'CurrentUser'});
877 $principal->Load($principal_id);
878 next unless ($right);
881 if ($object_type eq 'RT::System') {
883 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
884 $obj = $object_type->new($session{'CurrentUser'});
885 $obj->Load($object_id);
888 push (@results, loc("System Error"). ': '.
889 loc("Rights could not be revoked for [_1]", $object_type));
892 my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
893 push (@results, $msg);
905 # {{{ sub UpdateRecordObj
907 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
909 @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.
911 Returns an array of success/failure messages
915 sub UpdateRecordObject {
918 AttributesRef => undef,
920 AttributePrefix => undef,
926 my $object = $args{'Object'};
927 my $attributes = $args{'AttributesRef'};
928 my $ARGSRef = $args{'ARGSRef'};
929 foreach my $attribute (@$attributes) {
931 if ( defined $ARGSRef->{$attribute} ) {
932 $value = $ARGSRef->{$attribute};
935 defined( $args{'AttributePrefix'} )
937 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
940 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
946 $value =~ s/\r\n/\n/gs;
948 if ($value ne $object->$attribute()){
950 my $method = "Set$attribute";
951 my ( $code, $msg ) = $object->$method($value);
953 push @results, loc($attribute) . ': ' . loc_fuzzy($msg);
955 "[_1] could not be set to [_2].", # loc
956 "That is already the current value", # loc
957 "No value sent to _Set!\n", # loc
958 "Illegal value for [_1]", # loc
959 "The new value has been set.", # loc
960 "No column specified", # loc
961 "Immutable field", # loc
962 "Nonexistant field?", # loc
963 "Invalid data", # loc
964 "Couldn't find row", # loc
965 "Missing a primary key?: [_1]", # loc
966 "Found Object", # loc
975 # {{{ Sub ProcessCustomFieldUpdates
977 sub ProcessCustomFieldUpdates {
979 CustomFieldObj => undef,
984 my $Object = $args{'CustomFieldObj'};
985 my $ARGSRef = $args{'ARGSRef'};
987 my @attribs = qw( Name Type Description Queue SortOrder);
988 my @results = UpdateRecordObject(
989 AttributesRef => \@attribs,
994 if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
996 my ( $addval, $addmsg ) = $Object->AddValue(
998 $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
999 Description => $ARGSRef->{ "CustomField-"
1001 . "-AddValue-Description" },
1002 SortOrder => $ARGSRef->{ "CustomField-"
1004 . "-AddValue-SortOrder" },
1006 push ( @results, $addmsg );
1008 my @delete_values = (
1009 ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1011 ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
1012 : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
1013 foreach my $id (@delete_values) {
1014 next unless defined $id;
1015 my ( $err, $msg ) = $Object->DeleteValue($id);
1016 push ( @results, $msg );
1019 my $vals = $Object->Values();
1020 while (my $cfv = $vals->Next()) {
1021 if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
1022 if ($cfv->SortOrder != $so) {
1023 my ( $err, $msg ) = $cfv->SetSortOrder($so);
1024 push ( @results, $msg );
1034 # {{{ sub ProcessTicketBasics
1036 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1038 Returns an array of results messages.
1042 sub ProcessTicketBasics {
1050 my $TicketObj = $args{'TicketObj'};
1051 my $ARGSRef = $args{'ARGSRef'};
1053 # {{{ Set basic fields
1065 if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
1066 my $tempqueue = RT::Queue->new($RT::SystemUser);
1067 $tempqueue->Load( $ARGSRef->{'Queue'} );
1068 if ( $tempqueue->id ) {
1069 $ARGSRef->{'Queue'} = $tempqueue->Id();
1073 my @results = UpdateRecordObject(
1074 AttributesRef => \@attribs,
1075 Object => $TicketObj,
1079 # We special case owner changing, so we can use ForceOwnerChange
1080 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1082 if ( $ARGSRef->{'ForceOwnerChange'} ) {
1083 $ChownType = "Force";
1086 $ChownType = "Give";
1090 $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1091 push ( @results, $msg );
1101 # {{{ Sub ProcessTicketCustomFieldUpdates
1103 sub ProcessTicketCustomFieldUpdates {
1111 my $ARGSRef = $args{'ARGSRef'};
1113 # Build up a list of tickets that we want to work with
1115 my %custom_fields_to_mod;
1116 foreach my $arg ( keys %{$ARGSRef} ) {
1117 if ( $arg =~ /^Ticket-(\d+)-CustomField-(\d+)-/ ) {
1119 # For each of those tickets, find out what custom fields we want to work with.
1120 $custom_fields_to_mod{$1}{$2} = 1;
1124 # For each of those tickets
1125 foreach my $tick ( keys %custom_fields_to_mod ) {
1126 my $Ticket = $args{'TicketObj'};
1127 if (!$Ticket or $Ticket->id != $tick) {
1128 $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
1129 $Ticket->Load($tick);
1132 # For each custom field
1133 foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) {
1135 my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
1136 $CustomFieldObj->LoadById($cf);
1138 foreach my $arg ( keys %{$ARGSRef} ) {
1139 # since http won't pass in a form element with a null value, we need
1141 if ($arg =~ /^(.*?)-Values-Magic$/ ) {
1142 # We don't care about the magic, if there's really a values element;
1143 next if (exists $ARGSRef->{$1.'-Values'}) ;
1145 $arg = $1."-Values";
1146 $ARGSRef->{$1."-Values"} = undef;
1149 next unless ( $arg =~ /^Ticket-$tick-CustomField-$cf-/ );
1151 ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' )
1152 ? @{ $ARGSRef->{$arg} }
1153 : split /\n/, $ARGSRef->{$arg} ;
1154 if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
1155 foreach my $value (@values) {
1156 next unless length($value);
1157 my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1161 push ( @results, $msg );
1164 elsif ( $arg =~ /-DeleteValues$/ ) {
1165 foreach my $value (@values) {
1166 next unless length($value);
1167 my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
1171 push ( @results, $msg );
1174 elsif ( $arg =~ /-Values$/ and $CustomFieldObj->Type !~ /Entry/) {
1175 my $cf_values = $Ticket->CustomFieldValues($cf);
1178 foreach my $value (@values) {
1179 next unless length($value);
1181 # build up a hash of values that the new set has
1182 $values_hash{$value} = 1;
1184 unless ( $cf_values->HasEntry($value) ) {
1185 my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1189 push ( @results, $msg );
1193 while ( my $cf_value = $cf_values->Next ) {
1194 unless ( $values_hash{ $cf_value->Content } == 1 ) {
1195 my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
1197 Value => $cf_value->Content
1199 push ( @results, $msg);
1205 elsif ( $arg =~ /-Values$/ ) {
1206 my $cf_values = $Ticket->CustomFieldValues($cf);
1208 # keep everything up to the point of difference, delete the rest
1210 foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1211 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1220 # now add/replace extra things, if any
1221 foreach my $value (@values) {
1222 my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1226 push ( @results, $msg );
1230 push ( @results, "User asked for an unknown update type for custom field " . $cf->Name . " for ticket " . $Ticket->id );
1240 # {{{ sub ProcessTicketWatchers
1242 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1244 Returns an array of results messages.
1248 sub ProcessTicketWatchers {
1256 my $Ticket = $args{'TicketObj'};
1257 my $ARGSRef = $args{'ARGSRef'};
1259 # {{{ Munge watchers
1261 foreach my $key ( keys %$ARGSRef ) {
1263 # {{{ Delete deletable watchers
1264 if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ ) ) {
1265 my ( $code, $msg ) =
1266 $Ticket->DeleteWatcher(PrincipalId => $2,
1268 push @results, $msg;
1271 # Delete watchers in the simple style demanded by the bulk manipulator
1272 elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1273 my ( $code, $msg ) = $Ticket->DeleteWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1274 push @results, $msg;
1279 # Add new wathchers by email address
1280 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1281 and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1284 #They're in this order because otherwise $1 gets clobbered :/
1285 my ( $code, $msg ) = $Ticket->AddWatcher(
1286 Type => $ARGSRef->{$key},
1287 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1289 push @results, $msg;
1292 #Add requestors in the simple style demanded by the bulk manipulator
1293 elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1294 my ( $code, $msg ) = $Ticket->AddWatcher(
1296 Email => $ARGSRef->{$key}
1298 push @results, $msg;
1301 # Add new watchers by owner
1302 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1303 and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
1305 #They're in this order because otherwise $1 gets clobbered :/
1306 my ( $code, $msg ) =
1307 $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1308 push @results, $msg;
1319 # {{{ sub ProcessTicketDates
1321 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1323 Returns an array of results messages.
1327 sub ProcessTicketDates {
1334 my $Ticket = $args{'TicketObj'};
1335 my $ARGSRef = $args{'ARGSRef'};
1339 # {{{ Set date fields
1340 my @date_fields = qw(
1348 #Run through each field in this list. update the value if apropriate
1349 foreach my $field (@date_fields) {
1352 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1354 #If it's something other than just whitespace
1355 if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1357 Format => 'unknown',
1358 Value => $ARGSRef->{ $field . '_Date' }
1360 my $obj = $field . "Obj";
1361 if ( ( defined $DateObj->Unix )
1362 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1364 my $method = "Set$field";
1365 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1366 push @results, "$msg";
1377 # {{{ sub ProcessTicketLinks
1379 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1381 Returns an array of results messages.
1385 sub ProcessTicketLinks {
1386 my %args = ( TicketObj => undef,
1390 my $Ticket = $args{'TicketObj'};
1391 my $ARGSRef = $args{'ARGSRef'};
1395 # Delete links that are gone gone gone.
1396 foreach my $arg ( keys %$ARGSRef ) {
1397 if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1403 "Trying to delete: Base: $base Target: $target Type $type";
1404 my ( $val, $msg ) = $Ticket->DeleteLink( Base => $base,
1406 Target => $target );
1408 push @results, $msg;
1414 my @linktypes = qw( DependsOn MemberOf RefersTo );
1416 foreach my $linktype (@linktypes) {
1417 if ( $ARGSRef->{ $Ticket->Id . "-$linktype" } ) {
1418 for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) {
1419 $luri =~ s/\s*$//; # Strip trailing whitespace
1420 my ( $val, $msg ) = $Ticket->AddLink( Target => $luri,
1421 Type => $linktype );
1422 push @results, $msg;
1425 if ( $ARGSRef->{ "$linktype-" . $Ticket->Id } ) {
1427 for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) {
1428 my ( $val, $msg ) = $Ticket->AddLink( Base => $luri,
1429 Type => $linktype );
1431 push @results, $msg;
1436 #Merge if we need to
1437 if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1439 $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1440 push @results, $msg;
1448 eval "require RT::Interface::Web_Vendor";
1449 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1450 eval "require RT::Interface::Web_Local";
1451 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});