1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2007 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/copyleft/gpl.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 $user_info{'Privileged'} = 1;
158 if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
159 # Populate fields with information from Unix /etc/passwd
161 my ($comments, $realname) = (getpwnam($user))[5, 6];
162 $user_info{'Comments'} = $comments if defined $comments;
163 $user_info{'RealName'} = $realname if defined $realname;
165 elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
166 # Populate fields with information from NT domain controller
169 # and return the wad of stuff
179 This routine ells the current user's browser to redirect to URL.
180 Additionally, it unties the user's currently active session, helping to avoid
181 A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use
182 a cached DBI statement handle twice at the same time.
188 my $redir_to = shift;
189 untie $HTML::Mason::Commands::session;
190 my $uri = URI->new($redir_to);
191 my $server_uri = URI->new($RT::WebURL);
193 # If the user is coming in via a non-canonical
194 # hostname, don't redirect them to the canonical host,
195 # it will just upset them (and invalidate their credentials)
196 if ($uri->host eq $server_uri->host &&
197 $uri->port eq $server_uri->port) {
198 $uri->host($ENV{'HTTP_HOST'});
199 $uri->port($ENV{'SERVER_PORT'});
202 $HTML::Mason::Commands::m->redirect($uri->canonical);
203 $HTML::Mason::Commands::m->abort;
207 =head2 StaticFileHeaders
209 Send the browser a few headers to try to get it to (somewhat agressively)
210 cache RT's static Javascript and CSS files.
212 This routine could really use _accurate_ heuristics. (XXX TODO)
216 sub StaticFileHeaders {
218 $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
220 # Expire things in a month.
221 $HTML::Mason::Commands::r->headers_out->{'Expires'} = HTTP::Date::time2str( time() + 2592000 );
223 # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since'
224 # request, but we don't handle it and generate full reply again
225 # Last modified at server start time
226 #$HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = HTTP::Date::time2str($^T);
231 package HTML::Mason::Commands;
232 use vars qw/$r $m %session/;
239 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
240 with whatever it's called with. If there is no $session{'CurrentUser'},
241 it creates a temporary user, so we have something to get a localisation handle
248 if ($session{'CurrentUser'} &&
249 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
250 return($session{'CurrentUser'}->loc(@_));
252 elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
253 return ($u->loc(@_));
256 # pathetic case -- SystemUser is gone.
266 =head2 loc_fuzzy STRING
268 loc_fuzzy is for handling localizations of messages that may already
269 contain interpolated variables, typically returned from libraries
270 outside RT's control. It takes the message string and extracts the
271 variable array automatically by matching against the candidate entries
272 inside the lexicon file.
279 if ($session{'CurrentUser'} &&
280 UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
281 return($session{'CurrentUser'}->loc_fuzzy($msg));
284 my $u = RT::CurrentUser->new($RT::SystemUser->Id);
285 return ($u->loc_fuzzy($msg));
293 # Error - calls Error and aborts
296 if ($session{'ErrorDocument'} &&
297 $session{'ErrorDocumentType'}) {
298 $r->content_type($session{'ErrorDocumentType'});
299 $m->comp($session{'ErrorDocument'} , Why => shift);
303 $m->comp("/Elements/Error" , Why => shift);
310 # {{{ sub CreateTicket
312 =head2 CreateTicket ARGS
314 Create a new ticket, using Mason's %ARGS. returns @results.
323 my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
325 my $Queue = new RT::Queue( $session{'CurrentUser'} );
326 unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
327 Abort('Queue not found');
330 unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
331 Abort('You have no permission to create tickets in that queue.');
334 my $due = new RT::Date( $session{'CurrentUser'} );
335 $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
336 my $starts = new RT::Date( $session{'CurrentUser'} );
337 $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
339 my $MIMEObj = MakeMIMEEntity(
340 Subject => $ARGS{'Subject'},
341 From => $ARGS{'From'},
343 Body => $ARGS{'Content'},
344 Type => $ARGS{'ContentType'},
347 if ( $ARGS{'Attachments'} ) {
348 my $rv = $MIMEObj->make_multipart;
349 $RT::Logger->error("Couldn't make multipart message")
350 if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
352 foreach ( values %{$ARGS{'Attachments'}} ) {
354 $RT::Logger->error("Couldn't add empty attachemnt");
357 $MIMEObj->add_part($_);
362 Type => $ARGS{'Type'} || 'ticket',
363 Queue => $ARGS{'Queue'},
364 Owner => $ARGS{'Owner'},
365 InitialPriority => $ARGS{'InitialPriority'},
366 FinalPriority => $ARGS{'FinalPriority'},
367 TimeLeft => $ARGS{'TimeLeft'},
368 TimeEstimated => $ARGS{'TimeEstimated'},
369 TimeWorked => $ARGS{'TimeWorked'},
370 Subject => $ARGS{'Subject'},
371 Status => $ARGS{'Status'},
373 Starts => $starts->ISO,
378 foreach my $type (qw(Requestors Cc AdminCc)) {
379 my @tmp = map { $_->format } grep { $_->address} Mail::Address->parse( $ARGS{ $type } );
381 $create_args{ $type } = [
383 my $user = RT::User->new( $RT::SystemUser );
384 $user->LoadOrCreateByEmail( $_ );
385 # convert to ids to avoid work later
390 "$type got ".join(',',@{$create_args{ $type }}) );
393 # XXX: workaround for name conflict :(
394 $create_args{'Requestor'} = delete $create_args{'Requestors'};
396 foreach my $arg (keys %ARGS) {
397 next if $arg =~ /-(?:Magic|Category)$/;
399 if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
400 $create_args{$arg} = $ARGS{$arg};
402 # Object-RT::Ticket--CustomField-3-Values
403 elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
405 my $cf = RT::CustomField->new( $session{'CurrentUser'});
408 if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
409 $ARGS{$arg} =~ s/\r\n/\n/g;
410 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
413 if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
414 $ARGS{$arg} =~ s/\r//g;
417 if ( $arg =~ /-Upload$/ ) {
418 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
421 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
427 # XXX TODO This code should be about six lines. and badly needs refactoring.
429 # {{{ turn new link lists into arrays, and pass in the proper arguments
430 my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
432 foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
433 $luri =~ s/\s*$//; # Strip trailing whitespace
434 push @dependson, $luri;
436 $create_args{'DependsOn'} = \@dependson;
438 foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
439 push @dependedonby, $luri;
441 $create_args{'DependedOnBy'} = \@dependedonby;
443 foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
444 $luri =~ s/\s*$//; # Strip trailing whitespace
445 push @parents, $luri;
447 $create_args{'Parents'} = \@parents;
449 foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
450 push @children, $luri;
452 $create_args{'Children'} = \@children;
454 foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
455 $luri =~ s/\s*$//; # Strip trailing whitespace
456 push @refersto, $luri;
458 $create_args{'RefersTo'} = \@refersto;
460 foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
461 push @referredtoby, $luri;
463 $create_args{'ReferredToBy'} = \@referredtoby;
467 my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
472 push ( @Actions, split("\n", $ErrMsg) );
473 unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
474 Abort( "No permission to view newly created ticket #"
475 . $Ticket->id . "." );
477 return ( $Ticket, @Actions );
483 # {{{ sub LoadTicket - loads a ticket
487 Takes a ticket id as its only variable. if it's handed an array, it takes
490 Returns an RT::Ticket object as the current user.
497 if ( ref($id) eq "ARRAY" ) {
502 Abort("No ticket specified");
505 my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
507 unless ( $Ticket->id ) {
508 Abort("Could not load ticket $id");
515 # {{{ sub ProcessUpdateMessage
517 sub ProcessUpdateMessage {
519 #TODO document what else this takes.
527 #Make the update content have no 'weird' newlines in it
528 if ( $args{ARGSRef}->{'UpdateTimeWorked'}
529 || $args{ARGSRef}->{'UpdateContent'}
530 || $args{ARGSRef}->{'UpdateAttachments'} )
534 $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
536 $args{ARGSRef}->{'UpdateSubject'} = undef;
539 my $Message = MakeMIMEEntity(
540 Subject => $args{ARGSRef}->{'UpdateSubject'},
541 Body => $args{ARGSRef}->{'UpdateContent'},
542 Type => $args{ARGSRef}->{'UpdateContentType'},
545 $Message->head->add( 'Message-ID' =>
550 . int(rand(2000)) . "."
551 . $args{'TicketObj'}->id . "-"
553 . "0" . "@" # Email sent
556 my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
557 if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
558 $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
561 $old_txn = $args{TicketObj}->Transactions->First();
564 if ( $old_txn->Message && $old_txn->Message->First ) {
565 my @in_reply_to = split(/\s+/m, $old_txn->Message->First->GetHeader('In-Reply-To') || '');
566 my @references = split(/\s+/m, $old_txn->Message->First->GetHeader('References') || '' );
567 my @msgid = split(/\s+/m,$old_txn->Message->First->GetHeader('Message-ID') || '');
568 my @rtmsgid = split(/\s+/m,$old_txn->Message->First->GetHeader('RT-Message-ID') || '');
570 $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
571 $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
574 if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
575 $Message->make_multipart;
576 $Message->add_part($_)
577 foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
580 ## TODO: Implement public comments
581 if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
582 my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(
583 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
584 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
586 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
588 push( @{ $args{Actions} }, $Description );
589 $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
591 elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
592 my ( $Transaction, $Description, $Object ) =
593 $args{TicketObj}->Correspond(
594 CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
595 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
597 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
599 push( @{ $args{Actions} }, $Description );
600 $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
604 @{ $args{'Actions'} },
605 loc("Update type was neither correspondence nor comment.") . " "
606 . loc("Update not recorded.")
614 # {{{ sub MakeMIMEEntity
616 =head2 MakeMIMEEntity PARAMHASH
618 Takes a paramhash Subject, Body and AttachmentFieldName.
620 Also takes Form, Cc and Type as optional paramhash keys.
622 Returns a MIME::Entity.
628 #TODO document what else this takes.
634 AttachmentFieldName => undef,
636 # map Encode::encode_utf8($_), @_,
640 #Make the update content have no 'weird' newlines in it
642 $args{'Body'} =~ s/\r\n/\n/gs if $args{'Body'};
645 # MIME::Head is not happy in utf-8 domain. This only happens
646 # when processing an incoming email (so far observed).
649 $Message = MIME::Entity->build(
650 Subject => $args{'Subject'} || "",
651 From => $args{'From'},
653 Type => $args{'Type'} || 'text/plain',
654 'Charset:' => 'utf8',
655 Data => [ $args{'Body'} ]
659 my $cgi_object = $m->cgi_object;
661 if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
665 use File::Temp qw(tempfile tempdir);
667 #foreach my $filehandle (@filenames) {
669 my ( $fh, $temp_file );
671 # on NFS and NTFS, it is possible that tempfile() conflicts
672 # with other processes, causing a race condition. we try to
673 # accommodate this by pausing and retrying.
674 last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) };
678 binmode $fh; #thank you, windows
680 while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
684 my $uploadinfo = $cgi_object->uploadInfo($filehandle);
686 # Prefer the cached name first over CGI.pm stringification.
687 my $filename = $RT::Mason::CGI::Filename;
688 $filename = "$filehandle" unless defined($filename);
690 $filename =~ s#^.*[\\/]##;
694 Filename => Encode::decode_utf8($filename),
695 Type => $uploadinfo->{'Content-Type'},
703 $Message->make_singlepart();
704 RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
712 # {{{ sub ProcessSearchQuery
714 =head2 ProcessSearchQuery
716 Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
718 TODO Doc exactly what comes in the paramhash
723 sub ProcessSearchQuery {
726 ## TODO: The only parameter here is %ARGS. Maybe it would be
727 ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
728 ## instead of $args{ARGS}->{...} ? :)
730 #Searches are sticky.
731 if ( defined $session{'tickets'} ) {
733 # Reset the old search
734 $session{'tickets'}->GotoFirstItem;
739 $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
742 #Import a bookmarked search if we have one
743 if ( defined $args{ARGS}->{'Bookmark'} ) {
744 $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
747 # {{{ Goto next/prev page
748 if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
749 $session{'tickets'}->NextPage;
751 elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
752 $session{'tickets'}->PrevPage;
754 elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
755 $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
760 # {{{ Deal with limiting the search
762 if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
763 $session{'tickets_refresh_interval'} =
764 $args{ARGS}->{'RefreshSearchInterval'};
767 if ( $args{ARGS}->{'TicketsSortBy'} ) {
768 $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
769 $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
770 $session{'tickets'}->OrderBy(
771 FIELD => $args{ARGS}->{'TicketsSortBy'},
772 ORDER => $args{ARGS}->{'TicketsSortOrder'}
778 # {{{ Set the query limit
779 if ( defined $args{ARGS}->{'RowsPerPage'} ) {
781 "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
783 $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
784 $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
789 if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
790 $session{'tickets'}->LimitPriority(
791 VALUE => $args{ARGS}->{'ValueOfPriority'},
792 OPERATOR => $args{ARGS}->{'PriorityOp'}
798 if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
799 $session{'tickets'}->LimitOwner(
800 VALUE => $args{ARGS}->{'ValueOfOwner'},
801 OPERATOR => $args{ARGS}->{'OwnerOp'}
806 # {{{ Limit requestor email
807 if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
808 $session{'tickets'}->LimitWatcher(
809 TYPE => $args{ARGS}->{'WatcherRole'},
810 VALUE => $args{ARGS}->{'ValueOfWatcherRole'},
811 OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
818 if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
819 $session{'tickets'}->LimitQueue(
820 VALUE => $args{ARGS}->{'ValueOfQueue'},
821 OPERATOR => $args{ARGS}->{'QueueOp'}
827 if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
828 if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
829 foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
830 $session{'tickets'}->LimitStatus(
832 OPERATOR => $args{ARGS}->{'StatusOp'},
837 $session{'tickets'}->LimitStatus(
838 VALUE => $args{ARGS}->{'ValueOfStatus'},
839 OPERATOR => $args{ARGS}->{'StatusOp'},
847 if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
848 my $val = $args{ARGS}->{'ValueOfSubject'};
849 if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
852 $session{'tickets'}->LimitSubject(
854 OPERATOR => $args{ARGS}->{'SubjectOp'},
860 if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
861 my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
862 $args{ARGS}->{'DateType'} =~ s/_Date$//;
864 if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
865 $session{'tickets'}->LimitTransactionDate(
867 OPERATOR => $args{ARGS}->{'DateOp'},
871 $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
873 OPERATOR => $args{ARGS}->{'DateOp'},
880 if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
881 my $val = $args{ARGS}->{'ValueOfAttachmentField'};
882 if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
885 $session{'tickets'}->Limit(
886 FIELD => $args{ARGS}->{'AttachmentField'},
888 OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
894 # {{{ Limit CustomFields
896 foreach my $arg ( keys %{ $args{ARGS} } ) {
898 if ( $arg =~ /^CustomField(\d+)$/ ) {
904 next unless ( $args{ARGS}->{$arg} );
906 my $form = $args{ARGS}->{$arg};
907 my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
908 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
910 if ($oper =~ /like/i) {
911 $value = "%".$value."%";
913 if ( $value =~ /^null$/i ) {
915 #Don't quote the string 'null'
918 # Convert the operator to something apropriate for nulls
919 $oper = 'IS' if ( $oper eq '=' );
920 $oper = 'IS NOT' if ( $oper eq '!=' );
922 $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
924 QUOTEVALUE => $quote,
936 # {{{ sub ParseDateToISO
938 =head2 ParseDateToISO
940 Takes a date in an arbitrary format.
941 Returns an ISO date and time in GMT
948 my $date_obj = RT::Date->new($session{'CurrentUser'});
953 return ( $date_obj->ISO );
958 # {{{ sub ProcessACLChanges
960 sub ProcessACLChanges {
963 my %ARGS = %$ARGSref;
965 my ( $ACL, @results );
968 foreach my $arg (keys %ARGS) {
969 if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
970 my $principal_id = $1;
971 my $object_type = $2;
973 my $rights = $ARGS{$arg};
975 my $principal = RT::Principal->new($session{'CurrentUser'});
976 $principal->Load($principal_id);
980 if ($object_type eq 'RT::System') {
982 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
983 $obj = $object_type->new($session{'CurrentUser'});
984 $obj->Load($object_id);
986 push (@results, loc("System Error"). ': '.
987 loc("Rights could not be granted for [_1]", $object_type));
991 my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
992 foreach my $right (@rights) {
993 next unless ($right);
994 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
995 push (@results, $msg);
998 elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
999 my $principal_id = $1;
1000 my $object_type = $2;
1004 my $principal = RT::Principal->new($session{'CurrentUser'});
1005 $principal->Load($principal_id);
1006 next unless ($right);
1009 if ($object_type eq 'RT::System') {
1011 } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
1012 $obj = $object_type->new($session{'CurrentUser'});
1013 $obj->Load($object_id);
1015 push (@results, loc("System Error"). ': '.
1016 loc("Rights could not be revoked for [_1]", $object_type));
1019 my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
1020 push (@results, $msg);
1032 # {{{ sub UpdateRecordObj
1034 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
1036 @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.
1038 Returns an array of success/failure messages
1042 sub UpdateRecordObject {
1045 AttributesRef => undef,
1047 AttributePrefix => undef,
1051 my $Object = $args{'Object'};
1052 my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
1053 ARGSRef => $args{'ARGSRef'},
1054 AttributePrefix => $args{'AttributePrefix'}
1062 # {{{ Sub ProcessCustomFieldUpdates
1064 sub ProcessCustomFieldUpdates {
1066 CustomFieldObj => undef,
1071 my $Object = $args{'CustomFieldObj'};
1072 my $ARGSRef = $args{'ARGSRef'};
1074 my @attribs = qw( Name Type Description Queue SortOrder);
1075 my @results = UpdateRecordObject(
1076 AttributesRef => \@attribs,
1081 if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
1083 my ( $addval, $addmsg ) = $Object->AddValue(
1085 $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1086 Description => $ARGSRef->{ "CustomField-"
1088 . "-AddValue-Description" },
1089 SortOrder => $ARGSRef->{ "CustomField-"
1091 . "-AddValue-SortOrder" },
1093 push ( @results, $addmsg );
1095 my @delete_values = (
1096 ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1098 ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
1099 : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
1100 foreach my $id (@delete_values) {
1101 next unless defined $id;
1102 my ( $err, $msg ) = $Object->DeleteValue($id);
1103 push ( @results, $msg );
1106 my $vals = $Object->Values();
1107 while (my $cfv = $vals->Next()) {
1108 if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
1109 if ($cfv->SortOrder != $so) {
1110 my ( $err, $msg ) = $cfv->SetSortOrder($so);
1111 push ( @results, $msg );
1121 # {{{ sub ProcessTicketBasics
1123 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1125 Returns an array of results messages.
1129 sub ProcessTicketBasics {
1137 my $TicketObj = $args{'TicketObj'};
1138 my $ARGSRef = $args{'ARGSRef'};
1140 # {{{ Set basic fields
1154 if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
1155 my $tempqueue = RT::Queue->new($RT::SystemUser);
1156 $tempqueue->Load( $ARGSRef->{'Queue'} );
1157 if ( $tempqueue->id ) {
1158 $ARGSRef->{'Queue'} = $tempqueue->Id();
1163 # Status isn't a field that can be set to a null value.
1164 # RT core complains if you try
1165 delete $ARGSRef->{'Status'} unless ($ARGSRef->{'Status'});
1167 my @results = UpdateRecordObject(
1168 AttributesRef => \@attribs,
1169 Object => $TicketObj,
1173 # We special case owner changing, so we can use ForceOwnerChange
1174 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1176 if ( $ARGSRef->{'ForceOwnerChange'} ) {
1177 $ChownType = "Force";
1180 $ChownType = "Give";
1184 $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1185 push ( @results, $msg );
1195 sub ProcessTicketCustomFieldUpdates {
1197 $args{'Object'} = delete $args{'TicketObj'};
1198 my $ARGSRef = { %{ $args{'ARGSRef'} } };
1200 # Build up a list of objects that we want to work with
1201 my %custom_fields_to_mod;
1202 foreach my $arg ( keys %$ARGSRef ) {
1203 if ( $arg =~ /^Ticket-(\d+-.*)/) {
1204 $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
1206 elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1207 $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1211 return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1214 sub ProcessObjectCustomFieldUpdates {
1216 my $ARGSRef = $args{'ARGSRef'};
1219 # Build up a list of objects that we want to work with
1220 my %custom_fields_to_mod;
1221 foreach my $arg ( keys %$ARGSRef ) {
1222 # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands>
1223 next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/;
1225 # For each of those objects, find out what custom fields we want to work with.
1226 $custom_fields_to_mod{ $1 }{ $2 || 0 }{ $3 }{ $4 } = $ARGSRef->{ $arg };
1229 # For each of those objects
1230 foreach my $class ( keys %custom_fields_to_mod ) {
1231 foreach my $id ( keys %{$custom_fields_to_mod{$class}} ) {
1232 my $Object = $args{'Object'};
1233 $Object = $class->new( $session{'CurrentUser'} )
1234 unless $Object && ref $Object eq $class;
1236 $Object->Load( $id ) unless ($Object->id || 0) == $id;
1237 unless ( $Object->id ) {
1238 $RT::Logger->warning("Couldn't load object $class #$id");
1242 foreach my $cf ( keys %{ $custom_fields_to_mod{ $class }{ $id } } ) {
1243 my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} );
1244 $CustomFieldObj->LoadById( $cf );
1245 unless ( $CustomFieldObj->id ) {
1246 $RT::Logger->warning("Couldn't load custom field #$id");
1249 push @results, _ProcessObjectCustomFieldUpdates(
1250 Prefix => "Object-$class-$id-CustomField-$cf-",
1252 CustomField => $CustomFieldObj,
1253 ARGS => $custom_fields_to_mod{$class}{$id}{$cf},
1261 sub _ProcessObjectCustomFieldUpdates {
1263 my $cf = $args{'CustomField'};
1264 my $cf_type = $cf->Type;
1267 foreach my $arg ( keys %{ $args{'ARGS'} } ) {
1269 next if $arg =~ /Category$/;
1271 # since http won't pass in a form element with a null value, we need
1273 if ( $arg eq 'Values-Magic' ) {
1274 # We don't care about the magic, if there's really a values element;
1275 next if $args{'ARGS'}->{'Value'} || $args{'ARGS'}->{'Values'};
1277 # "Empty" values does not mean anything for Image and Binary fields
1278 next if $cf_type =~ /^(?:Image|Binary)$/;
1281 $args{'ARGS'}->{'Values'} = undef;
1285 if ( ref $args{'ARGS'}->{ $arg } eq 'ARRAY' ) {
1286 @values = @{ $args{'ARGS'}->{$arg} };
1287 } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext
1288 @values = ($args{'ARGS'}->{$arg});
1289 } elsif ( defined( $args{'ARGS'}->{ $arg } ) ) {
1290 @values = split /\n/, $args{'ARGS'}->{ $arg };
1293 if ( ( $cf_type eq 'Freeform' && !$cf->SingleValue ) || $cf_type =~ /text/i ) {
1294 s/\r//g foreach @values;
1296 @values = grep defined && $_ ne '', @values;
1298 if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
1299 foreach my $value (@values) {
1300 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1304 push ( @results, $msg );
1307 elsif ( $arg eq 'Upload' ) {
1308 my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
1309 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1313 push ( @results, $msg );
1315 elsif ( $arg eq 'DeleteValues' ) {
1316 foreach my $value ( @values ) {
1317 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1321 push ( @results, $msg );
1324 elsif ( $arg eq 'DeleteValueIds' ) {
1325 foreach my $value ( @values ) {
1326 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1330 push ( @results, $msg );
1333 elsif ( $arg eq 'Values' && !$cf->Repeated ) {
1334 my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1337 foreach my $value ( @values ) {
1338 # build up a hash of values that the new set has
1339 $values_hash{$value} = 1;
1340 next if $cf_values->HasEntry( $value );
1342 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1346 push ( @results, $msg );
1349 $cf_values->RedoSearch;
1350 while ( my $cf_value = $cf_values->Next ) {
1351 next if $values_hash{ $cf_value->Content };
1353 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1355 Value => $cf_value->Content
1357 push ( @results, $msg);
1360 elsif ( $arg eq 'Values' ) {
1361 my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1363 # keep everything up to the point of difference, delete the rest
1365 foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1366 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1375 # now add/replace extra things, if any
1376 foreach my $value ( @values ) {
1377 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1381 push ( @results, $msg );
1386 loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]",
1387 $cf->Name, ref $args{'Object'}, $args{'Object'}->id )
1394 # {{{ sub ProcessTicketWatchers
1396 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1398 Returns an array of results messages.
1402 sub ProcessTicketWatchers {
1410 my $Ticket = $args{'TicketObj'};
1411 my $ARGSRef = $args{'ARGSRef'};
1415 foreach my $key ( keys %$ARGSRef ) {
1417 # Delete deletable watchers
1418 if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) )
1420 my ( $code, $msg ) = $Ticket->DeleteWatcher(
1424 push @results, $msg;
1427 # Delete watchers in the simple style demanded by the bulk manipulator
1428 elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1429 my ( $code, $msg ) = $Ticket->DeleteWatcher(
1430 Email => $ARGSRef->{$key},
1433 push @results, $msg;
1436 # Add new wathchers by email address
1437 elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1438 and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1441 #They're in this order because otherwise $1 gets clobbered :/
1442 my ( $code, $msg ) = $Ticket->AddWatcher(
1443 Type => $ARGSRef->{$key},
1444 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1446 push @results, $msg;
1449 #Add requestors in the simple style demanded by the bulk manipulator
1450 elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1451 my ( $code, $msg ) = $Ticket->AddWatcher(
1453 Email => $ARGSRef->{$key}
1455 push @results, $msg;
1458 # Add new watchers by owner
1459 elsif ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) {
1460 my $principal_id = $1;
1461 my $form = $ARGSRef->{$key};
1462 foreach my $value ( ref($form) ? @{$form} : ($form) ) {
1463 next unless $value =~ /^(?:AdminCc|Cc|Requestor)$/i;
1465 my ( $code, $msg ) = $Ticket->AddWatcher(
1467 PrincipalId => $principal_id
1469 push @results, $msg;
1479 # {{{ sub ProcessTicketDates
1481 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1483 Returns an array of results messages.
1487 sub ProcessTicketDates {
1494 my $Ticket = $args{'TicketObj'};
1495 my $ARGSRef = $args{'ARGSRef'};
1499 # {{{ Set date fields
1500 my @date_fields = qw(
1508 #Run through each field in this list. update the value if apropriate
1509 foreach my $field (@date_fields) {
1512 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1514 #If it's something other than just whitespace
1515 if ( $ARGSRef->{ $field . '_Date' } && ($ARGSRef->{ $field . '_Date' } ne '') ) {
1517 Format => 'unknown',
1518 Value => $ARGSRef->{ $field . '_Date' }
1520 my $obj = $field . "Obj";
1521 if ( ( defined $DateObj->Unix )
1522 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1524 my $method = "Set$field";
1525 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1526 push @results, "$msg";
1537 # {{{ sub ProcessTicketLinks
1539 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1541 Returns an array of results messages.
1545 sub ProcessTicketLinks {
1546 my %args = ( TicketObj => undef,
1550 my $Ticket = $args{'TicketObj'};
1551 my $ARGSRef = $args{'ARGSRef'};
1554 my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1555 ARGSRef => $ARGSRef);
1557 #Merge if we need to
1558 if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1560 $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1561 push @results, $msg;
1569 sub ProcessRecordLinks {
1570 my %args = ( RecordObj => undef,
1574 my $Record = $args{'RecordObj'};
1575 my $ARGSRef = $args{'ARGSRef'};
1579 # Delete links that are gone gone gone.
1580 foreach my $arg ( keys %$ARGSRef ) {
1581 if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1587 "Trying to delete: Base: $base Target: $target Type $type";
1588 my ( $val, $msg ) = $Record->DeleteLink( Base => $base,
1590 Target => $target );
1592 push @results, $msg;
1598 my @linktypes = qw( DependsOn MemberOf RefersTo );
1600 foreach my $linktype (@linktypes) {
1601 if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
1602 for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
1603 $luri =~ s/\s*$//; # Strip trailing whitespace
1604 my ( $val, $msg ) = $Record->AddLink( Target => $luri,
1605 Type => $linktype );
1606 push @results, $msg;
1609 if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1611 for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1612 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1613 Type => $linktype );
1615 push @results, $msg;
1624 =head2 _UploadedFile ( $arg );
1626 Takes a CGI parameter name; if a file is uploaded under that name,
1627 return a hash reference suitable for AddCustomFieldValue's use:
1628 C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
1630 Returns C<undef> if no files were uploaded in the C<$arg> field.
1636 my $cgi_object = $m->cgi_object;
1637 my $fh = $cgi_object->upload($arg) or return undef;
1638 my $upload_info = $cgi_object->uploadInfo($fh);
1640 my $filename = "$fh";
1641 $filename =~ s#^.*[\\/]##;
1646 LargeContent => do { local $/; scalar <$fh> },
1647 ContentType => $upload_info->{'Content-Type'},
1651 =head2 _load_container_object ( $type, $id );
1653 Instantiate container object for saving searches.
1657 sub _load_container_object {
1658 my ($obj_type, $obj_id) = @_;
1659 return RT::SavedSearch->new($session{'CurrentUser'})->_load_privacy_object($obj_type, $obj_id);
1662 =head2 _parse_saved_search ( $arg );
1664 Given a serialization string for saved search, and returns the
1665 container object and the search id.
1669 sub _parse_saved_search {
1671 return unless $spec;
1672 if ($spec !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) {
1679 return (_load_container_object ($obj_type, $obj_id), $search_id);
1682 eval "require RT::Interface::Web_Vendor";
1683 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1684 eval "require RT::Interface::Web_Local";
1685 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});