rt/lib/RT/Interface/Web.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2007 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/copyleft/gpl.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     $user_info{'Privileged'} = 1;
 157
 158     if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
 159         # Populate fields with information from Unix /etc/passwd
 160
 161         my ($comments, $realname) = (getpwnam($user))[5, 6];
 162         $user_info{'Comments'} = $comments if defined $comments;
 163         $user_info{'RealName'} = $realname if defined $realname;
 164     }
 165     elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
 166         # Populate fields with information from NT domain controller
 167     }
 168
 169     # and return the wad of stuff
 170     return {%user_info};
 171 }
 172
 173 # }}}
 174
 175
 176
 177 =head2 Redirect URL
 178
 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.
 183
 184 =cut
 185
 186
 187 sub Redirect {
 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);
 192
 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'});
 200         }
 201
 202     $HTML::Mason::Commands::m->redirect($uri->canonical);
 203     $HTML::Mason::Commands::m->abort;
 204 }
 205
 206
 207 =head2 StaticFileHeaders
 208
 209 Send the browser a few headers to try to get it to (somewhat agressively)
 210 cache RT's static Javascript and CSS files.
 211
 212 This routine could really use _accurate_ heuristics. (XXX TODO)
 213
 214 =cut
 215
 216 sub StaticFileHeaders {
 217     # make cache public
 218     $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
 219
 220     # Expire things in a month.
 221     $HTML::Mason::Commands::r->headers_out->{'Expires'} = HTTP::Date::time2str( time() + 2592000 );
 222
 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);
 227
 228 }
 229
 230
 231 package HTML::Mason::Commands;
 232 use vars qw/$r $m %session/;
 233
 234
 235 # {{{ loc
 236
 237 =head2 loc ARRAY
 238
 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
 242 through
 243
 244 =cut
 245
 246 sub loc {
 247
 248     if ($session{'CurrentUser'} &&
 249         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 250         return($session{'CurrentUser'}->loc(@_));
 251     }
 252     elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
 253         return ($u->loc(@_));
 254     }
 255     else {
 256         # pathetic case -- SystemUser is gone.
 257         return $_[0];
 258     }
 259 }
 260
 261 # }}}
 262
 263
 264 # {{{ loc_fuzzy
 265
 266 =head2 loc_fuzzy STRING
 267
 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.
 273
 274 =cut
 275
 276 sub loc_fuzzy {
 277     my $msg  = shift;
 278
 279     if ($session{'CurrentUser'} &&
 280         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 281         return($session{'CurrentUser'}->loc_fuzzy($msg));
 282     }
 283     else  {
 284         my $u = RT::CurrentUser->new($RT::SystemUser->Id);
 285         return ($u->loc_fuzzy($msg));
 286     }
 287 }
 288
 289 # }}}
 290
 291
 292 # {{{ sub Abort
 293 # Error - calls Error and aborts
 294 sub Abort {
 295
 296     if ($session{'ErrorDocument'} &&
 297         $session{'ErrorDocumentType'}) {
 298         $r->content_type($session{'ErrorDocumentType'});
 299         $m->comp($session{'ErrorDocument'} , Why => shift);
 300         $m->abort;
 301     }
 302     else  {
 303         $m->comp("/Elements/Error" , Why => shift);
 304         $m->abort;
 305     }
 306 }
 307
 308 # }}}
 309
 310 # {{{ sub CreateTicket
 311
 312 =head2 CreateTicket ARGS
 313
 314 Create a new ticket, using Mason's %ARGS.  returns @results.
 315
 316 =cut
 317
 318 sub CreateTicket {
 319     my %ARGS = (@_);
 320
 321     my (@Actions);
 322
 323     my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
 324
 325     my $Queue = new RT::Queue( $session{'CurrentUser'} );
 326     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
 327         Abort('Queue not found');
 328     }
 329
 330     unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
 331         Abort('You have no permission to create tickets in that queue.');
 332     }
 333
 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'} );
 338
 339     my $MIMEObj = MakeMIMEEntity(
 340         Subject             => $ARGS{'Subject'},
 341         From                => $ARGS{'From'},
 342         Cc                  => $ARGS{'Cc'},
 343         Body                => $ARGS{'Content'},
 344         Type                => $ARGS{'ContentType'},
 345     );
 346
 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)$/;
 351
 352         foreach ( values %{$ARGS{'Attachments'}} ) {
 353             unless ( $_ ) {
 354                 $RT::Logger->error("Couldn't add empty attachemnt");
 355                 next;
 356             }
 357             $MIMEObj->add_part($_);
 358         }
 359     }
 360
 361     my %create_args = (
 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'},
 372         Due             => $due->ISO,
 373         Starts          => $starts->ISO,
 374         MIMEObj         => $MIMEObj
 375     );
 376
 377     my @temp_squelch;
 378     foreach my $type (qw(Requestors Cc AdminCc)) {
 379         my @tmp = map { $_->format } grep { $_->address} Mail::Address->parse( $ARGS{ $type } );
 380
 381         $create_args{ $type } = [
 382             grep $_, map {
 383                 my $user = RT::User->new( $RT::SystemUser );
 384                 $user->LoadOrCreateByEmail( $_ );
 385                 # convert to ids to avoid work later
 386                 $user->id;
 387             } @tmp
 388         ];
 389         $RT::Logger->debug(
 390             "$type got ".join(',',@{$create_args{ $type }}) );
 391
 392     }
 393     # XXX: workaround for name conflict :(
 394     $create_args{'Requestor'} = delete $create_args{'Requestors'};
 395
 396     foreach my $arg (keys %ARGS) {
 397         next if $arg =~ /-(?:Magic|Category)$/;
 398
 399         if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
 400             $create_args{$arg} = $ARGS{$arg};
 401         }
 402         # Object-RT::Ticket--CustomField-3-Values
 403         elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
 404             my $cfid = $1;
 405             my $cf = RT::CustomField->new( $session{'CurrentUser'});
 406             $cf->Load($cfid);
 407
 408             if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
 409                 $ARGS{$arg} =~ s/\r\n/\n/g;
 410                 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
 411             }
 412
 413             if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
 414                 $ARGS{$arg} =~ s/\r//g;
 415             }
 416
 417             if ( $arg =~ /-Upload$/ ) {
 418                 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
 419             }
 420             else {
 421                 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
 422             }
 423         }
 424     }
 425
 426
 427     # XXX TODO This code should be about six lines. and badly needs refactoring.
 428
 429     # {{{ turn new link lists into arrays, and pass in the proper arguments
 430     my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
 431
 432     foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
 433         $luri =~ s/\s*$//;    # Strip trailing whitespace
 434         push @dependson, $luri;
 435     }
 436     $create_args{'DependsOn'} = \@dependson;
 437
 438     foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
 439         push @dependedonby, $luri;
 440     }
 441     $create_args{'DependedOnBy'} = \@dependedonby;
 442
 443     foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
 444         $luri =~ s/\s*$//;    # Strip trailing whitespace
 445         push @parents, $luri;
 446     }
 447     $create_args{'Parents'} = \@parents;
 448
 449     foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
 450         push @children, $luri;
 451     }
 452     $create_args{'Children'} = \@children;
 453
 454     foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
 455         $luri =~ s/\s*$//;    # Strip trailing whitespace
 456         push @refersto, $luri;
 457     }
 458     $create_args{'RefersTo'} = \@refersto;
 459
 460     foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
 461         push @referredtoby, $luri;
 462     }
 463     $create_args{'ReferredToBy'} = \@referredtoby;
 464     # }}}
 465
 466
 467     my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
 468     unless ( $id ) {
 469         Abort($ErrMsg);
 470     }
 471
 472     push ( @Actions, split("\n", $ErrMsg) );
 473     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
 474         Abort( "No permission to view newly created ticket #"
 475             . $Ticket->id . "." );
 476     }
 477     return ( $Ticket, @Actions );
 478
 479 }
 480
 481 # }}}
 482
 483 # {{{ sub LoadTicket - loads a ticket
 484
 485 =head2  LoadTicket id
 486
 487 Takes a ticket id as its only variable. if it's handed an array, it takes
 488 the first value.
 489
 490 Returns an RT::Ticket object as the current user.
 491
 492 =cut
 493
 494 sub LoadTicket {
 495     my $id = shift;
 496
 497     if ( ref($id) eq "ARRAY" ) {
 498         $id = $id->[0];
 499     }
 500
 501     unless ($id) {
 502         Abort("No ticket specified");
 503     }
 504
 505     my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 506     $Ticket->Load($id);
 507     unless ( $Ticket->id ) {
 508         Abort("Could not load ticket $id");
 509     }
 510     return $Ticket;
 511 }
 512
 513 # }}}
 514
 515 # {{{ sub ProcessUpdateMessage
 516
 517 sub ProcessUpdateMessage {
 518
 519     #TODO document what else this takes.
 520     my %args = (
 521         ARGSRef   => undef,
 522         Actions   => undef,
 523         TicketObj => undef,
 524         @_
 525     );
 526
 527     #Make the update content have no 'weird' newlines in it
 528     if (   $args{ARGSRef}->{'UpdateTimeWorked'}
 529         || $args{ARGSRef}->{'UpdateContent'}
 530         || $args{ARGSRef}->{'UpdateAttachments'} )
 531     {
 532
 533         if (
 534             $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
 535         {
 536             $args{ARGSRef}->{'UpdateSubject'} = undef;
 537         }
 538
 539         my $Message = MakeMIMEEntity(
 540             Subject => $args{ARGSRef}->{'UpdateSubject'},
 541             Body    => $args{ARGSRef}->{'UpdateContent'},
 542             Type    => $args{ARGSRef}->{'UpdateContentType'},
 543         );
 544
 545         $Message->head->add( 'Message-ID' =>
 546               "<rt-"
 547               . $RT::VERSION . "-"
 548               . $$ . "-"
 549               . CORE::time() . "-"
 550               . int(rand(2000)) . "."
 551               . $args{'TicketObj'}->id . "-"
 552               . "0" . "-"  # Scrip
 553               . "0" . "@"  # Email sent
 554               . $RT::Organization
 555               . ">" );
 556         my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
 557         if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
 558             $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
 559         }
 560         else {
 561             $old_txn = $args{TicketObj}->Transactions->First();
 562         }
 563
 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') || '');
 569
 570             $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
 571             $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
 572         }
 573
 574     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
 575         $Message->make_multipart;
 576         $Message->add_part($_)
 577           foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
 578     }
 579
 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'},
 585             MIMEObj      => $Message,
 586             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 587         );
 588         push( @{ $args{Actions} }, $Description );
 589         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 590     }
 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'},
 596             MIMEObj      => $Message,
 597             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 598           );
 599         push( @{ $args{Actions} }, $Description );
 600         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 601     }
 602     else {
 603         push(
 604             @{ $args{'Actions'} },
 605             loc("Update type was neither correspondence nor comment.") . " "
 606               . loc("Update not recorded.")
 607         );
 608     }
 609 }
 610 }
 611
 612 # }}}
 613
 614 # {{{ sub MakeMIMEEntity
 615
 616 =head2 MakeMIMEEntity PARAMHASH
 617
 618 Takes a paramhash Subject, Body and AttachmentFieldName.
 619
 620 Also takes Form, Cc and Type as optional paramhash keys.
 621
 622   Returns a MIME::Entity.
 623
 624 =cut
 625
 626 sub MakeMIMEEntity {
 627
 628     #TODO document what else this takes.
 629     my %args = (
 630         Subject             => undef,
 631         From                => undef,
 632         Cc                  => undef,
 633         Body                => undef,
 634         AttachmentFieldName => undef,
 635         Type                => undef,
 636 #        map Encode::encode_utf8($_), @_,
 637         @_,
 638     );
 639
 640     #Make the update content have no 'weird' newlines in it
 641
 642     $args{'Body'} =~ s/\r\n/\n/gs if $args{'Body'};
 643     my $Message;
 644     {
 645         # MIME::Head is not happy in utf-8 domain.  This only happens
 646         # when processing an incoming email (so far observed).
 647         no utf8;
 648         use bytes;
 649         $Message = MIME::Entity->build(
 650             Subject => $args{'Subject'} || "",
 651             From    => $args{'From'},
 652             Cc      => $args{'Cc'},
 653             Type    => $args{'Type'} || 'text/plain',
 654             'Charset:' => 'utf8',
 655             Data    => [ $args{'Body'} ]
 656         );
 657     }
 658
 659     my $cgi_object = $m->cgi_object;
 660
 661     if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
 662
 663
 664
 665     use File::Temp qw(tempfile tempdir);
 666
 667     #foreach my $filehandle (@filenames) {
 668
 669     my ( $fh, $temp_file );
 670     for ( 1 .. 10 ) {
 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) };
 675         sleep 1;
 676     }
 677
 678     binmode $fh;    #thank you, windows
 679     my ($buffer);
 680     while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
 681         print $fh $buffer;
 682     }
 683
 684     my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 685
 686     # Prefer the cached name first over CGI.pm stringification.
 687     my $filename = $RT::Mason::CGI::Filename;
 688     $filename = "$filehandle" unless defined($filename);
 689
 690     $filename =~ s#^.*[\\/]##;
 691
 692     $Message->attach(
 693         Path     => $temp_file,
 694         Filename => Encode::decode_utf8($filename),
 695         Type     => $uploadinfo->{'Content-Type'},
 696     );
 697     close($fh);
 698
 699     #   }
 700
 701     }
 702
 703     $Message->make_singlepart();
 704     RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
 705
 706     return ($Message);
 707
 708 }
 709
 710 # }}}
 711
 712 # {{{ sub ProcessSearchQuery
 713
 714 =head2 ProcessSearchQuery
 715
 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.
 717
 718 TODO Doc exactly what comes in the paramhash
 719
 720
 721 =cut
 722
 723 sub ProcessSearchQuery {
 724     my %args = @_;
 725
 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}->{...} ? :)
 729
 730     #Searches are sticky.
 731     if ( defined $session{'tickets'} ) {
 732
 733         # Reset the old search
 734         $session{'tickets'}->GotoFirstItem;
 735     }
 736     else {
 737
 738         # Init a new search
 739         $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
 740     }
 741
 742     #Import a bookmarked search if we have one
 743     if ( defined $args{ARGS}->{'Bookmark'} ) {
 744         $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
 745     }
 746
 747     # {{{ Goto next/prev page
 748     if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
 749         $session{'tickets'}->NextPage;
 750     }
 751     elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
 752         $session{'tickets'}->PrevPage;
 753     }
 754     elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
 755         $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
 756     }
 757
 758     # }}}
 759
 760     # {{{ Deal with limiting the search
 761
 762     if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
 763         $session{'tickets_refresh_interval'} =
 764           $args{ARGS}->{'RefreshSearchInterval'};
 765     }
 766
 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'}
 773         );
 774     }
 775
 776     # }}}
 777
 778     # {{{ Set the query limit
 779     if ( defined $args{ARGS}->{'RowsPerPage'} ) {
 780         $RT::Logger->debug(
 781             "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
 782
 783         $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
 784         $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
 785     }
 786
 787     # }}}
 788     # {{{ Limit priority
 789     if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
 790         $session{'tickets'}->LimitPriority(
 791             VALUE    => $args{ARGS}->{'ValueOfPriority'},
 792             OPERATOR => $args{ARGS}->{'PriorityOp'}
 793         );
 794     }
 795
 796     # }}}
 797     # {{{ Limit owner
 798     if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
 799         $session{'tickets'}->LimitOwner(
 800             VALUE    => $args{ARGS}->{'ValueOfOwner'},
 801             OPERATOR => $args{ARGS}->{'OwnerOp'}
 802         );
 803     }
 804
 805     # }}}
 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'},
 812
 813         );
 814     }
 815
 816     # }}}
 817     # {{{ Limit Queue
 818     if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
 819         $session{'tickets'}->LimitQueue(
 820             VALUE    => $args{ARGS}->{'ValueOfQueue'},
 821             OPERATOR => $args{ARGS}->{'QueueOp'}
 822         );
 823     }
 824
 825     # }}}
 826     # {{{ Limit Status
 827     if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
 828         if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
 829             foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
 830                 $session{'tickets'}->LimitStatus(
 831                     VALUE    => $value,
 832                     OPERATOR => $args{ARGS}->{'StatusOp'},
 833                 );
 834             }
 835         }
 836         else {
 837             $session{'tickets'}->LimitStatus(
 838                 VALUE    => $args{ARGS}->{'ValueOfStatus'},
 839                 OPERATOR => $args{ARGS}->{'StatusOp'},
 840             );
 841         }
 842
 843     }
 844
 845     # }}}
 846     # {{{ Limit Subject
 847     if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
 848             my $val = $args{ARGS}->{'ValueOfSubject'};
 849         if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
 850             $val = "%".$val."%";
 851         }
 852         $session{'tickets'}->LimitSubject(
 853             VALUE    => $val,
 854             OPERATOR => $args{ARGS}->{'SubjectOp'},
 855         );
 856     }
 857
 858     # }}}
 859     # {{{ Limit Dates
 860     if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
 861         my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
 862         $args{ARGS}->{'DateType'} =~ s/_Date$//;
 863
 864         if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
 865             $session{'tickets'}->LimitTransactionDate(
 866                                             VALUE    => $date,
 867                                             OPERATOR => $args{ARGS}->{'DateOp'},
 868             );
 869         }
 870         else {
 871             $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
 872                                             VALUE => $date,
 873                                             OPERATOR => $args{ARGS}->{'DateOp'},
 874             );
 875         }
 876     }
 877
 878     # }}}
 879     # {{{ Limit Content
 880     if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
 881         my $val = $args{ARGS}->{'ValueOfAttachmentField'};
 882         if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
 883             $val = "%".$val."%";
 884         }
 885         $session{'tickets'}->Limit(
 886             FIELD   => $args{ARGS}->{'AttachmentField'},
 887             VALUE    => $val,
 888             OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
 889         );
 890     }
 891
 892     # }}}
 893
 894  # {{{ Limit CustomFields
 895
 896     foreach my $arg ( keys %{ $args{ARGS} } ) {
 897         my $id;
 898         if ( $arg =~ /^CustomField(\d+)$/ ) {
 899             $id = $1;
 900         }
 901         else {
 902             next;
 903         }
 904         next unless ( $args{ARGS}->{$arg} );
 905
 906         my $form = $args{ARGS}->{$arg};
 907         my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
 908         foreach my $value ( ref($form) ? @{$form} : ($form) ) {
 909             my $quote = 1;
 910             if ($oper =~ /like/i) {
 911                 $value = "%".$value."%";
 912             }
 913             if ( $value =~ /^null$/i ) {
 914
 915                 #Don't quote the string 'null'
 916                 $quote = 0;
 917
 918                 # Convert the operator to something apropriate for nulls
 919                 $oper = 'IS'     if ( $oper eq '=' );
 920                 $oper = 'IS NOT' if ( $oper eq '!=' );
 921             }
 922             $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
 923                                                    OPERATOR    => $oper,
 924                                                    QUOTEVALUE  => $quote,
 925                                                    VALUE       => $value );
 926         }
 927     }
 928
 929     # }}}
 930
 931
 932 }
 933
 934 # }}}
 935
 936 # {{{ sub ParseDateToISO
 937
 938 =head2 ParseDateToISO
 939
 940 Takes a date in an arbitrary format.
 941 Returns an ISO date and time in GMT
 942
 943 =cut
 944
 945 sub ParseDateToISO {
 946     my $date = shift;
 947
 948     my $date_obj = RT::Date->new($session{'CurrentUser'});
 949     $date_obj->Set(
 950         Format => 'unknown',
 951         Value  => $date
 952     );
 953     return ( $date_obj->ISO );
 954 }
 955
 956 # }}}
 957
 958 # {{{ sub ProcessACLChanges
 959
 960 sub ProcessACLChanges {
 961     my $ARGSref = shift;
 962
 963     my %ARGS     = %$ARGSref;
 964
 965     my ( $ACL, @results );
 966
 967
 968     foreach my $arg (keys %ARGS) {
 969         if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
 970             my $principal_id = $1;
 971             my $object_type = $2;
 972             my $object_id = $3;
 973             my $rights = $ARGS{$arg};
 974
 975             my $principal = RT::Principal->new($session{'CurrentUser'});
 976             $principal->Load($principal_id);
 977
 978             my $obj;
 979
 980              if ($object_type eq 'RT::System') {
 981                 $obj = $RT::System;
 982             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
 983                 $obj = $object_type->new($session{'CurrentUser'});
 984                 $obj->Load($object_id);
 985             } else {
 986                 push (@results, loc("System Error"). ': '.
 987                                 loc("Rights could not be granted for [_1]", $object_type));
 988                 next;
 989             }
 990
 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);
 996             }
 997         }
 998        elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
 999             my $principal_id = $1;
