1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2009 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., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
48 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
50 ## This is a library of static subs to be used by the Mason web
60 use_ok(RT::Interface::Web);
70 package RT::Interface::Web;
72 use RT::SavedSearches;
77 =head2 EscapeUTF8 SCALARREF
79 does a css-busting but minimalist escaping of whatever html you're passing in.
85 return unless defined $$ref;
96 Encode::_utf8_on($$ref);
105 =head2 EscapeURI SCALARREF
107 Escapes URI component according to RFC2396
114 $$ref = Encode::encode_utf8( $$ref );
115 $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
116 Encode::_utf8_on( $$ref );
121 # {{{ WebCanonicalizeInfo
123 =head2 WebCanonicalizeInfo();
125 Different web servers set different environmental varibles. This
126 function must return something suitable for REMOTE_USER. By default,
127 just downcase $ENV{'REMOTE_USER'}
131 sub WebCanonicalizeInfo {
134 if ( defined $ENV{'REMOTE_USER'} ) {
135 $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) );
143 # {{{ WebExternalAutoInfo
145 =head2 WebExternalAutoInfo($user);
147 Returns a hash of user attributes, used when WebExternalAuto is set.
151 sub WebExternalAutoInfo {
156 # default to making Privileged users, even if they specify
157 # some other default Attributes
158 if (!$RT::AutoCreate ||
159 ( ref($RT::AutoCreate) && not exists $RT::AutoCreate->{Privileged})) {
160 $user_info{'Privileged'} = 1;
163 if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
164 # Populate fields with information from Unix /etc/passwd
166 my ($comments, $realname) = (getpwnam($user))[5, 6];
167 $user_info{'Comments'} = $comments if defined $comments;
168 $user_info{'RealName'} = $realname if defined $realname;
170 elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
171 # Populate fields with information from NT domain controller
174 # and return the wad of stuff
184 This routine ells the current user's browser to redirect to URL.
185 Additionally, it unties the user's currently active session, helping to avoid
186 A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use
187 a cached DBI statement handle twice at the same time.
193 my $redir_to = shift;
194 untie $HTML::Mason::Commands::session;
195 my $uri = URI->new($redir_to);
196 my $server_uri = URI->new($RT::WebURL);
198 # If the user is coming in via a non-canonical
199 # hostname, don't redirect them to the canonical host,
200 # it will just upset them (and invalidate their credentials)
201 if ($uri->host eq $server_uri->host &&
202 $uri->port eq $server_uri->port) {
203 $uri->host($ENV{'HTTP_HOST'});
204 $uri->port($ENV{'SERVER_PORT'});
207 $HTML::Mason::Commands::m->redirect($uri->canonical);
208 $HTML::Mason::Commands::m->abort;
212 =head2 StaticFileHeaders
214 Send the browser a few headers to try to get it to (somewhat agressively)
215 cache RT's static Javascript and CSS files.
217 This routine could really use _accurate_ heuristics. (XXX TODO)
221 sub StaticFileHeaders {
223 $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
225 # Expire things in a month.
226 $HTML::Mason::Commands::r->headers_out->{'Expires'} = HTTP::Date::time2str( time() + 2592000 );
228 # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since'
229 # request, but we don't handle it and generate full reply again
230 # Last modified at server start time
231 #$HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = HTTP::Date::time2str($^T);
236 package HTML::Mason::Commands;
237 use vars qw/$r $m %session/;
244 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
245 with whatever it's called with. If there is no $session{'CurrentUser'},
246 it creates a temporary user, so we have something to get a localisation handle
253 if ($session{'CurrentUser'} &&
254 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
255 return($session{'CurrentUser'}->loc(@_));
257 elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
258 return ($u->loc(@_));
261 # pathetic case -- SystemUser is gone.
271 =head2 loc_fuzzy STRING
273 loc_fuzzy is for handling localizations of messages that may already
274 contain interpolated variables, typically returned from libraries
275 outside RT's control. It takes the message string and extracts the
276 variable array automatically by matching against the candidate entries
277 inside the lexicon file.
284 if ($session{'CurrentUser'} &&
285 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
286 return($session{'CurrentUser'}->loc_fuzzy($msg));
289 my $u = RT::CurrentUser->new($RT::SystemUser->Id);
290 return ($u->loc_fuzzy($msg));
298 # Error - calls Error and aborts
301 if ($session{'ErrorDocument'} &&
302 $session{'ErrorDocumentType'}) {
303 $r->content_type($session{'ErrorDocumentType'});
304 $m->comp($session{'ErrorDocument'} , Why => shift);
308 $m->comp("/Elements/Error" , Why => shift);
315 # {{{ sub CreateTicket
317 =head2 CreateTicket ARGS
319 Create a new ticket, using Mason's %ARGS. returns @results.
328 my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
330 my $Queue = new RT::Queue( $session{'CurrentUser'} );
331 unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
332 Abort('Queue not found');
335 unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
336 Abort('You have no permission to create tickets in that queue.');
339 my $due = new RT::Date( $session{'CurrentUser'} );
340 $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
341 my $starts = new RT::Date( $session{'CurrentUser'} );
342 $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
344 my $MIMEObj = MakeMIMEEntity(
345 Subject => $ARGS{'Subject'},
346 From => $ARGS{'From'},
348 Body => $ARGS{'Content'},
349 Type => $ARGS{'ContentType'},
352 if ( $ARGS{'Attachments'} ) {
353 my $rv = $MIMEObj->make_multipart;
354 $RT::Logger->error("Couldn't make multipart message")
355 if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
357 foreach ( values %{$ARGS{'Attachments'}} ) {
359 $RT::Logger->error("Couldn't add empty attachemnt");
362 $MIMEObj->add_part($_);
367 Type => $ARGS{'Type'} || 'ticket',
368 Queue => $ARGS{'Queue'},
369 Owner => $ARGS{'Owner'},
370 InitialPriority => $ARGS{'InitialPriority'},
371 FinalPriority => $ARGS{'FinalPriority'},
372 TimeLeft => $ARGS{'TimeLeft'},
373 TimeEstimated => $ARGS{'TimeEstimated'},
374 TimeWorked => $ARGS{'TimeWorked'},
375 Subject => $ARGS{'Subject'},
376 Status => $ARGS{'Status'},
378 Starts => $starts->ISO,
383 foreach my $type (qw(Requestors Cc AdminCc)) {
384 my @tmp = map { $_->format } grep { $_->address} Mail::Address->parse( $ARGS{ $type } );
386 $create_args{ $type } = [
388 my $user = RT::User->new( $RT::SystemUser );
389 $user->LoadOrCreateByEmail( $_ );
390 # convert to ids to avoid work later
395 "$type got ".join(',',@{$create_args{ $type }}) );
398 # XXX: workaround for name conflict :(
399 $create_args{'Requestor'} = delete $create_args{'Requestors'};
401 foreach my $arg (keys %ARGS) {
402 next if $arg =~ /-(?:Magic|Category)$/;
404 if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
405 $create_args{$arg} = $ARGS{$arg};
407 # Object-RT::Ticket--CustomField-3-Values
408 elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
410 my $cf = RT::CustomField->new( $session{'CurrentUser'});
413 if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
414 $ARGS{$arg} =~ s/\r\n/\n/g;
415 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
418 if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
419 $ARGS{$arg} =~ s/\r//g;
422 if ( $arg =~ /-Upload$/ ) {
423 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
426 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
432 # XXX TODO This code should be about six lines. and badly needs refactoring.
434 # {{{ turn new link lists into arrays, and pass in the proper arguments
435 my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
437 foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
438 $luri =~ s/\s*$//; # Strip trailing whitespace
439 push @dependson, $luri;
441 $create_args{'DependsOn'} = \@dependson;
443 foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
444 push @dependedonby, $luri;
446 $create_args{'DependedOnBy'} = \@dependedonby;
448 foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
449 $luri =~ s/\s*$//; # Strip trailing whitespace
450 push @parents, $luri;
452 $create_args{'Parents'} = \@parents;
454 foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
455 push @children, $luri;
457 $create_args{'Children'} = \@children;
459 foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
460 $luri =~ s/\s*$//; # Strip trailing whitespace
461 push @refersto, $luri;
463 $create_args{'RefersTo'} = \@refersto;
465 foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
466 push @referredtoby, $luri;
468 $create_args{'ReferredToBy'} = \@referredtoby;
472 my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
477 push ( @Actions, split("\n", $ErrMsg) );
478 unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
479 Abort( "No permission to view newly created ticket #"
480 . $Ticket->id . "." );
482 return ( $Ticket, @Actions );
488 # {{{ sub LoadTicket - loads a ticket
492 Takes a ticket id as its only variable. if it's handed an array, it takes
495 Returns an RT::Ticket object as the current user.
502 if ( ref($id) eq "ARRAY" ) {
507 Abort("No ticket specified");
510 my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
512 unless ( $Ticket->id ) {
513 Abort("Could not load ticket $id");
520 # {{{ sub ProcessUpdateMessage
522 sub ProcessUpdateMessage {
524 #TODO document what else this takes.
532 #Make the update content have no 'weird' newlines in it
533 if ( $args{ARGSRef}->{'UpdateTimeWorked'}
534 || $args{ARGSRef}->{'UpdateContent'}
535 || $args{ARGSRef}->{'UpdateAttachments'} )
539 $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
541 $args{ARGSRef}->{'UpdateSubject'} = undef;
544 my $Message = MakeMIMEEntity(
545 Subject => $args{ARGSRef}->{'UpdateSubject'},
546 Body => $args{ARGSRef}->{'UpdateContent'},
547 Type => $args{ARGSRef}->{'UpdateContentType'},
550 $Message->head->add( 'Message-ID' =>
555 . int(rand(2000)) . "."
556 . $args{'TicketObj'}->id . "-"
558 . "0" . "@" # Email sent
561 my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
562 if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
563 $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
566 $old_txn = $args{TicketObj}->Transactions->First();
569 if ( $old_txn->Message && $old_txn->Message->First ) {
570 my @in_reply_to = split(/\s+/m, $old_txn->Message->First->GetHeader('In-Reply-To') || '');
571 my @references = split(/\s+/m, $old_txn->Message->First->GetHeader('References') || '' );
572 my @msgid = split(/\s+/m,$old_txn->Message->First->GetHeader('Message-ID') || '');
573 my @rtmsgid = split(/\s+/m,$old_txn->Message->First->GetHeader('RT-Message-ID') || '');
575 $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
576 $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
579 if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
580 $Message->make_multipart;
581 $Message->add_part($_)
582 foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
585 ## TODO: Implement public comments
586 if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
587 my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(
588 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
589 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
591 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
593 push( @{ $args{Actions} }, $Description );
594 $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
596 elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
597 my ( $Transaction, $Description, $Object ) =
598 $args{TicketObj}->Correspond(
599 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
600 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
602 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
604 push( @{ $args{Actions} }, $Description );
605 $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
609 @{ $args{'Actions'} },
610 loc("Update type was neither correspondence nor comment.") . " "
611 . loc("Update not recorded.")
619 # {{{ sub MakeMIMEEntity
621 =head2 MakeMIMEEntity PARAMHASH
623 Takes a paramhash Subject, Body and AttachmentFieldName.
625 Also takes Form, Cc and Type as optional paramhash keys.
627 Returns a MIME::Entity.
633 #TODO document what else this takes.
639 AttachmentFieldName => undef,
641 # map Encode::encode_utf8($_), @_,
645 #Make the update content have no 'weird' newlines in it
647 $args{'Body'} =~ s/\r\n/\n/gs if $args{'Body'};
650 # MIME::Head is not happy in utf-8 domain. This only happens
651 # when processing an incoming email (so far observed).
654 $Message = MIME::Entity->build(
655 Subject => $args{'Subject'} || "",
656 From => $args{'From'},
658 Type => $args{'Type'} || 'text/plain',
659 'Charset:' => 'utf8',
660 Data => [ $args{'Body'} ]
664 my $cgi_object = $m->cgi_object;
666 if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
670 use File::Temp qw(tempfile tempdir);
672 #foreach my $filehandle (@filenames) {
674 my ( $fh, $temp_file );
676 # on NFS and NTFS, it is possible that tempfile() conflicts
677 # with other processes, causing a race condition. we try to
678 # accommodate this by pausing and retrying.
679 last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) };
683 binmode $fh; #thank you, windows
685 while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
689 my $uploadinfo = $cgi_object->uploadInfo($filehandle);
691 # Prefer the cached name first over CGI.pm stringification.
692 my $filename = $RT::Mason::CGI::Filename;
693 $filename = "$filehandle" unless defined($filename);
695 $filename =~ s#^.*[\\/]##;
699 Filename => Encode::decode_utf8($filename),
700 Type => $uploadinfo->{'Content-Type'},
708 $Message->make_singlepart();
709 RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
717 # {{{ sub ProcessSearchQuery
719 =head2 ProcessSearchQuery
721 Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
723 TODO Doc exactly what comes in the paramhash
728 sub ProcessSearchQuery {
731 ## TODO: The only parameter here is %ARGS. Maybe it would be
732 ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
733 ## instead of $args{ARGS}->{...} ? :)
735 #Searches are sticky.
736 if ( defined $session{'tickets'} ) {
738 # Reset the old search
739 $session{'tickets'}->GotoFirstItem;
744 $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
747 #Import a bookmarked search if we have one
748 if ( defined $args{ARGS}->{'Bookmark'} ) {
749 $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
752 # {{{ Goto next/prev page
753 if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
754 $session{'tickets'}->NextPage;
756 elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
757 $session{'tickets'}->PrevPage;
759 elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
760 $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
765 # {{{ Deal with limiting the search
767 if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
768 $session{'tickets_refresh_interval'} =
769 $args{ARGS}->{'RefreshSearchInterval'};
772 if ( $args{ARGS}->{'TicketsSortBy'} ) {
773 $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
774 $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
775 $session{'tickets'}->OrderBy(
776 FIELD => $args{ARGS}->{'TicketsSortBy'},
777 ORDER => $args{ARGS}->{'TicketsSortOrder'}
783 # {{{ Set the query limit
784 if ( defined $args{ARGS}->{'RowsPerPage'} ) {
786 "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
788 $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
789 $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
794 if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
795 $session{'tickets'}->LimitPriority(
796 VALUE => $args{ARGS}->{'ValueOfPriority'},
797 OPERATOR => $args{ARGS}->{'PriorityOp'}
803 if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
804 $session{'tickets'}->LimitOwner(
805 VALUE => $args{ARGS}->{'ValueOfOwner'},
806 OPERATOR => $args{ARGS}->{'OwnerOp'}
811 # {{{ Limit requestor email
812 if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
813 $session{'tickets'}->LimitWatcher(
814 TYPE => $args{ARGS}->{'WatcherRole'},
815 VALUE => $args{ARGS}->{'ValueOfWatcherRole'},
816 OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
823 if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
824 $session{'tickets'}->LimitQueue(
825 VALUE => $args{ARGS}->{'ValueOfQueue'},
826 OPERATOR => $args{ARGS}->{'QueueOp'}
832 if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
833 if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
834 foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
835 $session{'tickets'}->LimitStatus(
837 OPERATOR => $args{ARGS}->{'StatusOp'},
842 $session{'tickets'}->LimitStatus(
843 VALUE => $args{ARGS}->{'ValueOfStatus'},
844 OPERATOR => $args{ARGS}->{'StatusOp'},
852 if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
853 my $val = $args{ARGS}->{'ValueOfSubject'};
854 if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
857 $session{'tickets'}->LimitSubject(
859 OPERATOR => $args{ARGS}->{'SubjectOp'},
865 if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
866 my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
867 $args{ARGS}->{'DateType'} =~ s/_Date$//;
869 if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
870 $session{'tickets'}->LimitTransactionDate(
872 OPERATOR => $args{ARGS}->{'DateOp'},
876 $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
878 OPERATOR => $args{ARGS}->{'DateOp'},
885 if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
886 my $val = $args{ARGS}->{'ValueOfAttachmentField'};
887 if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
890 $session{'tickets'}->Limit(
891 FIELD => $args{ARGS}->{'AttachmentField'},
893 OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
899 # {{{ Limit CustomFields
901 foreach my $arg ( keys %{ $args{ARGS} } ) {
903 if ( $arg =~ /^CustomField(\d+)$/ ) {
909 next unless ( $args{ARGS}->{$arg} );
911 my $form = $args{ARGS}->{$arg};
912 my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
913 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
915 if ($oper =~ /like/i) {
916 $value = "%".$value."%";
918 if ( $value =~ /^null$/i ) {
920 #Don't quote the string 'null'
923 # Convert the operator to something apropriate for nulls
924 $oper = 'IS' if ( $oper eq '=' );
925 $oper = 'IS NOT' if ( $oper eq '!=' );
927 $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
929 QUOTEVALUE => $quote,
941 # {{{ sub ParseDateToISO
943 =head2 ParseDateToISO
945 Takes a date in an arbitrary format.
946 Returns an ISO date and time in GMT
953 my $date_obj = RT::Date->new($session{'CurrentUser'});
958 return ( $date_obj->ISO );
963 # {{{ sub ProcessACLChanges
965 sub ProcessACLChanges {
968 my %ARGS = %$ARGSref;
970 my ( $ACL, @results );
973 foreach my $arg (keys %ARGS) {
974 if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
975 my $principal_id = $1;
976 my $object_type = $2;
978 my $rights = $ARGS{$arg};
980 my $principal = RT::Principal->new($session{'CurrentUser'});
981 $principal->Load($principal_id);
985 if ($object_type eq 'RT::System') {
987 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
988 $obj = $object_type->new($session{'CurrentUser'});
989 $obj->Load($object_id);
991 push (@results, loc("System Error"). ': '.
992 loc("Rights could not be granted for [_1]", $object_type));
996 my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
997 foreach my $right (@rights) {
998 next unless ($right);
999 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
1000 push (@results, $msg);
1003 elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
1004 my $principal_id = $1;
1005 my $object_type = $2;
1009 my $principal = RT::Principal->new($session{'CurrentUser'});
1010 $principal->Load($principal_id);
1011 next unless ($right);
1014 if ($object_type eq 'RT::System') {
1016 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
1017 $obj = $object_type->new($session{'CurrentUser'});
1018 $obj->Load($object_id);
1020 push (@results, loc("System Error"). ': '.
1021 loc("Rights could not be revoked for [_1]", $object_type));
1024 my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
1025 push (@results, $msg);
1037 # {{{ sub UpdateRecordObj
1039 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
1041 @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.
1043 Returns an array of success/failure messages
1047 sub UpdateRecordObject {
1050 AttributesRef => undef,
1052 AttributePrefix => undef,
1056 my $Object = $args{'Object'};
1057 my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
1058 ARGSRef => $args{'ARGSRef'},
1059 AttributePrefix => $args{'AttributePrefix'}
1067 # {{{ Sub ProcessCustomFieldUpdates
1069 sub ProcessCustomFieldUpdates {
1071 CustomFieldObj => undef,
1076 my $Object = $args{'CustomFieldObj'};
1077 my $ARGSRef = $args{'ARGSRef'};
1079 my @attribs = qw( Name Type Description Queue SortOrder);
1080 my @results = UpdateRecordObject(
1081 AttributesRef => \@attribs,
1086 if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
1088 my ( $addval, $addmsg ) = $Object->AddValue(
1090 $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1091 Description => $ARGSRef->{ "CustomField-"
1093 . "-AddValue-Description" },
1094 SortOrder => $ARGSRef->{ "CustomField-"
1096 . "-AddValue-SortOrder" },
1098 push ( @results, $addmsg );
1100 my @delete_values = (
1101 ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1103 ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
1104 : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
1105 foreach my $id (@delete_values) {
1106 next unless defined $id;
1107 my ( $err, $msg ) = $Object->DeleteValue($id);
1108 push ( @results, $msg );
1111 my $vals = $Object->Values();
1112 while (my $cfv = $vals->Next()) {
1113 if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
1114 if ($cfv->SortOrder != $so) {
1115 my ( $err, $msg ) = $cfv->SetSortOrder($so);
1116 push ( @results, $msg );
1126 # {{{ sub ProcessTicketBasics
1128 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1130 Returns an array of results messages.
1134 sub ProcessTicketBasics {
1142 my $TicketObj = $args{'TicketObj'};
1143 my $ARGSRef = $args{'ARGSRef'};
1145 # {{{ Set basic fields
1159 if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
1160 my $tempqueue = RT::Queue->new($RT::SystemUser);
1161 $tempqueue->Load( $ARGSRef->{'Queue'} );
1162 if ( $tempqueue->id ) {
1163 $ARGSRef->{'Queue'} = $tempqueue->Id();
1168 # Status isn't a field that can be set to a null value.
1169 # RT core complains if you try
1170 delete $ARGSRef->{'Status'} unless ($ARGSRef->{'Status'});
1172 my @results = UpdateRecordObject(
1173 AttributesRef => \@attribs,
1174 Object => $TicketObj,
1178 # We special case owner changing, so we can use ForceOwnerChange
1179 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1181 if ( $ARGSRef->{'ForceOwnerChange'} ) {
1182 $ChownType = "Force";
1185 $ChownType = "Give";
1189 $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1190 push ( @results, $msg );
1200 sub ProcessTicketCustomFieldUpdates {
1202 $args{'Object'} = delete $args{'TicketObj'};
1203 my $ARGSRef = { %{ $args{'ARGSRef'} } };
1205 # Build up a list of objects that we want to work with
1206 my %custom_fields_to_mod;
1207 foreach my $arg ( keys %$ARGSRef ) {
1208 if ( $arg =~ /^Ticket-(\d+-.*)/) {
1209 $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
1211 elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1212 $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1216 return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1219 sub ProcessObjectCustomFieldUpdates {
1221 my $ARGSRef = $args{'ARGSRef'};
1224 # Build up a list of objects that we want to work with
1225 my %custom_fields_to_mod;
1226 foreach my $arg ( keys %$ARGSRef ) {
1227 # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands>
1228 next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/;
1230 # For each of those objects, find out what custom fields we want to work with.
1231 $custom_fields_to_mod{ $1 }{ $2 || 0 }{ $3 }{ $4 } = $ARGSRef->{ $arg };
1234 # For each of those objects
1235 foreach my $class ( keys %custom_fields_to_mod ) {
1236 foreach my $id ( keys %{$custom_fields_to_mod{$class}} ) {
1237 my $Object = $args{'Object'};
1238 $Object = $class->new( $session{'CurrentUser'} )
1239 unless $Object && ref $Object eq $class;
1241 $Object->Load( $id ) unless ($Object->id || 0) == $id;
1242 unless ( $Object->id ) {
1243 $RT::Logger->warning("Couldn't load object $class #$id");
1247 foreach my $cf ( keys %{ $custom_fields_to_mod{ $class }{ $id } } ) {
1248 my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} );
1249 $CustomFieldObj->LoadById( $cf );
1250 unless ( $CustomFieldObj->id ) {
1251 $RT::Logger->warning("Couldn't load custom field #$id");
1254 push @results, _ProcessObjectCustomFieldUpdates(
1255 Prefix => "Object-$class-$id-CustomField-$cf-",
1257 CustomField => $CustomFieldObj,
1258 ARGS => $custom_fields_to_mod{$class}{$id}{$cf},
1266 sub _ProcessObjectCustomFieldUpdates {
1268 my $cf = $args{'CustomField'};
1269 my $cf_type = $cf->Type;
1272 foreach my $arg ( keys %{ $args{'ARGS'} } ) {
1274 next if $arg =~ /Category$/;
1276 # since http won't pass in a form element with a null value, we need
1278 if ( $arg eq 'Values-Magic' ) {
1279 # We don't care about the magic, if there's really a values element;
1280 next if $args{'ARGS'}->{'Value'} || $args{'ARGS'}->{'Values'};
1282 # "Empty" values does not mean anything for Image and Binary fields
1283 next if $cf_type =~ /^(?:Image|Binary)$/;
1286 $args{'ARGS'}->{'Values'} = undef;
1290 if ( ref $args{'ARGS'}->{ $arg } eq 'ARRAY' ) {
1291 @values = @{ $args{'ARGS'}->{$arg} };
1292 } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext
1293 @values = ($args{'ARGS'}->{$arg});
1294 } elsif ( defined( $args{'ARGS'}->{ $arg } ) ) {
1295 @values = split /\n/, $args{'ARGS'}->{ $arg };
1298 if ( ( $cf_type eq 'Freeform' && !$cf->SingleValue ) || $cf_type =~ /text/i ) {
1299 s/\r//g foreach @values;
1301 @values = grep defined && $_ ne '', @values;
1303 if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
1304 foreach my $value (@values) {
1305 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1309 push ( @results, $msg );
1312 elsif ( $arg eq 'Upload' ) {
1313 my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
1314 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1318 push ( @results, $msg );
1320 elsif ( $arg eq 'DeleteValues' ) {
1321 foreach my $value ( @values ) {
1322 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1326 push ( @results, $msg );
1329 elsif ( $arg eq 'DeleteValueIds' ) {
1330 foreach my $value ( @values ) {
1331 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1335 push ( @results, $msg );
1338 elsif ( $arg eq 'Values' && !$cf->Repeated ) {
1339 my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1342 foreach my $value ( @values ) {
1343 # build up a hash of values that the new set has
1344 $values_hash{$value} = 1;
1345 next if $cf_values->HasEntry( $value );
1347 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1351 push ( @results, $msg );
1354 $cf_values->RedoSearch;
1355 while ( my $cf_value = $cf_values->Next ) {
1356 next if $values_hash{ $cf_value->Content };
1358 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1360 Value => $cf_value->Content
1362 push ( @results, $msg);
1365 elsif ( $arg eq 'Values' ) {
1366 my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1368 # keep everything up to the point of difference, delete the rest
1370 foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1371 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1380 # now add/replace extra things, if any
1381 foreach my $value ( @values ) {
1382 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1386 push ( @results, $msg );
1391 loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]",
1392 $cf->Name, ref $args{'Object'}, $args{'Object'}->id )
1399 # {{{ sub ProcessTicketWatchers
1401 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1403 Returns an array of results messages.
1407 sub ProcessTicketWatchers {
1415 my $Ticket = $args{'TicketObj'};
1416 my $ARGSRef = $args{'ARGSRef'};
1420 foreach my $key ( keys %$ARGSRef ) {
1422 # Delete deletable watchers
1423 if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) )
1425 my ( $code, $msg ) = $Ticket->DeleteWatcher(
1429 push @results, $msg;
1432 # Delete watchers in the simple style demanded by the bulk manipulator
1433 elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1434 my ( $code, $msg ) = $Ticket->DeleteWatcher(
1435 Email => $ARGSRef->{$key},
1438 push @results, $msg;
1441 # Add new wathchers by email address
1442 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1443 and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1446 #They're in this order because otherwise $1 gets clobbered :/
1447 my ( $code, $msg ) = $Ticket->AddWatcher(
1448 Type => $ARGSRef->{$key},
1449 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1451 push @results, $msg;
1454 #Add requestors in the simple style demanded by the bulk manipulator
1455 elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1456 my ( $code, $msg ) = $Ticket->AddWatcher(
1458 Email => $ARGSRef->{$key}
1460 push @results, $msg;
1463 # Add new watchers by owner
1464 elsif ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) {
1465 my $principal_id = $1;
1466 my $form = $ARGSRef->{$key};
1467 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
1468 next unless $value =~ /^(?:AdminCc|Cc|Requestor)$/i;
1470 my ( $code, $msg ) = $Ticket->AddWatcher(
1472 PrincipalId => $principal_id
1474 push @results, $msg;
1484 # {{{ sub ProcessTicketDates
1486 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1488 Returns an array of results messages.
1492 sub ProcessTicketDates {
1499 my $Ticket = $args{'TicketObj'};
1500 my $ARGSRef = $args{'ARGSRef'};
1504 # {{{ Set date fields
1505 my @date_fields = qw(
1513 #Run through each field in this list. update the value if apropriate
1514 foreach my $field (@date_fields) {
1517 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1519 #If it's something other than just whitespace
1520 if ( $ARGSRef->{ $field . '_Date' } && ($ARGSRef->{ $field . '_Date' } ne '') ) {
1522 Format => 'unknown',
1523 Value => $ARGSRef->{ $field . '_Date' }
1525 my $obj = $field . "Obj";
1526 if ( ( defined $DateObj->Unix )
1527 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1529 my $method = "Set$field";
1530 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1531 push @results, "$msg";
1542 # {{{ sub ProcessTicketLinks
1544 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1546 Returns an array of results messages.
1550 sub ProcessTicketLinks {
1551 my %args = ( TicketObj => undef,
1555 my $Ticket = $args{'TicketObj'};
1556 my $ARGSRef = $args{'ARGSRef'};
1559 my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1560 ARGSRef => $ARGSRef);
1562 #Merge if we need to
1563 if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1565 $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1566 push @results, $msg;
1574 sub ProcessRecordLinks {
1575 my %args = ( RecordObj => undef,
1579 my $Record = $args{'RecordObj'};
1580 my $ARGSRef = $args{'ARGSRef'};
1584 # Delete links that are gone gone gone.
1585 foreach my $arg ( keys %$ARGSRef ) {
1586 if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1592 "Trying to delete: Base: $base Target: $target Type $type";
1593 my ( $val, $msg ) = $Record->DeleteLink( Base => $base,
1595 Target => $target );
1597 push @results, $msg;
1603 my @linktypes = qw( DependsOn MemberOf RefersTo );
1605 foreach my $linktype (@linktypes) {
1606 if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
1607 for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
1608 $luri =~ s/\s*$//; # Strip trailing whitespace
1609 my ( $val, $msg ) = $Record->AddLink( Target => $luri,
1610 Type => $linktype );
1611 push @results, $msg;
1614 if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1616 for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1617 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1618 Type => $linktype );
1620 push @results, $msg;
1629 =head2 _UploadedFile ( $arg );
1631 Takes a CGI parameter name; if a file is uploaded under that name,
1632 return a hash reference suitable for AddCustomFieldValue's use:
1633 C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
1635 Returns C<undef> if no files were uploaded in the C<$arg> field.
1641 my $cgi_object = $m->cgi_object;
1642 my $fh = $cgi_object->upload($arg) or return undef;
1643 my $upload_info = $cgi_object->uploadInfo($fh);
1645 my $filename = "$fh";
1646 $filename =~ s#^.*[\\/]##;
1651 LargeContent => do { local $/; scalar <$fh> },
1652 ContentType => $upload_info->{'Content-Type'},
1656 =head2 _load_container_object ( $type, $id );
1658 Instantiate container object for saving searches.
1662 sub _load_container_object {
1663 my ($obj_type, $obj_id) = @_;
1664 return RT::SavedSearch->new($session{'CurrentUser'})->_load_privacy_object($obj_type, $obj_id);
1667 =head2 _parse_saved_search ( $arg );
1669 Given a serialization string for saved search, and returns the
1670 container object and the search id.
1674 sub _parse_saved_search {
1676 return unless $spec;
1677 if ($spec !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) {
1684 return (_load_container_object ($obj_type, $obj_id), $search_id);
1687 eval "require RT::Interface::Web_Vendor";
1688 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1689 eval "require RT::Interface::Web_Local";
1690 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});