rt/lib/RT/Interface/Web.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  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
  16 # from www.gnu.org.
  17 #
  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.
  22 #
  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.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  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.)
  37 #
  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.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
  49
  50 ## This is a library of static subs to be used by the Mason web
  51 ## interface to RT
  52
  53
  54 =head1 NAME
  55
  56 RT::Interface::Web
  57
  58 =begin testing
  59
  60 use_ok(RT::Interface::Web);
  61
  62 =end testing
  63
  64 =cut
  65
  66
  67 use strict;
  68 use warnings;
  69
  70 package RT::Interface::Web;
  71 use HTTP::Date;
  72 use RT::SavedSearches;
  73 use URI;
  74
  75 # {{{ EscapeUTF8
  76
  77 =head2 EscapeUTF8 SCALARREF
  78
  79 does a css-busting but minimalist escaping of whatever html you're passing in.
  80
  81 =cut
  82
  83 sub EscapeUTF8  {
  84         my  $ref = shift;
  85         return unless defined $$ref;
  86         my $val = $$ref;
  87         use bytes;
  88         $val =~ s/&/&#38;/g;
  89         $val =~ s/</&lt;/g;
  90         $val =~ s/>/&gt;/g;
  91         $val =~ s/\(/&#40;/g;
  92         $val =~ s/\)/&#41;/g;
  93         $val =~ s/"/&#34;/g;
  94         $val =~ s/'/&#39;/g;
  95         $$ref = $val;
  96         Encode::_utf8_on($$ref);
  97
  98
  99 }
 100
 101 # }}}
 102
 103 # {{{ EscapeURI
 104
 105 =head2 EscapeURI SCALARREF
 106
 107 Escapes URI component according to RFC2396
 108
 109 =cut
 110
 111 use Encode qw();
 112 sub EscapeURI {
 113     my $ref = shift;
 114     $$ref = Encode::encode_utf8( $$ref );
 115     $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
 116     Encode::_utf8_on( $$ref );
 117 }
 118
 119 # }}}
 120
 121 # {{{ WebCanonicalizeInfo
 122
 123 =head2 WebCanonicalizeInfo();
 124
 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'}
 128
 129 =cut
 130
 131 sub WebCanonicalizeInfo {
 132     my $user;
 133
 134     if ( defined $ENV{'REMOTE_USER'} ) {
 135         $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) );
 136     }
 137
 138     return $user;
 139 }
 140
 141 # }}}
 142
 143 # {{{ WebExternalAutoInfo
 144
 145 =head2 WebExternalAutoInfo($user);
 146
 147 Returns a hash of user attributes, used when WebExternalAuto is set.
 148
 149 =cut
 150
 151 sub WebExternalAutoInfo {
 152     my $user = shift;
 153
 154     my %user_info;
 155
 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;
 161     }
 162
 163     if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
 164         # Populate fields with information from Unix /etc/passwd
 165
 166         my ($comments, $realname) = (getpwnam($user))[5, 6];
 167         $user_info{'Comments'} = $comments if defined $comments;
 168         $user_info{'RealName'} = $realname if defined $realname;
 169     }
 170     elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
 171         # Populate fields with information from NT domain controller
 172     }
 173
 174     # and return the wad of stuff
 175     return {%user_info};
 176 }
 177
 178 # }}}
 179
 180
 181
 182 =head2 Redirect URL
 183
 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.
 188
 189 =cut
 190
 191
 192 sub Redirect {
 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);
 197
 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'});
 205         }
 206
 207     $HTML::Mason::Commands::m->redirect($uri->canonical);
 208     $HTML::Mason::Commands::m->abort;
 209 }
 210
 211
 212 =head2 StaticFileHeaders
 213
 214 Send the browser a few headers to try to get it to (somewhat agressively)
 215 cache RT's static Javascript and CSS files.
 216
 217 This routine could really use _accurate_ heuristics. (XXX TODO)
 218
 219 =cut
 220
 221 sub StaticFileHeaders {
 222     # make cache public
 223     $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
 224
 225     # Expire things in a month.
 226     $HTML::Mason::Commands::r->headers_out->{'Expires'} = HTTP::Date::time2str( time() + 2592000 );
 227
 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);
 232
 233 }
 234
 235
 236 package HTML::Mason::Commands;
 237 use vars qw/$r $m %session/;
 238
 239
 240 # {{{ loc
 241
 242 =head2 loc ARRAY
 243
 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
 247 through
 248
 249 =cut
 250
 251 sub loc {
 252
 253     if ($session{'CurrentUser'} &&
 254         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 255         return($session{'CurrentUser'}->loc(@_));
 256     }
 257     elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
 258         return ($u->loc(@_));
 259     }
 260     else {
 261         # pathetic case -- SystemUser is gone.
 262         return $_[0];
 263     }
 264 }
 265
 266 # }}}
 267
 268
 269 # {{{ loc_fuzzy
 270
 271 =head2 loc_fuzzy STRING
 272
 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.
 278
 279 =cut
 280
 281 sub loc_fuzzy {
 282     my $msg  = shift;
 283
 284     if ($session{'CurrentUser'} &&
 285         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 286         return($session{'CurrentUser'}->loc_fuzzy($msg));
 287     }
 288     else  {
 289         my $u = RT::CurrentUser->new($RT::SystemUser->Id);
 290         return ($u->loc_fuzzy($msg));
 291     }
 292 }
 293
 294 # }}}
 295
 296
 297 # {{{ sub Abort
 298 # Error - calls Error and aborts
 299 sub Abort {
 300
 301     if ($session{'ErrorDocument'} &&
 302         $session{'ErrorDocumentType'}) {
 303         $r->content_type($session{'ErrorDocumentType'});
 304         $m->comp($session{'ErrorDocument'} , Why => shift);
 305         $m->abort;
 306     }
 307     else  {
 308         $m->comp("/Elements/Error" , Why => shift);
 309         $m->abort;
 310     }
 311 }
 312
 313 # }}}
 314
 315 # {{{ sub CreateTicket
 316
 317 =head2 CreateTicket ARGS
 318
 319 Create a new ticket, using Mason's %ARGS.  returns @results.
 320
 321 =cut
 322
 323 sub CreateTicket {
 324     my %ARGS = (@_);
 325
 326     my (@Actions);
 327
 328     my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
 329
 330     my $Queue = new RT::Queue( $session{'CurrentUser'} );
 331     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
 332         Abort('Queue not found');
 333     }
 334
 335     unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
 336         Abort('You have no permission to create tickets in that queue.');
 337     }
 338
 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'} );
 343
 344     my $MIMEObj = MakeMIMEEntity(
 345         Subject             => $ARGS{'Subject'},
 346         From                => $ARGS{'From'},
 347         Cc                  => $ARGS{'Cc'},
 348         Body                => $ARGS{'Content'},
 349         Type                => $ARGS{'ContentType'},
 350     );
 351
 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)$/;
 356
 357         foreach ( values %{$ARGS{'Attachments'}} ) {
 358             unless ( $_ ) {
 359                 $RT::Logger->error("Couldn't add empty attachemnt");
 360                 next;
 361             }
 362             $MIMEObj->add_part($_);
 363         }
 364     }
 365
 366     my %create_args = (
 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'},
 377         Due             => $due->ISO,
 378         Starts          => $starts->ISO,
 379         MIMEObj         => $MIMEObj
 380     );
 381
 382     my @temp_squelch;
 383     foreach my $type (qw(Requestors Cc AdminCc)) {
 384         my @tmp = map { $_->format } grep { $_->address} Mail::Address->parse( $ARGS{ $type } );
 385
 386         $create_args{ $type } = [
 387             grep $_, map {
 388                 my $user = RT::User->new( $RT::SystemUser );
 389                 $user->LoadOrCreateByEmail( $_ );
 390                 # convert to ids to avoid work later
 391                 $user->id;
 392             } @tmp
 393         ];
 394         $RT::Logger->debug(
 395             "$type got ".join(',',@{$create_args{ $type }}) );
 396
 397     }
 398     # XXX: workaround for name conflict :(
 399     $create_args{'Requestor'} = delete $create_args{'Requestors'};
 400
 401     foreach my $arg (keys %ARGS) {
 402         next if $arg =~ /-(?:Magic|Category)$/;
 403
 404         if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
 405             $create_args{$arg} = $ARGS{$arg};
 406         }
 407         # Object-RT::Ticket--CustomField-3-Values
 408         elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
 409             my $cfid = $1;
 410             my $cf = RT::CustomField->new( $session{'CurrentUser'});
 411             $cf->Load($cfid);
 412
 413             if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
 414                 $ARGS{$arg} =~ s/\r\n/\n/g;
 415                 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
 416             }
 417
 418             if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
 419                 $ARGS{$arg} =~ s/\r//g;
 420             }
 421
 422             if ( $arg =~ /-Upload$/ ) {
 423                 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
 424             }
 425             else {
 426                 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
 427             }
 428         }
 429     }
 430
 431
 432     # XXX TODO This code should be about six lines. and badly needs refactoring.
 433
 434     # {{{ turn new link lists into arrays, and pass in the proper arguments
 435     my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
 436
 437     foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
 438         $luri =~ s/\s*$//;    # Strip trailing whitespace
 439         push @dependson, $luri;
 440     }
 441     $create_args{'DependsOn'} = \@dependson;
 442
 443     foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
 444         push @dependedonby, $luri;
 445     }
 446     $create_args{'DependedOnBy'} = \@dependedonby;
 447
 448     foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
 449         $luri =~ s/\s*$//;    # Strip trailing whitespace
 450         push @parents, $luri;
 451     }
 452     $create_args{'Parents'} = \@parents;
 453
 454     foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
 455         push @children, $luri;
 456     }
 457     $create_args{'Children'} = \@children;
 458
 459     foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
 460         $luri =~ s/\s*$//;    # Strip trailing whitespace
 461         push @refersto, $luri;
 462     }
 463     $create_args{'RefersTo'} = \@refersto;
 464
 465     foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
 466         push @referredtoby, $luri;
 467     }
 468     $create_args{'ReferredToBy'} = \@referredtoby;
 469     # }}}
 470
 471
 472     my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
 473     unless ( $id ) {
 474         Abort($ErrMsg);
 475     }
 476
 477     push ( @Actions, split("\n", $ErrMsg) );
 478     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
 479         Abort( "No permission to view newly created ticket #"
 480             . $Ticket->id . "." );
 481     }
 482     return ( $Ticket, @Actions );
 483
 484 }
 485
 486 # }}}
 487
 488 # {{{ sub LoadTicket - loads a ticket
 489
 490 =head2  LoadTicket id
 491
 492 Takes a ticket id as its only variable. if it's handed an array, it takes
 493 the first value.
 494
 495 Returns an RT::Ticket object as the current user.
 496
 497 =cut
 498
 499 sub LoadTicket {
 500     my $id = shift;
 501
 502     if ( ref($id) eq "ARRAY" ) {
 503         $id = $id->[0];
 504     }
 505
 506     unless ($id) {
 507         Abort("No ticket specified");
 508     }
 509
 510     my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 511     $Ticket->Load($id);
 512     unless ( $Ticket->id ) {
 513         Abort("Could not load ticket $id");
 514     }
 515     return $Ticket;
 516 }
 517
 518 # }}}
 519
 520 # {{{ sub ProcessUpdateMessage
 521
 522 sub ProcessUpdateMessage {
 523
 524     #TODO document what else this takes.
 525     my %args = (
 526         ARGSRef   => undef,
 527         Actions   => undef,
 528         TicketObj => undef,
 529         @_
 530     );
 531
 532     #Make the update content have no 'weird' newlines in it
 533     if (   $args{ARGSRef}->{'UpdateTimeWorked'}
 534         || $args{ARGSRef}->{'UpdateContent'}
 535         || $args{ARGSRef}->{'UpdateAttachments'} )
 536     {
 537
 538         if (
 539             $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
 540         {
 541             $args{ARGSRef}->{'UpdateSubject'} = undef;
 542         }
 543
 544         my $Message = MakeMIMEEntity(
 545             Subject => $args{ARGSRef}->{'UpdateSubject'},
 546             Body    => $args{ARGSRef}->{'UpdateContent'},
 547             Type    => $args{ARGSRef}->{'UpdateContentType'},
 548         );
 549
 550         $Message->head->add( 'Message-ID' =>
 551               "<rt-"
 552               . $RT::VERSION . "-"
 553               . $$ . "-"
 554               . CORE::time() . "-"
 555               . int(rand(2000)) . "."
 556               . $args{'TicketObj'}->id . "-"
 557               . "0" . "-"  # Scrip
 558               . "0" . "@"  # Email sent
 559               . $RT::Organization
 560               . ">" );
 561         my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
 562         if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
 563             $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
 564         }
 565         else {
 566             $old_txn = $args{TicketObj}->Transactions->First();
 567         }
 568
 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') || '');
 574
 575             $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
 576             $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
 577         }
 578
 579     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
 580         $Message->make_multipart;
 581         $Message->add_part($_)
 582           foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
 583     }
 584
 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'},
 590             MIMEObj      => $Message,
 591             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 592         );
 593         push( @{ $args{Actions} }, $Description );
 594         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 595     }
 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'},
 601             MIMEObj      => $Message,
 602             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 603           );
 604         push( @{ $args{Actions} }, $Description );
 605         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 606     }
 607     else {
 608         push(
 609             @{ $args{'Actions'} },
 610             loc("Update type was neither correspondence nor comment.") . " "
 611               . loc("Update not recorded.")
 612         );
 613     }
 614 }
 615 }
 616
 617 # }}}
 618
 619 # {{{ sub MakeMIMEEntity
 620
 621 =head2 MakeMIMEEntity PARAMHASH
 622
 623 Takes a paramhash Subject, Body and AttachmentFieldName.
 624
 625 Also takes Form, Cc and Type as optional paramhash keys.
 626
 627   Returns a MIME::Entity.
 628
 629 =cut
 630
 631 sub MakeMIMEEntity {
 632
 633     #TODO document what else this takes.
 634     my %args = (
 635         Subject             => undef,
 636         From                => undef,
 637         Cc                  => undef,
 638         Body                => undef,
 639         AttachmentFieldName => undef,
 640         Type                => undef,
 641 #        map Encode::encode_utf8($_), @_,
 642         @_,
 643     );
 644
 645     #Make the update content have no 'weird' newlines in it
 646
 647     $args{'Body'} =~ s/\r\n/\n/gs if $args{'Body'};
 648     my $Message;
 649     {
 650         # MIME::Head is not happy in utf-8 domain.  This only happens
 651         # when processing an incoming email (so far observed).
 652         no utf8;
 653         use bytes;
 654         $Message = MIME::Entity->build(
 655             Subject => $args{'Subject'} || "",
 656             From    => $args{'From'},
 657             Cc      => $args{'Cc'},
 658             Type    => $args{'Type'} || 'text/plain',
 659             'Charset:' => 'utf8',
 660             Data    => [ $args{'Body'} ]
 661         );
 662     }
 663
 664     my $cgi_object = $m->cgi_object;
 665
 666     if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
 667
 668
 669
 670     use File::Temp qw(tempfile tempdir);
 671
 672     #foreach my $filehandle (@filenames) {
 673
 674     my ( $fh, $temp_file );
 675     for ( 1 .. 10 ) {
 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) };
 680         sleep 1;
 681     }
 682
 683     binmode $fh;    #thank you, windows
 684     my ($buffer);
 685     while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
 686         print $fh $buffer;
 687     }
 688
 689     my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 690
 691     # Prefer the cached name first over CGI.pm stringification.
 692     my $filename = $RT::Mason::CGI::Filename;
 693     $filename = "$filehandle" unless defined($filename);
 694
 695     $filename =~ s#^.*[\\/]##;
 696
 697     $Message->attach(
 698         Path     => $temp_file,
 699         Filename => Encode::decode_utf8($filename),
 700         Type     => $uploadinfo->{'Content-Type'},
 701     );
 702     close($fh);
 703
 704     #   }
 705
 706     }
 707
 708     $Message->make_singlepart();
 709     RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
 710
 711     return ($Message);
 712
 713 }
 714
 715 # }}}
 716
 717 # {{{ sub ProcessSearchQuery
 718
 719 =head2 ProcessSearchQuery
 720
 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.
 722
 723 TODO Doc exactly what comes in the paramhash
 724
 725
 726 =cut
 727
 728 sub ProcessSearchQuery {
 729     my %args = @_;
 730
 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}->{...} ? :)
 734
 735     #Searches are sticky.
 736     if ( defined $session{'tickets'} ) {
 737
 738         # Reset the old search
 739         $session{'tickets'}->GotoFirstItem;
 740     }
 741     else {
 742
 743         # Init a new search
 744         $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
 745     }
 746
 747     #Import a bookmarked search if we have one
 748     if ( defined $args{ARGS}->{'Bookmark'} ) {
 749         $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
 750     }
 751
 752     # {{{ Goto next/prev page
 753     if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
 754         $session{'tickets'}->NextPage;
 755     }
 756     elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
 757         $session{'tickets'}->PrevPage;
 758     }
 759     elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
 760         $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
 761     }
 762
 763     # }}}
 764
 765     # {{{ Deal with limiting the search
 766
 767     if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
 768         $session{'tickets_refresh_interval'} =
 769           $args{ARGS}->{'RefreshSearchInterval'};
 770     }
 771
 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'}
 778         );
 779     }
 780
 781     # }}}
 782
 783     # {{{ Set the query limit
 784     if ( defined $args{ARGS}->{'RowsPerPage'} ) {
 785         $RT::Logger->debug(
 786             "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
 787
 788         $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
 789         $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
 790     }
 791
 792     # }}}
 793     # {{{ Limit priority
 794     if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
 795         $session{'tickets'}->LimitPriority(
 796             VALUE    => $args{ARGS}->{'ValueOfPriority'},
 797             OPERATOR => $args{ARGS}->{'PriorityOp'}
 798         );
 799     }
 800
 801     # }}}
 802     # {{{ Limit owner
 803     if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
 804         $session{'tickets'}->LimitOwner(
 805             VALUE    => $args{ARGS}->{'ValueOfOwner'},
 806             OPERATOR => $args{ARGS}->{'OwnerOp'}
 807         );
 808     }
 809
 810     # }}}
 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'},
 817
 818         );
 819     }
 820
 821     # }}}
 822     # {{{ Limit Queue
 823     if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
 824         $session{'tickets'}->LimitQueue(
 825             VALUE    => $args{ARGS}->{'ValueOfQueue'},
 826             OPERATOR => $args{ARGS}->{'QueueOp'}
 827         );
 828     }
 829
 830     # }}}
 831     # {{{ Limit Status
 832     if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
 833         if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
 834             foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
 835                 $session{'tickets'}->LimitStatus(
 836                     VALUE    => $value,
 837                     OPERATOR => $args{ARGS}->{'StatusOp'},
 838                 );
 839             }
 840         }
 841         else {
 842             $session{'tickets'}->LimitStatus(
 843                 VALUE    => $args{ARGS}->{'ValueOfStatus'},
 844                 OPERATOR => $args{ARGS}->{'StatusOp'},
 845             );
 846         }
 847
 848     }
 849
 850     # }}}
 851     # {{{ Limit Subject
 852     if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
 853             my $val = $args{ARGS}->{'ValueOfSubject'};
 854         if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
 855             $val = "%".$val."%";
 856         }
 857         $session{'tickets'}->LimitSubject(
 858             VALUE    => $val,
 859             OPERATOR => $args{ARGS}->{'SubjectOp'},
 860         );
 861     }
 862
 863     # }}}
 864     # {{{ Limit Dates
 865     if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
 866         my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
 867         $args{ARGS}->{'DateType'} =~ s/_Date$//;
 868
 869         if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
 870             $session{'tickets'}->LimitTransactionDate(
 871                                             VALUE    => $date,
 872                                             OPERATOR => $args{ARGS}->{'DateOp'},
 873             );
 874         }
 875         else {
 876             $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
 877                                             VALUE => $date,
 878                                             OPERATOR => $args{ARGS}->{'DateOp'},
 879             );
 880         }
 881     }
 882
 883     # }}}
 884     # {{{ Limit Content
 885     if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
 886         my $val = $args{ARGS}->{'ValueOfAttachmentField'};
 887         if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
 888             $val = "%".$val."%";
 889         }
 890         $session{'tickets'}->Limit(
 891             FIELD   => $args{ARGS}->{'AttachmentField'},
 892             VALUE    => $val,
 893             OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
 894         );
 895     }
 896
 897     # }}}
 898
 899  # {{{ Limit CustomFields
 900
 901     foreach my $arg ( keys %{ $args{ARGS} } ) {
 902         my $id;
 903         if ( $arg =~ /^CustomField(\d+)$/ ) {
 904             $id = $1;
 905         }
 906         else {
 907             next;
 908         }
 909         next unless ( $args{ARGS}->{$arg} );
 910
 911         my $form = $args{ARGS}->{$arg};
 912         my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
 913         foreach my $value ( ref($form) ? @{$form} : ($form) ) {
 914             my $quote = 1;
 915             if ($oper =~ /like/i) {
 916                 $value = "%".$value."%";
 917             }
 918             if ( $value =~ /^null$/i ) {
 919
 920                 #Don't quote the string 'null'
 921                 $quote = 0;
 922
 923                 # Convert the operator to something apropriate for nulls
 924                 $oper = 'IS'     if ( $oper eq '=' );
 925                 $oper = 'IS NOT' if ( $oper eq '!=' );
 926             }
 927             $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
 928                                                    OPERATOR    => $oper,
 929                                                    QUOTEVALUE  => $quote,
 930                                                    VALUE       => $value );
 931         }
 932     }
 933
 934     # }}}
 935
 936
 937 }
 938
 939 # }}}
 940
 941 # {{{ sub ParseDateToISO
 942
 943 =head2 ParseDateToISO
 944
 945 Takes a date in an arbitrary format.
 946 Returns an ISO date and time in GMT
 947
 948 =cut
 949
 950 sub ParseDateToISO {
 951     my $date = shift;
 952
 953     my $date_obj = RT::Date->new($session{'CurrentUser'});
 954     $date_obj->Set(
 955         Format => 'unknown',
 956         Value  => $date
 957     );
 958     return ( $date_obj->ISO );
 959 }
 960
 961 # }}}
 962
 963 # {{{ sub ProcessACLChanges
 964
 965 sub ProcessACLChanges {
 966     my $ARGSref = shift;
 967
 968     my %ARGS     = %$ARGSref;
 969
 970     my ( $ACL, @results );
 971
 972
 973     foreach my $arg (keys %ARGS) {
 974         if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
 975             my $principal_id = $1;
 976             my $object_type = $2;
 977             my $object_id = $3;
 978             my $rights = $ARGS{$arg};
 979
 980             my $principal = RT::Principal->new($session{'CurrentUser'});
 981             $principal->Load($principal_id);
 982
 983             my $obj;
 984
 985              if ($object_type eq 'RT::System') {
 986                 $obj = $RT::System;
 987             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
 988                 $obj = $object_type->new($session{'CurrentUser'});
 989                 $obj->Load($object_id);
 990             } else {
 991                 push (@results, loc("System Error"). ': '.
 992                                 loc("Rights could not be granted for [_1]", $object_type));
 993                 next;
 994             }
 995
 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);
1001             }
1002         }
1003        elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
1004             my $principal_id = $1;
1005             my $object_type = $2;
1006             my $object_id = $3;
1007             my $right = $4;
1008
1009             my $principal = RT::Principal->new($session{'CurrentUser'});
1010             $principal->Load($principal_id);
1011             next unless ($right);
1012             my $obj;
1013
1014              if ($object_type eq 'RT::System') {
1015                 $obj = $RT::System;
1016             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
1017                 $obj = $object_type->new($session{'CurrentUser'});
1018                 $obj->Load($object_id);
1019             } else {
1020                 push (@results, loc("System Error"). ': '.
1021                                 loc("Rights could not be revoked for [_1]", $object_type));
1022                 next;
1023             }
1024             my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
1025             push (@results, $msg);
1026         }
1027
1028
1029     }
1030
1031     return (@results);
1032
1033     }
1034
1035 # }}}
1036
1037 # {{{ sub UpdateRecordObj
1038
1039 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
1040
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.
1042
1043 Returns an array of success/failure messages
1044
1045 =cut
1046
1047 sub UpdateRecordObject {
1048     my %args = (
1049         ARGSRef       => undef,
1050         AttributesRef => undef,
1051         Object        => undef,
1052         AttributePrefix => undef,
1053         @_
1054     );
1055
1056     my $Object = $args{'Object'};
1057     my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
1058                                   ARGSRef       => $args{'ARGSRef'},
1059                   AttributePrefix => $args{'AttributePrefix'}
1060                                   );
1061
1062     return (@results);
1063 }
1064
1065 # }}}
1066
1067 # {{{ Sub ProcessCustomFieldUpdates
1068
1069 sub ProcessCustomFieldUpdates {
1070     my %args = (
1071         CustomFieldObj => undef,
1072         ARGSRef        => undef,
1073         @_
1074     );
1075
1076     my $Object  = $args{'CustomFieldObj'};
1077     my $ARGSRef = $args{'ARGSRef'};
1078
1079     my @attribs = qw( Name Type Description Queue SortOrder);
1080     my @results = UpdateRecordObject(
1081         AttributesRef => \@attribs,
1082         Object        => $Object,
1083         ARGSRef       => $ARGSRef
1084     );
1085
1086     if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
1087
1088         my ( $addval, $addmsg ) = $Object->AddValue(
1089             Name =>
1090               $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1091             Description => $ARGSRef->{ "CustomField-"
1092                   . $Object->Id
1093                   . "-AddValue-Description" },
1094             SortOrder => $ARGSRef->{ "CustomField-"
1095                   . $Object->Id
1096                   . "-AddValue-SortOrder" },
1097         );
1098         push ( @results, $addmsg );
1099     }
1100     my @delete_values = (
1101         ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1102           'ARRAY' )
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 );
1109     }
1110
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 );
1117             }
1118         }
1119     }
1120
1121     return (@results);
1122 }
1123
1124 # }}}
1125
1126 # {{{ sub ProcessTicketBasics
1127
1128 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1129
1130 Returns an array of results messages.
1131
1132 =cut
1133
1134 sub ProcessTicketBasics {
1135
1136     my %args = (
1137         TicketObj => undef,
1138         ARGSRef   => undef,
1139         @_
1140     );
1141
1142     my $TicketObj = $args{'TicketObj'};
1143     my $ARGSRef   = $args{'ARGSRef'};
1144
1145     # {{{ Set basic fields
1146     my @attribs = qw(
1147       Subject
1148       FinalPriority
1149       Priority
1150       TimeEstimated
1151       TimeWorked
1152       TimeLeft
1153       Type
1154       Status
1155       Queue
1156     );
1157
1158
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();
1164         }
1165     }
1166
1167
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'});
1171
1172     my @results = UpdateRecordObject(
1173         AttributesRef => \@attribs,
1174         Object        => $TicketObj,
1175         ARGSRef       => $ARGSRef
1176     );
1177
1178     # We special case owner changing, so we can use ForceOwnerChange
1179     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1180         my ($ChownType);
1181         if ( $ARGSRef->{'ForceOwnerChange'} ) {
1182             $ChownType = "Force";
1183         }
1184         else {
1185             $ChownType = "Give";
1186         }
1187
1188         my ( $val, $msg ) =
1189           $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1190         push ( @results, $msg );
1191     }
1192
1193     # }}}
1194
1195     return (@results);
1196 }
1197
1198 # }}}
1199
1200 sub ProcessTicketCustomFieldUpdates {
1201     my %args = @_;
1202     $args{'Object'} = delete $args{'TicketObj'};
1203     my $ARGSRef = { %{ $args{'ARGSRef'} } };
1204
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};
1210         }
1211         elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1212             $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1213         }
1214     }
1215
1216     return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1217 }
1218
1219 sub ProcessObjectCustomFieldUpdates {
1220     my %args = @_;
1221     my $ARGSRef = $args{'ARGSRef'};
1222     my @results;
1223
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+)-(.*)$/;
1229
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 };
1232     }
1233
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;
1240
1241             $Object->Load( $id ) unless ($Object->id || 0) == $id;
1242             unless ( $Object->id ) {
1243                 $RT::Logger->warning("Couldn't load object $class #$id");
1244                 next;
1245             }
1246
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");
1252                     next;
1253                 }
1254                 push @results, _ProcessObjectCustomFieldUpdates(
1255                     Prefix      => "Object-$class-$id-CustomField-$cf-",
1256                     Object      => $Object,
1257                     CustomField => $CustomFieldObj,
1258                     ARGS        => $custom_fields_to_mod{$class}{$id}{$cf},
1259                 );
1260             }
1261         }
1262     }
1263     return @results;
1264 }
1265
1266 sub _ProcessObjectCustomFieldUpdates {
1267     my %args = @_;
1268     my $cf = $args{'CustomField'};
1269     my $cf_type = $cf->Type;
1270
1271     my @results;
1272     foreach my $arg ( keys %{ $args{'ARGS'} } ) {
1273
1274         next if $arg =~ /Category$/;
1275
1276         # since http won't pass in a form element with a null value, we need
1277         # to fake it
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'};
1281
1282             # "Empty" values does not mean anything for Image and Binary fields
1283             next if $cf_type =~ /^(?:Image|Binary)$/;
1284
1285             $arg = 'Values';
1286             $args{'ARGS'}->{'Values'} = undef;
1287         }
1288
1289         my @values = ();
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 };
1296         }
1297
1298         if ( ( $cf_type eq 'Freeform' && !$cf->SingleValue ) || $cf_type =~ /text/i ) {
1299             s/\r//g foreach @values;
1300         }
1301         @values = grep defined && $_ ne '', @values;
1302
1303         if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
1304             foreach my $value (@values) {
1305                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1306                     Field => $cf->id,
1307                     Value => $value
1308                 );
1309                 push ( @results, $msg );
1310             }
1311         }
1312         elsif ( $arg eq 'Upload' ) {
1313             my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
1314             my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1315                 %$value_hash,
1316                 Field => $cf,
1317             );
1318             push ( @results, $msg );
1319         }
1320         elsif ( $arg eq 'DeleteValues' ) {
1321             foreach my $value ( @values ) {
1322                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1323                     Field => $cf,
1324                     Value => $value,
1325                 );
1326                 push ( @results, $msg );
1327             }
1328         }
1329         elsif ( $arg eq 'DeleteValueIds' ) {
1330             foreach my $value ( @values ) {
1331                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1332                     Field   => $cf,
1333                     ValueId => $value,
1334                 );
1335                 push ( @results, $msg );
1336             }
1337         }
1338         elsif ( $arg eq 'Values' && !$cf->Repeated ) {
1339             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1340
1341             my %values_hash;
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 );
1346
1347                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1348                     Field => $cf,
1349                     Value => $value
1350                 );
1351                 push ( @results, $msg );
1352             }
1353
1354             $cf_values->RedoSearch;
1355             while ( my $cf_value = $cf_values->Next ) {
1356                 next if $values_hash{ $cf_value->Content };
1357
1358                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1359                     Field => $cf,
1360                     Value => $cf_value->Content
1361                 );
1362                 push ( @results, $msg);
1363             }
1364         }
1365         elsif ( $arg eq 'Values' ) {
1366             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1367
1368             # keep everything up to the point of difference, delete the rest
1369             my $delete_flag;
1370             foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1371                 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1372                     shift @values;
1373                     next;
1374                 }
1375
1376                 $delete_flag ||= 1;
1377                 $old_cf->Delete;
1378             }
1379
1380             # now add/replace extra things, if any
1381             foreach my $value ( @values ) {
1382                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1383                     Field => $cf,
1384                     Value => $value
1385                 );
1386                 push ( @results, $msg );
1387             }
1388         }
1389         else {
1390             push ( @results,
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 )
1393             );
1394         }
1395     }
1396     return @results;
1397 }
1398
1399 # {{{ sub ProcessTicketWatchers
1400
1401 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1402
1403 Returns an array of results messages.
1404
1405 =cut
1406
1407 sub ProcessTicketWatchers {
1408     my %args = (
1409         TicketObj => undef,
1410         ARGSRef   => undef,
1411         @_
1412     );
1413     my (@results);
1414
1415     my $Ticket  = $args{'TicketObj'};
1416     my $ARGSRef = $args{'ARGSRef'};
1417
1418     # Munge watchers
1419
1420     foreach my $key ( keys %$ARGSRef ) {
1421
1422         # Delete deletable watchers
1423         if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) )
1424         {
1425             my ( $code, $msg ) = $Ticket->DeleteWatcher(
1426                 PrincipalId => $2,
1427                 Type        => $1
1428             );
1429             push @results, $msg;
1430         }
1431
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},
1436                 Type  => $1
1437             );
1438             push @results, $msg;
1439         }
1440
1441         # Add new wathchers by email address
1442         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1443             and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1444         {
1445
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 }
1450             );
1451             push @results, $msg;
1452         }
1453
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(
1457                 Type  => $1,
1458                 Email => $ARGSRef->{$key}
1459             );
1460             push @results, $msg;
1461         }
1462
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;
1469
1470                 my ( $code, $msg ) = $Ticket->AddWatcher(
1471                     Type        => $value,
1472                     PrincipalId => $principal_id
1473                 );
1474                 push @results, $msg;
1475             }
1476         }
1477
1478     }
1479     return (@results);
1480 }
1481
1482 # }}}
1483
1484 # {{{ sub ProcessTicketDates
1485
1486 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1487
1488 Returns an array of results messages.
1489
1490 =cut
1491
1492 sub ProcessTicketDates {
1493     my %args = (
1494         TicketObj => undef,
1495         ARGSRef   => undef,
1496         @_
1497     );
1498
1499     my $Ticket  = $args{'TicketObj'};
1500     my $ARGSRef = $args{'ARGSRef'};
1501
1502     my (@results);
1503
1504     # {{{ Set date fields
1505     my @date_fields = qw(
1506       Told
1507       Resolved
1508       Starts
1509       Started
1510       Due
1511     );
1512
1513     #Run through each field in this list. update the value if apropriate
1514     foreach my $field (@date_fields) {
1515         my ( $code, $msg );
1516
1517         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1518
1519         #If it's something other than just whitespace
1520         if ( $ARGSRef->{ $field . '_Date' } && ($ARGSRef->{ $field . '_Date' } ne '') ) {
1521             $DateObj->Set(
1522                 Format => 'unknown',
1523                 Value  => $ARGSRef->{ $field . '_Date' }
1524             );
1525             my $obj = $field . "Obj";
1526             if ( ( defined $DateObj->Unix )
1527                 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1528             {
1529                 my $method = "Set$field";
1530                 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1531                 push @results, "$msg";
1532             }
1533         }
1534     }
1535
1536     # }}}
1537     return (@results);
1538 }
1539
1540 # }}}
1541
1542 # {{{ sub ProcessTicketLinks
1543
1544 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1545
1546 Returns an array of results messages.
1547
1548 =cut
1549
1550 sub ProcessTicketLinks {
1551     my %args = ( TicketObj => undef,
1552                  ARGSRef   => undef,
1553                  @_ );
1554
1555     my $Ticket  = $args{'TicketObj'};
1556     my $ARGSRef = $args{'ARGSRef'};
1557
1558
1559     my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1560                                        ARGSRef => $ARGSRef);
1561
1562     #Merge if we need to
1563     if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1564         my ( $val, $msg ) =
1565           $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1566         push @results, $msg;
1567     }
1568
1569     return (@results);
1570 }
1571
1572 # }}}
1573
1574 sub ProcessRecordLinks {
1575     my %args = ( RecordObj => undef,
1576                  ARGSRef   => undef,
1577                  @_ );
1578
1579     my $Record  = $args{'RecordObj'};
1580     my $ARGSRef = $args{'ARGSRef'};
1581
1582     my (@results);
1583
1584     # Delete links that are gone gone gone.
1585     foreach my $arg ( keys %$ARGSRef ) {
1586         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1587             my $base   = $1;
1588             my $type   = $2;
1589             my $target = $3;
1590
1591             push @results,
1592               "Trying to delete: Base: $base Target: $target  Type $type";
1593             my ( $val, $msg ) = $Record->DeleteLink( Base   => $base,
1594                                                      Type   => $type,
1595                                                      Target => $target );
1596
1597             push @results, $msg;
1598
1599         }
1600
1601     }
1602
1603     my @linktypes = qw( DependsOn MemberOf RefersTo );
1604
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;
1612             }
1613         }
1614         if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1615
1616             for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1617                 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1618                                                       Type => $linktype );
1619
1620                 push @results, $msg;
1621             }
1622         }
1623     }
1624
1625     return (@results);
1626 }
1627
1628
1629 =head2 _UploadedFile ( $arg );
1630
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 )>.
1634
1635 Returns C<undef> if no files were uploaded in the C<$arg> field.
1636
1637 =cut
1638
1639 sub _UploadedFile {
1640     my $arg = shift;
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);
1644
1645     my $filename = "$fh";
1646     $filename =~ s#^.*[\\/]##;
1647     binmode($fh);
1648
1649     return {
1650         Value => $filename,
1651         LargeContent => do { local $/; scalar <$fh> },
1652         ContentType => $upload_info->{'Content-Type'},
1653     };
1654 }
1655
1656 =head2 _load_container_object ( $type, $id );
1657
1658 Instantiate container object for saving searches.
1659
1660 =cut
1661
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);
1665 }
1666
1667 =head2 _parse_saved_search ( $arg );
1668
1669 Given a serialization string for saved search, and returns the
1670 container object and the search id.
1671
1672 =cut
1673
1674 sub _parse_saved_search {
1675     my $spec = shift;
1676     return unless $spec;
1677     if ($spec  !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) {
1678         return;
1679     }
1680     my $obj_type  = $1;
1681     my $obj_id    = $2;
1682     my $search_id = $3;
1683
1684     return (_load_container_object ($obj_type, $obj_id), $search_id);
1685 }
1686
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});
1691
1692 1;