1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
6 # <jesse@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
28 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
45 # END BPS TAGGED BLOCK }}}
46 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
48 ## This is a library of static subs to be used by the Mason web
58 use_ok(RT::Interface::Web);
65 package RT::Interface::Web;
72 =head2 EscapeUTF8 SCALARREF
74 does a css-busting but minimalist escaping of whatever html you're passing in.
80 return unless defined $$ref;
91 Encode::_utf8_on($$ref);
100 =head2 EscapeURI SCALARREF
102 Escapes URI component according to RFC2396
109 $$ref = Encode::encode_utf8( $$ref );
110 $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
111 Encode::_utf8_on( $$ref );
116 # {{{ WebCanonicalizeInfo
118 =head2 WebCanonicalizeInfo();
120 Different web servers set different environmental varibles. This
121 function must return something suitable for REMOTE_USER. By default,
122 just downcase $ENV{'REMOTE_USER'}
126 sub WebCanonicalizeInfo {
129 if ( defined $ENV{'REMOTE_USER'} ) {
130 $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) );
138 # {{{ WebExternalAutoInfo
140 =head2 WebExternalAutoInfo($user);
142 Returns a hash of user attributes, used when WebExternalAuto is set.
146 sub WebExternalAutoInfo {
151 $user_info{'Privileged'} = 1;
153 if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
154 # Populate fields with information from Unix /etc/passwd
156 my ($comments, $realname) = (getpwnam($user))[5, 6];
157 $user_info{'Comments'} = $comments if defined $comments;
158 $user_info{'RealName'} = $realname if defined $realname;
160 elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
161 # Populate fields with information from NT domain controller
164 # and return the wad of stuff
171 package HTML::Mason::Commands;
173 use vars qw/$r $m %session/;
180 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
181 with whatever it's called with. If there is no $session{'CurrentUser'},
182 it creates a temporary user, so we have something to get a localisation handle
189 if ($session{'CurrentUser'} &&
190 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
191 return($session{'CurrentUser'}->loc(@_));
193 elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
194 return ($u->loc(@_));
197 # pathetic case -- SystemUser is gone.
207 =head2 loc_fuzzy STRING
209 loc_fuzzy is for handling localizations of messages that may already
210 contain interpolated variables, typically returned from libraries
211 outside RT's control. It takes the message string and extracts the
212 variable array automatically by matching against the candidate entries
213 inside the lexicon file.
220 if ($session{'CurrentUser'} &&
221 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
222 return($session{'CurrentUser'}->loc_fuzzy($msg));
225 my $u = RT::CurrentUser->new($RT::SystemUser->Id);
226 return ($u->loc_fuzzy($msg));
234 # Error - calls Error and aborts
237 if ($session{'ErrorDocument'} &&
238 $session{'ErrorDocumentType'}) {
239 $r->content_type($session{'ErrorDocumentType'});
240 $m->comp($session{'ErrorDocument'} , Why => shift);
244 $m->comp("/Elements/Error" , Why => shift);
251 # {{{ sub CreateTicket
253 =head2 CreateTicket ARGS
255 Create a new ticket, using Mason's %ARGS. returns @results.
264 my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
266 my $Queue = new RT::Queue( $session{'CurrentUser'} );
267 unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
268 Abort('Queue not found');
271 unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
272 Abort('You have no permission to create tickets in that queue.');
275 my $due = new RT::Date( $session{'CurrentUser'} );
276 $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
277 my $starts = new RT::Date( $session{'CurrentUser'} );
278 $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
280 my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} );
281 my @Cc = split ( /\s*,\s*/, $ARGS{'Cc'} );
282 my @AdminCc = split ( /\s*,\s*/, $ARGS{'AdminCc'} );
284 my $MIMEObj = MakeMIMEEntity(
285 Subject => $ARGS{'Subject'},
286 From => $ARGS{'From'},
288 Body => $ARGS{'Content'},
291 if ($ARGS{'Attachments'}) {
292 $MIMEObj->make_multipart;
293 $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}};
297 Type => $ARGS{'Type'} || 'ticket',
298 Queue => $ARGS{'Queue'},
299 Owner => $ARGS{'Owner'},
300 InitialPriority => $ARGS{'InitialPriority'},
301 FinalPriority => $ARGS{'FinalPriority'},
302 TimeLeft => $ARGS{'TimeLeft'},
303 TimeEstimated => $ARGS{'TimeEstimated'},
304 TimeWorked => $ARGS{'TimeWorked'},
305 Requestor => \@Requestors,
307 AdminCc => \@AdminCc,
308 Subject => $ARGS{'Subject'},
309 Status => $ARGS{'Status'},
311 Starts => $starts->ISO,
314 foreach my $arg (keys %ARGS) {
317 next if ($arg =~ /-Magic$/);
318 #Object-RT::Ticket--CustomField-3-Values
319 if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
320 $create_args{$arg} = $ARGS{$arg};
322 elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
324 my $cf = RT::CustomField->new( $session{'CurrentUser'});
327 if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
328 $ARGS{$arg} =~ s/\r\n/\n/g;
329 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
332 if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
333 $ARGS{$arg} =~ s/\r//g;
336 if ( $arg =~ /-Upload$/ ) {
337 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
340 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
346 # XXX TODO This code should be about six lines. and badly needs refactoring.
348 # {{{ turn new link lists into arrays, and pass in the proper arguments
349 my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
351 foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
352 $luri =~ s/\s*$//; # Strip trailing whitespace
353 push @dependson, $luri;
355 $create_args{'DependsOn'} = \@dependson;
357 foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
358 push @dependedonby, $luri;
360 $create_args{'DependedOnBy'} = \@dependedonby;
362 foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
363 $luri =~ s/\s*$//; # Strip trailing whitespace
364 push @parents, $luri;
366 $create_args{'Parents'} = \@parents;
368 foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
369 push @children, $luri;
371 $create_args{'Children'} = \@children;
373 foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
374 $luri =~ s/\s*$//; # Strip trailing whitespace
375 push @refersto, $luri;
377 $create_args{'RefersTo'} = \@refersto;
379 foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
380 push @referredtoby, $luri;
382 $create_args{'ReferredToBy'} = \@referredtoby;
386 my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
387 unless ( $id && $Trans ) {
391 push ( @Actions, split("\n", $ErrMsg) );
392 unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
393 Abort( "No permission to view newly created ticket #"
394 . $Ticket->id . "." );
396 return ( $Ticket, @Actions );
402 # {{{ sub LoadTicket - loads a ticket
406 Takes a ticket id as its only variable. if it's handed an array, it takes
409 Returns an RT::Ticket object as the current user.
416 if ( ref($id) eq "ARRAY" ) {
421 Abort("No ticket specified");
424 my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
426 unless ( $Ticket->id ) {
427 Abort("Could not load ticket $id");
434 # {{{ sub ProcessUpdateMessage
436 sub ProcessUpdateMessage {
438 #TODO document what else this takes.
446 #Make the update content have no 'weird' newlines in it
447 if ( $args{ARGSRef}->{'UpdateTimeWorked'}
448 || $args{ARGSRef}->{'UpdateContent'}
449 || $args{ARGSRef}->{'UpdateAttachments'} )
453 $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
455 $args{ARGSRef}->{'UpdateSubject'} = undef;
458 my $Message = MakeMIMEEntity(
459 Subject => $args{ARGSRef}->{'UpdateSubject'},
460 Body => $args{ARGSRef}->{'UpdateContent'},
463 $Message->head->add( 'Message-ID' =>
468 . int(rand(2000)) . "."
469 . $args{'TicketObj'}->id . "-"
471 . "0" . "@" # Email sent
474 my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
475 if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
476 $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
479 $old_txn = $args{TicketObj}->Transactions->First();
482 if ( $old_txn->Message && $old_txn->Message->First ) {
483 my @in_reply_to = split(/\s+/m, $old_txn->Message->First->GetHeader('In-Reply-To') || '');
484 my @references = split(/\s+/m, $old_txn->Message->First->GetHeader('References') || '' );
485 my @msgid = split(/\s+/m,$old_txn->Message->First->GetHeader('Message-ID') || '');
486 my @rtmsgid = split(/\s+/m,$old_txn->Message->First->GetHeader('RT-Message-ID') || '');
488 $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
489 $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
492 if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
493 $Message->make_multipart;
494 $Message->add_part($_)
495 foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
498 ## TODO: Implement public comments
499 if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
500 my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(
501 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
502 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
504 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
506 push( @{ $args{Actions} }, $Description );
507 $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
509 elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
510 my ( $Transaction, $Description, $Object ) =
511 $args{TicketObj}->Correspond(
512 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
513 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
515 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
517 push( @{ $args{Actions} }, $Description );
518 $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
522 @{ $args{'Actions'} },
523 loc("Update type was neither correspondence nor comment.") . " "
524 . loc("Update not recorded.")
532 # {{{ sub MakeMIMEEntity
534 =head2 MakeMIMEEntity PARAMHASH
536 Takes a paramhash Subject, Body and AttachmentFieldName.
538 Returns a MIME::Entity.
544 #TODO document what else this takes.
550 AttachmentFieldName => undef,
551 # map Encode::encode_utf8($_), @_,
555 #Make the update content have no 'weird' newlines in it
557 $args{'Body'} =~ s/\r\n/\n/gs;
560 # MIME::Head is not happy in utf-8 domain. This only happens
561 # when processing an incoming email (so far observed).
564 $Message = MIME::Entity->build(
565 Subject => $args{'Subject'} || "",
566 From => $args{'From'},
569 Data => [ $args{'Body'} ]
573 my $cgi_object = $m->cgi_object;
575 if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
579 use File::Temp qw(tempfile tempdir);
581 #foreach my $filehandle (@filenames) {
583 my ( $fh, $temp_file );
585 # on NFS and NTFS, it is possible that tempfile() conflicts
586 # with other processes, causing a race condition. we try to
587 # accommodate this by pausing and retrying.
588 last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) };
592 binmode $fh; #thank you, windows
594 while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
598 my $uploadinfo = $cgi_object->uploadInfo($filehandle);
600 # Prefer the cached name first over CGI.pm stringification.
601 my $filename = $RT::Mason::CGI::Filename;
602 $filename = "$filehandle" unless defined($filename);
604 $filename =~ s#^.*[\\/]##;
608 Filename => Encode::decode_utf8($filename),
609 Type => $uploadinfo->{'Content-Type'},
617 $Message->make_singlepart();
618 RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
626 # {{{ sub ProcessSearchQuery
628 =head2 ProcessSearchQuery
630 Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
632 TODO Doc exactly what comes in the paramhash
637 sub ProcessSearchQuery {
640 ## TODO: The only parameter here is %ARGS. Maybe it would be
641 ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
642 ## instead of $args{ARGS}->{...} ? :)
644 #Searches are sticky.
645 if ( defined $session{'tickets'} ) {
647 # Reset the old search
648 $session{'tickets'}->GotoFirstItem;
653 $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
656 #Import a bookmarked search if we have one
657 if ( defined $args{ARGS}->{'Bookmark'} ) {
658 $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
661 # {{{ Goto next/prev page
662 if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
663 $session{'tickets'}->NextPage;
665 elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
666 $session{'tickets'}->PrevPage;
668 elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
669 $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
674 # {{{ Deal with limiting the search
676 if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
677 $session{'tickets_refresh_interval'} =
678 $args{ARGS}->{'RefreshSearchInterval'};
681 if ( $args{ARGS}->{'TicketsSortBy'} ) {
682 $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
683 $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
684 $session{'tickets'}->OrderBy(
685 FIELD => $args{ARGS}->{'TicketsSortBy'},
686 ORDER => $args{ARGS}->{'TicketsSortOrder'}
692 # {{{ Set the query limit
693 if ( defined $args{ARGS}->{'RowsPerPage'} ) {
695 "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
697 $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
698 $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
703 if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
704 $session{'tickets'}->LimitPriority(
705 VALUE => $args{ARGS}->{'ValueOfPriority'},
706 OPERATOR => $args{ARGS}->{'PriorityOp'}
712 if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
713 $session{'tickets'}->LimitOwner(
714 VALUE => $args{ARGS}->{'ValueOfOwner'},
715 OPERATOR => $args{ARGS}->{'OwnerOp'}
720 # {{{ Limit requestor email
721 if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
722 $session{'tickets'}->LimitWatcher(
723 TYPE => $args{ARGS}->{'WatcherRole'},
724 VALUE => $args{ARGS}->{'ValueOfWatcherRole'},
725 OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
732 if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
733 $session{'tickets'}->LimitQueue(
734 VALUE => $args{ARGS}->{'ValueOfQueue'},
735 OPERATOR => $args{ARGS}->{'QueueOp'}
741 if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
742 if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
743 foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
744 $session{'tickets'}->LimitStatus(
746 OPERATOR => $args{ARGS}->{'StatusOp'},
751 $session{'tickets'}->LimitStatus(
752 VALUE => $args{ARGS}->{'ValueOfStatus'},
753 OPERATOR => $args{ARGS}->{'StatusOp'},
761 if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
762 my $val = $args{ARGS}->{'ValueOfSubject'};
763 if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
766 $session{'tickets'}->LimitSubject(
768 OPERATOR => $args{ARGS}->{'SubjectOp'},
774 if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
775 my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
776 $args{ARGS}->{'DateType'} =~ s/_Date$//;
778 if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
779 $session{'tickets'}->LimitTransactionDate(
781 OPERATOR => $args{ARGS}->{'DateOp'},
785 $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
787 OPERATOR => $args{ARGS}->{'DateOp'},
794 if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
795 my $val = $args{ARGS}->{'ValueOfAttachmentField'};
796 if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
799 $session{'tickets'}->Limit(
800 FIELD => $args{ARGS}->{'AttachmentField'},
802 OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
808 # {{{ Limit CustomFields
810 foreach my $arg ( keys %{ $args{ARGS} } ) {
812 if ( $arg =~ /^CustomField(\d+)$/ ) {
818 next unless ( $args{ARGS}->{$arg} );
820 my $form = $args{ARGS}->{$arg};
821 my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
822 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
824 if ($oper =~ /like/i) {
825 $value = "%".$value."%";
827 if ( $value =~ /^null$/i ) {
829 #Don't quote the string 'null'
832 # Convert the operator to something apropriate for nulls
833 $oper = 'IS' if ( $oper eq '=' );
834 $oper = 'IS NOT' if ( $oper eq '!=' );
836 $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
838 QUOTEVALUE => $quote,
850 # {{{ sub ParseDateToISO
852 =head2 ParseDateToISO
854 Takes a date in an arbitrary format.
855 Returns an ISO date and time in GMT
862 my $date_obj = RT::Date->new($session{'CurrentUser'});
867 return ( $date_obj->ISO );
872 # {{{ sub ProcessACLChanges
874 sub ProcessACLChanges {
877 my %ARGS = %$ARGSref;
879 my ( $ACL, @results );
882 foreach my $arg (keys %ARGS) {
883 if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
884 my $principal_id = $1;
885 my $object_type = $2;
887 my $rights = $ARGS{$arg};
889 my $principal = RT::Principal->new($session{'CurrentUser'});
890 $principal->Load($principal_id);
894 if ($object_type eq 'RT::System') {
896 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
897 $obj = $object_type->new($session{'CurrentUser'});
898 $obj->Load($object_id);
900 push (@results, loc("System Error"). ': '.
901 loc("Rights could not be granted for [_1]", $object_type));
905 my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
906 foreach my $right (@rights) {
907 next unless ($right);
908 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
909 push (@results, $msg);
912 elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
913 my $principal_id = $1;
914 my $object_type = $2;
918 my $principal = RT::Principal->new($session{'CurrentUser'});
919 $principal->Load($principal_id);
920 next unless ($right);
923 if ($object_type eq 'RT::System') {
925 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
926 $obj = $object_type->new($session{'CurrentUser'});
927 $obj->Load($object_id);
929 push (@results, loc("System Error"). ': '.
930 loc("Rights could not be revoked for [_1]", $object_type));
933 my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
934 push (@results, $msg);
946 # {{{ sub UpdateRecordObj
948 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
950 @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.
952 Returns an array of success/failure messages
956 sub UpdateRecordObject {
959 AttributesRef => undef,
961 AttributePrefix => undef,
965 my $Object = $args{'Object'};
966 my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
967 ARGSRef => $args{'ARGSRef'},
968 AttributePrefix => $args{'AttributePrefix'}
976 # {{{ Sub ProcessCustomFieldUpdates
978 sub ProcessCustomFieldUpdates {
980 CustomFieldObj => undef,
985 my $Object = $args{'CustomFieldObj'};
986 my $ARGSRef = $args{'ARGSRef'};
988 my @attribs = qw( Name Type Description Queue SortOrder);
989 my @results = UpdateRecordObject(
990 AttributesRef => \@attribs,
995 if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
997 my ( $addval, $addmsg ) = $Object->AddValue(
999 $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1000 Description => $ARGSRef->{ "CustomField-"
1002 . "-AddValue-Description" },
1003 SortOrder => $ARGSRef->{ "CustomField-"
1005 . "-AddValue-SortOrder" },
1007 push ( @results, $addmsg );
1009 my @delete_values = (
1010 ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1012 ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
1013 : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
1014 foreach my $id (@delete_values) {
1015 next unless defined $id;
1016 my ( $err, $msg ) = $Object->DeleteValue($id);
1017 push ( @results, $msg );
1020 my $vals = $Object->Values();
1021 while (my $cfv = $vals->Next()) {
1022 if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
1023 if ($cfv->SortOrder != $so) {
1024 my ( $err, $msg ) = $cfv->SetSortOrder($so);
1025 push ( @results, $msg );
1035 # {{{ sub ProcessTicketBasics
1037 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1039 Returns an array of results messages.
1043 sub ProcessTicketBasics {
1051 my $TicketObj = $args{'TicketObj'};
1052 my $ARGSRef = $args{'ARGSRef'};
1054 # {{{ Set basic fields
1067 if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
1068 my $tempqueue = RT::Queue->new($RT::SystemUser);
1069 $tempqueue->Load( $ARGSRef->{'Queue'} );
1070 if ( $tempqueue->id ) {
1071 $ARGSRef->{'Queue'} = $tempqueue->Id();
1076 # Status isn't a field that can be set to a null value.
1077 # RT core complains if you try
1078 delete $ARGSRef->{'Status'} unless ($ARGSRef->{'Status'});
1080 my @results = UpdateRecordObject(
1081 AttributesRef => \@attribs,
1082 Object => $TicketObj,
1086 # We special case owner changing, so we can use ForceOwnerChange
1087 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1089 if ( $ARGSRef->{'ForceOwnerChange'} ) {
1090 $ChownType = "Force";
1093 $ChownType = "Give";
1097 $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1098 push ( @results, $msg );
1108 sub ProcessTicketCustomFieldUpdates {
1110 $args{'Object'} = delete $args{'TicketObj'};
1111 my $ARGSRef = { %{ $args{'ARGSRef'} } };
1113 # Build up a list of objects that we want to work with
1114 my %custom_fields_to_mod;
1115 foreach my $arg ( keys %$ARGSRef ) {
1116 if ( $arg =~ /^Ticket-(\d+-.*)/) {
1117 $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
1119 elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1120 $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1124 return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1127 sub ProcessObjectCustomFieldUpdates {
1129 my $ARGSRef = $args{'ARGSRef'};
1132 # Build up a list of objects that we want to work with
1133 my %custom_fields_to_mod;
1134 foreach my $arg ( keys %$ARGSRef ) {
1135 if ( $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-/ ) {
1136 # For each of those objects, find out what custom fields we want to work with.
1137 $custom_fields_to_mod{$1}{$2 || $args{'Object'}->Id}{$3} = 1;
1141 # For each of those objects
1142 foreach my $class ( keys %custom_fields_to_mod ) {
1143 foreach my $id ( keys %{$custom_fields_to_mod{$class}} ) {
1144 my $Object = $args{'Object'};
1145 if (!$Object or ref($Object) ne $class or $Object->id != $id) {
1146 $Object = $class->new( $session{'CurrentUser'} );
1150 # For each custom field
1151 foreach my $cf ( keys %{ $custom_fields_to_mod{$class}{$id} } ) {
1152 my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
1153 $CustomFieldObj->LoadById($cf);
1155 foreach my $arg ( keys %{$ARGSRef} ) {
1156 # Only interested in args for the current CF:
1157 next unless ( $arg =~ /^Object-$class-(?:$id)?-CustomField-$cf-/ );
1159 # since http won't pass in a form element with a null value, we need
1161 if ($arg =~ /^(.*?)-Values-Magic$/ ) {
1162 # We don't care about the magic, if there's really a values element;
1163 next if ($ARGSRef->{$1.'-Value'} || $ARGSRef->{$1.'-Values'}) ;
1165 # "Empty" values does not mean anything for Image and Binary fields
1166 next if $CustomFieldObj->Type =~ /^(?:Image|Binary)$/;
1168 $arg = $1."-Values";
1169 $ARGSRef->{$1."-Values"} = undef;
1173 if (ref( $ARGSRef->{$arg} ) eq 'ARRAY' ) {
1174 @values = @{ $ARGSRef->{$arg} };
1175 } elsif ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
1176 @values = ($ARGSRef->{$arg});
1178 @values = split /\n/, $ARGSRef->{$arg};
1181 if ( ($CustomFieldObj->Type eq 'Freeform'
1182 && ! $CustomFieldObj->SingleValue) ||
1183 $CustomFieldObj->Type =~ /text/i) {
1184 foreach my $val (@values) {
1189 if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
1190 foreach my $value (@values) {
1191 next unless length($value);
1192 my ( $val, $msg ) = $Object->AddCustomFieldValue(
1196 push ( @results, $msg );
1199 elsif ( $arg =~ /-Upload$/ ) {
1200 my $value_hash = _UploadedFile($arg) or next;
1202 my ( $val, $msg ) = $Object->AddCustomFieldValue(
1206 push ( @results, $msg );
1208 elsif ( $arg =~ /-DeleteValues$/ ) {
1209 foreach my $value (@values) {
1210 next unless length($value);
1211 my ( $val, $msg ) = $Object->DeleteCustomFieldValue(
1215 push ( @results, $msg );
1218 elsif ( $arg =~ /-DeleteValueIds$/ ) {
1219 foreach my $value (@values) {
1220 next unless length($value);
1221 my ( $val, $msg ) = $Object->DeleteCustomFieldValue(
1225 push ( @results, $msg );
1228 elsif ( $arg =~ /-Values$/ and !$CustomFieldObj->Repeated) {
1229 my $cf_values = $Object->CustomFieldValues($cf);
1232 foreach my $value (@values) {
1233 next unless length($value);
1235 # build up a hash of values that the new set has
1236 $values_hash{$value} = 1;
1238 unless ( $cf_values->HasEntry($value) ) {
1239 my ( $val, $msg ) = $Object->AddCustomFieldValue(
1243 push ( @results, $msg );
1247 while ( my $cf_value = $cf_values->Next ) {
1248 unless ( $values_hash{ $cf_value->Content } == 1 ) {
1249 my ( $val, $msg ) = $Object->DeleteCustomFieldValue(
1251 Value => $cf_value->Content
1253 push ( @results, $msg);
1258 elsif ( $arg =~ /-Values$/ ) {
1259 my $cf_values = $Object->CustomFieldValues($cf);
1261 # keep everything up to the point of difference, delete the rest
1263 foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1264 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1273 # now add/replace extra things, if any
1274 foreach my $value (@values) {
1275 my ( $val, $msg ) = $Object->AddCustomFieldValue(
1279 push ( @results, $msg );
1283 push ( @results, loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]", $cf->Name, $class, $Object->id ) );
1292 # {{{ sub ProcessTicketWatchers
1294 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1296 Returns an array of results messages.
1300 sub ProcessTicketWatchers {
1308 my $Ticket = $args{'TicketObj'};
1309 my $ARGSRef = $args{'ARGSRef'};
1311 # {{{ Munge watchers
1313 foreach my $key ( keys %$ARGSRef ) {
1315 # {{{ Delete deletable watchers
1316 if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) ) {
1317 my ( $code, $msg ) =
1318 $Ticket->DeleteWatcher(PrincipalId => $2,
1320 push @results, $msg;
1323 # Delete watchers in the simple style demanded by the bulk manipulator
1324 elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1325 my ( $code, $msg ) = $Ticket->DeleteWatcher( Email => $ARGSRef->{$key}, Type => $1 );
1326 push @results, $msg;
1331 # Add new wathchers by email address
1332 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1333 and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1336 #They're in this order because otherwise $1 gets clobbered :/
1337 my ( $code, $msg ) = $Ticket->AddWatcher(
1338 Type => $ARGSRef->{$key},
1339 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1341 push @results, $msg;
1344 #Add requestors in the simple style demanded by the bulk manipulator
1345 elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1346 my ( $code, $msg ) = $Ticket->AddWatcher(
1348 Email => $ARGSRef->{$key}
1350 push @results, $msg;
1353 # Add new watchers by owner
1354 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1355 and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
1357 #They're in this order because otherwise $1 gets clobbered :/
1358 my ( $code, $msg ) =
1359 $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1360 push @results, $msg;
1371 # {{{ sub ProcessTicketDates
1373 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1375 Returns an array of results messages.
1379 sub ProcessTicketDates {
1386 my $Ticket = $args{'TicketObj'};
1387 my $ARGSRef = $args{'ARGSRef'};
1391 # {{{ Set date fields
1392 my @date_fields = qw(
1400 #Run through each field in this list. update the value if apropriate
1401 foreach my $field (@date_fields) {
1404 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1406 #If it's something other than just whitespace
1407 if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1409 Format => 'unknown',
1410 Value => $ARGSRef->{ $field . '_Date' }
1412 my $obj = $field . "Obj";
1413 if ( ( defined $DateObj->Unix )
1414 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1416 my $method = "Set$field";
1417 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1418 push @results, "$msg";
1429 # {{{ sub ProcessTicketLinks
1431 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1433 Returns an array of results messages.
1437 sub ProcessTicketLinks {
1438 my %args = ( TicketObj => undef,
1442 my $Ticket = $args{'TicketObj'};
1443 my $ARGSRef = $args{'ARGSRef'};
1446 my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1447 ARGSRef => $ARGSRef);
1449 #Merge if we need to
1450 if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1452 $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1453 push @results, $msg;
1461 sub ProcessRecordLinks {
1462 my %args = ( RecordObj => undef,
1466 my $Record = $args{'RecordObj'};
1467 my $ARGSRef = $args{'ARGSRef'};
1471 # Delete links that are gone gone gone.
1472 foreach my $arg ( keys %$ARGSRef ) {
1473 if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1479 "Trying to delete: Base: $base Target: $target Type $type";
1480 my ( $val, $msg ) = $Record->DeleteLink( Base => $base,
1482 Target => $target );
1484 push @results, $msg;
1490 my @linktypes = qw( DependsOn MemberOf RefersTo );
1492 foreach my $linktype (@linktypes) {
1493 if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
1494 for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
1495 $luri =~ s/\s*$//; # Strip trailing whitespace
1496 my ( $val, $msg ) = $Record->AddLink( Target => $luri,
1497 Type => $linktype );
1498 push @results, $msg;
1501 if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1503 for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1504 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1505 Type => $linktype );
1507 push @results, $msg;
1516 =head2 _UploadedFile ( $arg );
1518 Takes a CGI parameter name; if a file is uploaded under that name,
1519 return a hash reference suitable for AddCustomFieldValue's use:
1520 C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
1522 Returns C<undef> if no files were uploaded in the C<$arg> field.
1528 my $cgi_object = $m->cgi_object;
1529 my $fh = $cgi_object->upload($arg) or return undef;
1530 my $upload_info = $cgi_object->uploadInfo($fh);
1532 my $filename = "$fh";
1533 $filename =~ s#^.*[\\/]##;
1538 LargeContent => do { local $/; scalar <$fh> },
1539 ContentType => $upload_info->{'Content-Type'},
1543 eval "require RT::Interface::Web_Vendor";
1544 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1545 eval "require RT::Interface::Web_Local";
1546 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});