1000             my $object_type = $2;
1001             my $object_id = $3;
1002             my $right = $4;
1003
1004             my $principal = RT::Principal->new($session{'CurrentUser'});
1005             $principal->Load($principal_id);
1006             next unless ($right);
1007             my $obj;
1008
1009              if ($object_type eq 'RT::System') {
1010                 $obj = $RT::System;
1011             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
1012                 $obj = $object_type->new($session{'CurrentUser'});
1013                 $obj->Load($object_id);
1014             } else {
1015                 push (@results, loc("System Error"). ': '.
1016                                 loc("Rights could not be revoked for [_1]", $object_type));
1017                 next;
1018             }
1019             my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
1020             push (@results, $msg);
1021         }
1022
1023
1024     }
1025
1026     return (@results);
1027
1028     }
1029
1030 # }}}
1031
1032 # {{{ sub UpdateRecordObj
1033
1034 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
1035
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.
1037
1038 Returns an array of success/failure messages
1039
1040 =cut
1041
1042 sub UpdateRecordObject {
1043     my %args = (
1044         ARGSRef       => undef,
1045         AttributesRef => undef,
1046         Object        => undef,
1047         AttributePrefix => undef,
1048         @_
1049     );
1050
1051     my $Object = $args{'Object'};
1052     my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
1053                                   ARGSRef       => $args{'ARGSRef'},
1054                   AttributePrefix => $args{'AttributePrefix'}
1055                                   );
1056
1057     return (@results);
1058 }
1059
1060 # }}}
1061
1062 # {{{ Sub ProcessCustomFieldUpdates
1063
1064 sub ProcessCustomFieldUpdates {
1065     my %args = (
1066         CustomFieldObj => undef,
1067         ARGSRef        => undef,
1068         @_
1069     );
1070
1071     my $Object  = $args{'CustomFieldObj'};
1072     my $ARGSRef = $args{'ARGSRef'};
1073
1074     my @attribs = qw( Name Type Description Queue SortOrder);
1075     my @results = UpdateRecordObject(
1076         AttributesRef => \@attribs,
1077         Object        => $Object,
1078         ARGSRef       => $ARGSRef
1079     );
1080
1081     if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
1082
1083         my ( $addval, $addmsg ) = $Object->AddValue(
1084             Name =>
1085               $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1086             Description => $ARGSRef->{ "CustomField-"
1087                   . $Object->Id
1088                   . "-AddValue-Description" },
1089             SortOrder => $ARGSRef->{ "CustomField-"
1090                   . $Object->Id
1091                   . "-AddValue-SortOrder" },
1092         );
1093         push ( @results, $addmsg );
1094     }
1095     my @delete_values = (
1096         ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1097           'ARRAY' )
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 );
1104     }
1105
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 );
1112             }
1113         }
1114     }
1115
1116     return (@results);
1117 }
1118
1119 # }}}
1120
1121 # {{{ sub ProcessTicketBasics
1122
1123 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1124
1125 Returns an array of results messages.
1126
1127 =cut
1128
1129 sub ProcessTicketBasics {
1130
1131     my %args = (
1132         TicketObj => undef,
1133         ARGSRef   => undef,
1134         @_
1135     );
1136
1137     my $TicketObj = $args{'TicketObj'};
1138     my $ARGSRef   = $args{'ARGSRef'};
1139
1140     # {{{ Set basic fields
1141     my @attribs = qw(
1142       Subject
1143       FinalPriority
1144       Priority
1145       TimeEstimated
1146       TimeWorked
1147       TimeLeft
1148       Type
1149       Status
1150       Queue
1151     );
1152
1153
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();
1159         }
1160     }
1161
1162
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'});
1166
1167     my @results = UpdateRecordObject(
1168         AttributesRef => \@attribs,
1169         Object        => $TicketObj,
1170         ARGSRef       => $ARGSRef
1171     );
1172
1173     # We special case owner changing, so we can use ForceOwnerChange
1174     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1175         my ($ChownType);
1176         if ( $ARGSRef->{'ForceOwnerChange'} ) {
1177             $ChownType = "Force";
1178         }
1179         else {
1180             $ChownType = "Give";
1181         }
1182
1183         my ( $val, $msg ) =
1184           $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1185         push ( @results, $msg );
1186     }
1187
1188     # }}}
1189
1190     return (@results);
1191 }
1192
1193 # }}}
1194
1195 sub ProcessTicketCustomFieldUpdates {
1196     my %args = @_;
1197     $args{'Object'} = delete $args{'TicketObj'};
1198     my $ARGSRef = { %{ $args{'ARGSRef'} } };
1199
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};
1205         }
1206         elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1207             $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1208         }
1209     }
1210
1211     return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1212 }
1213
1214 sub ProcessObjectCustomFieldUpdates {
1215     my %args = @_;
1216     my $ARGSRef = $args{'ARGSRef'};
1217     my @results;
1218
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+)-(.*)$/;
1224
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 };
1227     }
1228
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;
1235
1236             $Object->Load( $id ) unless ($Object->id || 0) == $id;
1237             unless ( $Object->id ) {
1238                 $RT::Logger->warning("Couldn't load object $class #$id");
1239                 next;
1240             }
1241
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");
1247                     next;
1248                 }
1249                 push @results, _ProcessObjectCustomFieldUpdates(
1250                     Prefix      => "Object-$class-$id-CustomField-$cf-",
1251                     Object      => $Object,
1252                     CustomField => $CustomFieldObj,
1253                     ARGS        => $custom_fields_to_mod{$class}{$id}{$cf},
1254                 );
1255             }
1256         }
1257     }
1258     return @results;
1259 }
1260
1261 sub _ProcessObjectCustomFieldUpdates {
1262     my %args = @_;
1263     my $cf = $args{'CustomField'};
1264     my $cf_type = $cf->Type;
1265
1266     my @results;
1267     foreach my $arg ( keys %{ $args{'ARGS'} } ) {
1268
1269         next if $arg =~ /Category$/;
1270
1271         # since http won't pass in a form element with a null value, we need
1272         # to fake it
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'};
1276
1277             # "Empty" values does not mean anything for Image and Binary fields
1278             next if $cf_type =~ /^(?:Image|Binary)$/;
1279
1280             $arg = 'Values';
1281             $args{'ARGS'}->{'Values'} = undef;
1282         }
1283
1284         my @values = ();
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 };
1291         }
1292
1293         if ( ( $cf_type eq 'Freeform' && !$cf->SingleValue ) || $cf_type =~ /text/i ) {
1294             s/\r//g foreach @values;
1295         }
1296         @values = grep defined && $_ ne '', @values;
1297
1298         if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
1299             foreach my $value (@values) {
1300                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1301                     Field => $cf->id,
1302                     Value => $value
1303                 );
1304                 push ( @results, $msg );
1305             }
1306         }
1307         elsif ( $arg eq 'Upload' ) {
1308             my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
1309             my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1310                 %$value_hash,
1311                 Field => $cf,
1312             );
1313             push ( @results, $msg );
1314         }
1315         elsif ( $arg eq 'DeleteValues' ) {
1316             foreach my $value ( @values ) {
1317                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1318                     Field => $cf,
1319                     Value => $value,
1320                 );
1321                 push ( @results, $msg );
1322             }
1323         }
1324         elsif ( $arg eq 'DeleteValueIds' ) {
1325             foreach my $value ( @values ) {
1326                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1327                     Field   => $cf,
1328                     ValueId => $value,
1329                 );
1330                 push ( @results, $msg );
1331             }
1332         }
1333         elsif ( $arg eq 'Values' && !$cf->Repeated ) {
1334             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1335
1336             my %values_hash;
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 );
1341
1342                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1343                     Field => $cf,
1344                     Value => $value
1345                 );
1346                 push ( @results, $msg );
1347             }
1348
1349             $cf_values->RedoSearch;
1350             while ( my $cf_value = $cf_values->Next ) {
1351                 next if $values_hash{ $cf_value->Content };
1352
1353                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1354                     Field => $cf,
1355                     Value => $cf_value->Content
1356                 );
1357                 push ( @results, $msg);
1358             }
1359         }
1360         elsif ( $arg eq 'Values' ) {
1361             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1362
1363             # keep everything up to the point of difference, delete the rest
1364             my $delete_flag;
1365             foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1366                 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1367                     shift @values;
1368                     next;
1369                 }
1370
1371                 $delete_flag ||= 1;
1372                 $old_cf->Delete;
1373             }
1374
1375             # now add/replace extra things, if any
1376             foreach my $value ( @values ) {
1377                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1378                     Field => $cf,
1379                     Value => $value
1380                 );
1381                 push ( @results, $msg );
1382             }
1383         }
1384         else {
1385             push ( @results,
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 )
1388             );
1389         }
1390     }
1391     return @results;
1392 }
1393
1394 # {{{ sub ProcessTicketWatchers
1395
1396 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1397
1398 Returns an array of results messages.
1399
1400 =cut
1401
1402 sub ProcessTicketWatchers {
1403     my %args = (
1404         TicketObj => undef,
1405         ARGSRef   => undef,
1406         @_
1407     );
1408     my (@results);
1409
1410     my $Ticket  = $args{'TicketObj'};
1411     my $ARGSRef = $args{'ARGSRef'};
1412
1413     # Munge watchers
1414
1415     foreach my $key ( keys %$ARGSRef ) {
1416
1417         # Delete deletable watchers
1418         if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) )
1419         {
1420             my ( $code, $msg ) = $Ticket->DeleteWatcher(
1421                 PrincipalId => $2,
1422                 Type        => $1
1423             );
1424             push @results, $msg;
1425         }
1426
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},
1431                 Type  => $1
1432             );
1433             push @results, $msg;
1434         }
1435
1436         # Add new wathchers by email address
1437         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1438             and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1439         {
1440
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 }
1445             );
1446             push @results, $msg;
1447         }
1448
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(
1452                 Type  => $1,
1453                 Email => $ARGSRef->{$key}
1454             );
1455             push @results, $msg;
1456         }
1457
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;
1464
1465                 my ( $code, $msg ) = $Ticket->AddWatcher(
1466                     Type        => $value,
1467                     PrincipalId => $principal_id
1468                 );
1469                 push @results, $msg;
1470             }
1471         }
1472
1473     }
1474     return (@results);
1475 }
1476
1477 # }}}
1478
1479 # {{{ sub ProcessTicketDates
1480
1481 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1482
1483 Returns an array of results messages.
1484
1485 =cut
1486
1487 sub ProcessTicketDates {
1488     my %args = (
1489         TicketObj => undef,
1490         ARGSRef   => undef,
1491         @_
1492     );
1493
1494     my $Ticket  = $args{'TicketObj'};
1495     my $ARGSRef = $args{'ARGSRef'};
1496
1497     my (@results);
1498
1499     # {{{ Set date fields
1500     my @date_fields = qw(
1501       Told
1502       Resolved
1503       Starts
1504       Started
1505       Due
1506     );
1507
1508     #Run through each field in this list. update the value if apropriate
1509     foreach my $field (@date_fields) {
1510         my ( $code, $msg );
1511
1512         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1513
1514         #If it's something other than just whitespace
1515         if ( $ARGSRef->{ $field . '_Date' } && ($ARGSRef->{ $field . '_Date' } ne '') ) {
1516             $DateObj->Set(
1517                 Format => 'unknown',
1518                 Value  => $ARGSRef->{ $field . '_Date' }
1519             );
1520             my $obj = $field . "Obj";
1521             if ( ( defined $DateObj->Unix )
1522                 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1523             {
1524                 my $method = "Set$field";
1525                 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1526                 push @results, "$msg";
1527             }
1528         }
1529     }
1530
1531     # }}}
1532     return (@results);
1533 }
1534
1535 # }}}
1536
1537 # {{{ sub ProcessTicketLinks
1538
1539 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1540
1541 Returns an array of results messages.
1542
1543 =cut
1544
1545 sub ProcessTicketLinks {
1546     my %args = ( TicketObj => undef,
1547                  ARGSRef   => undef,
1548                  @_ );
1549
1550     my $Ticket  = $args{'TicketObj'};
1551     my $ARGSRef = $args{'ARGSRef'};
1552
1553
1554     my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1555                                        ARGSRef => $ARGSRef);
1556
1557     #Merge if we need to
1558     if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1559         my ( $val, $msg ) =
1560           $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1561         push @results, $msg;
1562     }
1563
1564     return (@results);
1565 }
1566
1567 # }}}
1568
1569 sub ProcessRecordLinks {
1570     my %args = ( RecordObj => undef,
1571                  ARGSRef   => undef,
1572                  @_ );
1573
1574     my $Record  = $args{'RecordObj'};
1575     my $ARGSRef = $args{'ARGSRef'};
1576
1577     my (@results);
1578
1579     # Delete links that are gone gone gone.
1580     foreach my $arg ( keys %$ARGSRef ) {
1581         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1582             my $base   = $1;
1583             my $type   = $2;
1584             my $target = $3;
1585
1586             push @results,
1587               "Trying to delete: Base: $base Target: $target  Type $type";
1588             my ( $val, $msg ) = $Record->DeleteLink( Base   => $base,
1589                                                      Type   => $type,
1590                                                      Target => $target );
1591
1592             push @results, $msg;
1593
1594         }
1595
1596     }
1597
1598     my @linktypes = qw( DependsOn MemberOf RefersTo );
1599
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;
1607             }
1608         }
1609         if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1610
1611             for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1612                 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1613                                                       Type => $linktype );
1614
1615                 push @results, $msg;
1616             }
1617         }
1618     }
1619
1620     return (@results);
1621 }
1622
1623
1624 =head2 _UploadedFile ( $arg );
1625
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 )>.
1629
1630 Returns C<undef> if no files were uploaded in the C<$arg> field.
1631
1632 =cut
1633
1634 sub _UploadedFile {
1635     my $arg = shift;
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);
1639
1640     my $filename = "$fh";
1641     $filename =~ s#^.*[\\/]##;
1642     binmode($fh);
1643
1644     return {
1645         Value => $filename,
1646         LargeContent => do { local $/; scalar <$fh> },
1647         ContentType => $upload_info->{'Content-Type'},
1648     };
1649 }
1650
1651 =head2 _load_container_object ( $type, $id );
1652
1653 Instantiate container object for saving searches.
1654
1655 =cut
1656
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);
1660 }
1661
1662 =head2 _parse_saved_search ( $arg );
1663
1664 Given a serialization string for saved search, and returns the
1665 container object and the search id.
1666
1667 =cut
1668
1669 sub _parse_saved_search {
1670     my $spec = shift;
1671     return unless $spec;
1672     if ($spec  !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) {
1673         return;
1674     }
1675     my $obj_type  = $1;
1676     my $obj_id    = $2;
1677     my $search_id = $3;
1678
1679     return (_load_container_object ($obj_type, $obj_id), $search_id);
1680 }
1681
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});
1686
1687 1;