rt/lib/RT/Interface/Web.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2005 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., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 #
  27 #
  28 # CONTRIBUTION SUBMISSION POLICY:
  29 #
  30 # (The following paragraph is not intended to limit the rights granted
  31 # to you to modify and distribute this software under the terms of
  32 # the GNU General Public License and is only of importance to you if
  33 # you choose to contribute your changes and enhancements to the
  34 # community by submitting them to Best Practical Solutions, LLC.)
  35 #
  36 # By intentionally submitting any modifications, corrections or
  37 # derivatives to this work, or any other work intended for use with
  38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  39 # you are the copyright holder for those contributions and you grant
  40 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  41 # royalty-free, perpetual, license to use, copy, create derivative
  42 # works based on those contributions, and sublicense and distribute
  43 # those contributions and any derivatives thereof.
  44 #
  45 # END BPS TAGGED BLOCK }}}
  46 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
  47
  48 ## This is a library of static subs to be used by the Mason web
  49 ## interface to RT
  50
  51
  52 =head1 NAME
  53
  54 RT::Interface::Web
  55
  56 =begin testing
  57
  58 use_ok(RT::Interface::Web);
  59
  60 =end testing
  61
  62 =cut
  63
  64
  65 package RT::Interface::Web;
  66 use strict;
  67
  68
  69
  70 # {{{ EscapeUTF8
  71
  72 =head2 EscapeUTF8 SCALARREF
  73
  74 does a css-busting but minimalist escaping of whatever html you're passing in.
  75
  76 =cut
  77
  78 sub EscapeUTF8  {
  79         my  $ref = shift;
  80         return unless defined $$ref;
  81         my $val = $$ref;
  82         use bytes;
  83         $val =~ s/&/&#38;/g;
  84         $val =~ s/</&lt;/g;
  85         $val =~ s/>/&gt;/g;
  86         $val =~ s/\(/&#40;/g;
  87         $val =~ s/\)/&#41;/g;
  88         $val =~ s/"/&#34;/g;
  89         $val =~ s/'/&#39;/g;
  90         $$ref = $val;
  91         Encode::_utf8_on($$ref);
  92
  93
  94 }
  95
  96 # }}}
  97
  98 # {{{ EscapeURI
  99
 100 =head2 EscapeURI SCALARREF
 101
 102 Escapes URI component according to RFC2396
 103
 104 =cut
 105
 106 use Encode qw();
 107 sub EscapeURI {
 108     my $ref = shift;
 109     $$ref = Encode::encode_utf8( $$ref );
 110     $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
 111     Encode::_utf8_on( $$ref );
 112 }
 113
 114 # }}}
 115
 116 # {{{ WebCanonicalizeInfo
 117
 118 =head2 WebCanonicalizeInfo();
 119
 120 Different web servers set different environmental varibles. This
 121 function must return something suitable for REMOTE_USER. By default,
 122 just downcase $ENV{'REMOTE_USER'}
 123
 124 =cut
 125
 126 sub WebCanonicalizeInfo {
 127     my $user;
 128
 129     if ( defined $ENV{'REMOTE_USER'} ) {
 130         $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) );
 131     }
 132
 133     return $user;
 134 }
 135
 136 # }}}
 137
 138 # {{{ WebExternalAutoInfo
 139
 140 =head2 WebExternalAutoInfo($user);
 141
 142 Returns a hash of user attributes, used when WebExternalAuto is set.
 143
 144 =cut
 145
 146 sub WebExternalAutoInfo {
 147     my $user = shift;
 148
 149     my %user_info;
 150
 151     $user_info{'Privileged'} = 1;
 152
 153     if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
 154         # Populate fields with information from Unix /etc/passwd
 155
 156         my ($comments, $realname) = (getpwnam($user))[5, 6];
 157         $user_info{'Comments'} = $comments if defined $comments;
 158         $user_info{'RealName'} = $realname if defined $realname;
 159     }
 160     elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
 161         # Populate fields with information from NT domain controller
 162     }
 163
 164     # and return the wad of stuff
 165     return {%user_info};
 166 }
 167
 168 # }}}
 169
 170
 171 package HTML::Mason::Commands;
 172 use strict;
 173 use vars qw/$r $m %session/;
 174
 175
 176 # {{{ loc
 177
 178 =head2 loc ARRAY
 179
 180 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
 181 with whatever it's called with. If there is no $session{'CurrentUser'},
 182 it creates a temporary user, so we have something to get a localisation handle
 183 through
 184
 185 =cut
 186
 187 sub loc {
 188
 189     if ($session{'CurrentUser'} &&
 190         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 191         return($session{'CurrentUser'}->loc(@_));
 192     }
 193     elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
 194         return ($u->loc(@_));
 195     }
 196     else {
 197         # pathetic case -- SystemUser is gone.
 198         return $_[0];
 199     }
 200 }
 201
 202 # }}}
 203
 204
 205 # {{{ loc_fuzzy
 206
 207 =head2 loc_fuzzy STRING
 208
 209 loc_fuzzy is for handling localizations of messages that may already
 210 contain interpolated variables, typically returned from libraries
 211 outside RT's control.  It takes the message string and extracts the
 212 variable array automatically by matching against the candidate entries
 213 inside the lexicon file.
 214
 215 =cut
 216
 217 sub loc_fuzzy {
 218     my $msg  = shift;
 219
 220     if ($session{'CurrentUser'} &&
 221         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 222         return($session{'CurrentUser'}->loc_fuzzy($msg));
 223     }
 224     else  {
 225         my $u = RT::CurrentUser->new($RT::SystemUser->Id);
 226         return ($u->loc_fuzzy($msg));
 227     }
 228 }
 229
 230 # }}}
 231
 232
 233 # {{{ sub Abort
 234 # Error - calls Error and aborts
 235 sub Abort {
 236
 237     if ($session{'ErrorDocument'} &&
 238         $session{'ErrorDocumentType'}) {
 239         $r->content_type($session{'ErrorDocumentType'});
 240         $m->comp($session{'ErrorDocument'} , Why => shift);
 241         $m->abort;
 242     }
 243     else  {
 244         $m->comp("/Elements/Error" , Why => shift);
 245         $m->abort;
 246     }
 247 }
 248
 249 # }}}
 250
 251 # {{{ sub CreateTicket
 252
 253 =head2 CreateTicket ARGS
 254
 255 Create a new ticket, using Mason's %ARGS.  returns @results.
 256
 257 =cut
 258
 259 sub CreateTicket {
 260     my %ARGS = (@_);
 261
 262     my (@Actions);
 263
 264     my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
 265
 266     my $Queue = new RT::Queue( $session{'CurrentUser'} );
 267     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
 268         Abort('Queue not found');
 269     }
 270
 271     unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
 272         Abort('You have no permission to create tickets in that queue.');
 273     }
 274
 275     my $due = new RT::Date( $session{'CurrentUser'} );
 276     $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
 277     my $starts = new RT::Date( $session{'CurrentUser'} );
 278     $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
 279
 280     my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} );
 281     my @Cc         = split ( /\s*,\s*/, $ARGS{'Cc'} );
 282     my @AdminCc    = split ( /\s*,\s*/, $ARGS{'AdminCc'} );
 283
 284     my $MIMEObj = MakeMIMEEntity(
 285         Subject             => $ARGS{'Subject'},
 286         From                => $ARGS{'From'},
 287         Cc                  => $ARGS{'Cc'},
 288         Body                => $ARGS{'Content'},
 289     );
 290
 291     if ( $ARGS{'Attachments'} ) {
 292         my $rv = $MIMEObj->make_multipart;
 293         $RT::Logger->error("Couldn't make multipart message")
 294             if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
 295
 296         foreach ( values %{$ARGS{'Attachments'}} ) {
 297             unless ( $_ ) {
 298                 $RT::Logger->error("Couldn't add empty attachemnt");
 299                 next;
 300             }
 301             $MIMEObj->add_part($_);
 302         }
 303     }
 304
 305     my %create_args = (
 306         Type            => $ARGS{'Type'} || 'ticket',
 307         Queue           => $ARGS{'Queue'},
 308         Owner           => $ARGS{'Owner'},
 309         InitialPriority => $ARGS{'InitialPriority'},
 310         FinalPriority   => $ARGS{'FinalPriority'},
 311         TimeLeft        => $ARGS{'TimeLeft'},
 312         TimeEstimated        => $ARGS{'TimeEstimated'},
 313         TimeWorked      => $ARGS{'TimeWorked'},
 314         Requestor       => \@Requestors,
 315         Cc              => \@Cc,
 316         AdminCc         => \@AdminCc,
 317         Subject         => $ARGS{'Subject'},
 318         Status          => $ARGS{'Status'},
 319         Due             => $due->ISO,
 320         Starts          => $starts->ISO,
 321         MIMEObj         => $MIMEObj
 322     );
 323     foreach my $arg (keys %ARGS) {
 324             my $cfid = $1;
 325
 326             next if ($arg =~ /-Magic$/);
 327        #Object-RT::Ticket--CustomField-3-Values
 328         if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
 329             $create_args{$arg} = $ARGS{$arg};
 330         }
 331         elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
 332             my $cfid = $1;
 333             my $cf = RT::CustomField->new( $session{'CurrentUser'});
 334             $cf->Load($cfid);
 335
 336             if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
 337                 $ARGS{$arg} =~ s/\r\n/\n/g;
 338                 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
 339             }
 340
 341             if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
 342                 $ARGS{$arg} =~ s/\r//g;
 343             }
 344
 345             if ( $arg =~ /-Upload$/ ) {
 346                 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
 347             }
 348             else {
 349                 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
 350             }
 351         }
 352     }
 353
 354
 355     # XXX TODO This code should be about six lines. and badly needs refactoring.
 356
 357     # {{{ turn new link lists into arrays, and pass in the proper arguments
 358     my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
 359
 360     foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
 361         $luri =~ s/\s*$//;    # Strip trailing whitespace
 362         push @dependson, $luri;
 363     }
 364     $create_args{'DependsOn'} = \@dependson;
 365
 366     foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
 367         push @dependedonby, $luri;
 368     }
 369     $create_args{'DependedOnBy'} = \@dependedonby;
 370
 371     foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
 372         $luri =~ s/\s*$//;    # Strip trailing whitespace
 373         push @parents, $luri;
 374     }
 375     $create_args{'Parents'} = \@parents;
 376
 377     foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
 378         push @children, $luri;
 379     }
 380     $create_args{'Children'} = \@children;
 381
 382     foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
 383         $luri =~ s/\s*$//;    # Strip trailing whitespace
 384         push @refersto, $luri;
 385     }
 386     $create_args{'RefersTo'} = \@refersto;
 387
 388     foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
 389         push @referredtoby, $luri;
 390     }
 391     $create_args{'ReferredToBy'} = \@referredtoby;
 392     # }}}
 393
 394
 395     my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
 396     unless ( $id && $Trans ) {
 397         Abort($ErrMsg);
 398     }
 399
 400     push ( @Actions, split("\n", $ErrMsg) );
 401     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
 402         Abort( "No permission to view newly created ticket #"
 403             . $Ticket->id . "." );
 404     }
 405     return ( $Ticket, @Actions );
 406
 407 }
 408
 409 # }}}
 410
 411 # {{{ sub LoadTicket - loads a ticket
 412
 413 =head2  LoadTicket id
 414
 415 Takes a ticket id as its only variable. if it's handed an array, it takes
 416 the first value.
 417
 418 Returns an RT::Ticket object as the current user.
 419
 420 =cut
 421
 422 sub LoadTicket {
 423     my $id = shift;
 424
 425     if ( ref($id) eq "ARRAY" ) {
 426         $id = $id->[0];
 427     }
 428
 429     unless ($id) {
 430         Abort("No ticket specified");
 431     }
 432
 433     my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 434     $Ticket->Load($id);
 435     unless ( $Ticket->id ) {
 436         Abort("Could not load ticket $id");
 437     }
 438     return $Ticket;
 439 }
 440
 441 # }}}
 442
 443 # {{{ sub ProcessUpdateMessage
 444
 445 sub ProcessUpdateMessage {
 446
 447     #TODO document what else this takes.
 448     my %args = (
 449         ARGSRef   => undef,
 450         Actions   => undef,
 451         TicketObj => undef,
 452         @_
 453     );
 454
 455     #Make the update content have no 'weird' newlines in it
 456     if (   $args{ARGSRef}->{'UpdateTimeWorked'}
 457         || $args{ARGSRef}->{'UpdateContent'}
 458         || $args{ARGSRef}->{'UpdateAttachments'} )
 459     {
 460
 461         if (
 462             $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
 463         {
 464             $args{ARGSRef}->{'UpdateSubject'} = undef;
 465         }
 466
 467         my $Message = MakeMIMEEntity(
 468             Subject => $args{ARGSRef}->{'UpdateSubject'},
 469             Body    => $args{ARGSRef}->{'UpdateContent'},
 470         );
 471
 472         $Message->head->add( 'Message-ID' =>
 473               "<rt-"
 474               . $RT::VERSION . "-"
 475               . $$ . "-"
 476               . CORE::time() . "-"
 477               . int(rand(2000)) . "."
 478               . $args{'TicketObj'}->id . "-"
 479               . "0" . "-"  # Scrip
 480               . "0" . "@"  # Email sent
 481               . $RT::Organization
 482               . ">" );
 483         my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
 484         if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
 485             $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
 486         }
 487         else {
 488             $old_txn = $args{TicketObj}->Transactions->First();
 489         }
 490
 491         if ( $old_txn->Message && $old_txn->Message->First ) {
 492             my @in_reply_to = split(/\s+/m, $old_txn->Message->First->GetHeader('In-Reply-To') || '');
 493             my @references = split(/\s+/m, $old_txn->Message->First->GetHeader('References') || '' );
 494             my @msgid = split(/\s+/m,$old_txn->Message->First->GetHeader('Message-ID') || '');
 495             my @rtmsgid = split(/\s+/m,$old_txn->Message->First->GetHeader('RT-Message-ID') || '');
 496
 497             $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
 498             $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
 499         }
 500
 501     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
 502         $Message->make_multipart;
 503         $Message->add_part($_)
 504           foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
 505     }
 506
 507     ## TODO: Implement public comments
 508     if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
 509         my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(
 510             CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 511             BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 512             MIMEObj      => $Message,
 513             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 514         );
 515         push( @{ $args{Actions} }, $Description );
 516         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 517     }
 518     elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
 519         my ( $Transaction, $Description, $Object ) =
 520           $args{TicketObj}->Correspond(
 521             CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 522             BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 523             MIMEObj      => $Message,
 524             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 525           );
 526         push( @{ $args{Actions} }, $Description );
 527         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 528     }
 529     else {
 530         push(
 531             @{ $args{'Actions'} },
 532             loc("Update type was neither correspondence nor comment.") . " "
 533               . loc("Update not recorded.")
 534         );
 535     }
 536 }
 537 }
 538
 539 # }}}
 540
 541 # {{{ sub MakeMIMEEntity
 542
 543 =head2 MakeMIMEEntity PARAMHASH
 544
 545 Takes a paramhash Subject, Body and AttachmentFieldName.
 546
 547   Returns a MIME::Entity.
 548
 549 =cut
 550
 551 sub MakeMIMEEntity {
 552
 553     #TODO document what else this takes.
 554     my %args = (
 555         Subject             => undef,
 556         From                => undef,
 557         Cc                  => undef,
 558         Body                => undef,
 559         AttachmentFieldName => undef,
 560 #        map Encode::encode_utf8($_), @_,
 561         @_,
 562     );
 563
 564     #Make the update content have no 'weird' newlines in it
 565
 566     $args{'Body'} =~ s/\r\n/\n/gs;
 567     my $Message;
 568     {
 569         # MIME::Head is not happy in utf-8 domain.  This only happens
 570         # when processing an incoming email (so far observed).
 571         no utf8;
 572         use bytes;
 573         $Message = MIME::Entity->build(
 574             Subject => $args{'Subject'} || "",
 575             From    => $args{'From'},
 576             Cc      => $args{'Cc'},
 577             Charset => 'utf8',
 578             Data    => [ $args{'Body'} ]
 579         );
 580     }
 581
 582     my $cgi_object = $m->cgi_object;
 583
 584     if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
 585
 586
 587
 588     use File::Temp qw(tempfile tempdir);
 589
 590     #foreach my $filehandle (@filenames) {
 591
 592     my ( $fh, $temp_file );
 593     for ( 1 .. 10 ) {
 594         # on NFS and NTFS, it is possible that tempfile() conflicts
 595         # with other processes, causing a race condition. we try to
 596         # accommodate this by pausing and retrying.
 597         last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) };
 598         sleep 1;
 599     }
 600
 601     binmode $fh;    #thank you, windows
 602     my ($buffer);
 603     while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
 604         print $fh $buffer;
 605     }
 606
 607     my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 608
 609     # Prefer the cached name first over CGI.pm stringification.
 610     my $filename = $RT::Mason::CGI::Filename;
 611     $filename = "$filehandle" unless defined($filename);
 612
 613     $filename =~ s#^.*[\\/]##;
 614
 615     $Message->attach(
 616         Path     => $temp_file,
 617         Filename => Encode::decode_utf8($filename),
 618         Type     => $uploadinfo->{'Content-Type'},
 619     );
 620     close($fh);
 621
 622     #   }
 623
 624     }
 625
 626     $Message->make_singlepart();
 627     RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
 628
 629     return ($Message);
 630
 631 }
 632
 633 # }}}
 634
 635 # {{{ sub ProcessSearchQuery
 636
 637 =head2 ProcessSearchQuery
 638
 639   Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
 640
 641 TODO Doc exactly what comes in the paramhash
 642
 643
 644 =cut
 645
 646 sub ProcessSearchQuery {
 647     my %args = @_;
 648
 649     ## TODO: The only parameter here is %ARGS.  Maybe it would be
 650     ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
 651     ## instead of $args{ARGS}->{...} ? :)
 652
 653     #Searches are sticky.
 654     if ( defined $session{'tickets'} ) {
 655
 656         # Reset the old search
 657         $session{'tickets'}->GotoFirstItem;
 658     }
 659     else {
 660
 661         # Init a new search
 662         $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
 663     }
 664
 665     #Import a bookmarked search if we have one
 666     if ( defined $args{ARGS}->{'Bookmark'} ) {
 667         $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
 668     }
 669
 670     # {{{ Goto next/prev page
 671     if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
 672         $session{'tickets'}->NextPage;
 673     }
 674     elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
 675         $session{'tickets'}->PrevPage;
 676     }
 677     elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
 678         $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
 679     }
 680
 681     # }}}
 682
 683     # {{{ Deal with limiting the search
 684
 685     if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
 686         $session{'tickets_refresh_interval'} =
 687           $args{ARGS}->{'RefreshSearchInterval'};
 688     }
 689
 690     if ( $args{ARGS}->{'TicketsSortBy'} ) {
 691         $session{'tickets_sort_by'}    = $args{ARGS}->{'TicketsSortBy'};
 692         $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
 693         $session{'tickets'}->OrderBy(
 694             FIELD => $args{ARGS}->{'TicketsSortBy'},
 695             ORDER => $args{ARGS}->{'TicketsSortOrder'}
 696         );
 697     }
 698
 699     # }}}
 700
 701     # {{{ Set the query limit
 702     if ( defined $args{ARGS}->{'RowsPerPage'} ) {
 703         $RT::Logger->debug(
 704             "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
 705
 706         $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
 707         $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
 708     }
 709
 710     # }}}
 711     # {{{ Limit priority
 712     if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
 713         $session{'tickets'}->LimitPriority(
 714             VALUE    => $args{ARGS}->{'ValueOfPriority'},
 715             OPERATOR => $args{ARGS}->{'PriorityOp'}
 716         );
 717     }
 718
 719     # }}}
 720     # {{{ Limit owner
 721     if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
 722         $session{'tickets'}->LimitOwner(
 723             VALUE    => $args{ARGS}->{'ValueOfOwner'},
 724             OPERATOR => $args{ARGS}->{'OwnerOp'}
 725         );
 726     }
 727
 728     # }}}
 729     # {{{ Limit requestor email
 730      if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
 731          $session{'tickets'}->LimitWatcher(
 732              TYPE     => $args{ARGS}->{'WatcherRole'},
 733              VALUE    => $args{ARGS}->{'ValueOfWatcherRole'},
 734              OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
 735
 736         );
 737     }
 738
 739     # }}}
 740     # {{{ Limit Queue
 741     if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
 742         $session{'tickets'}->LimitQueue(
 743             VALUE    => $args{ARGS}->{'ValueOfQueue'},
 744             OPERATOR => $args{ARGS}->{'QueueOp'}
 745         );
 746     }
 747
 748     # }}}
 749     # {{{ Limit Status
 750     if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
 751         if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
 752             foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
 753                 $session{'tickets'}->LimitStatus(
 754                     VALUE    => $value,
 755                     OPERATOR => $args{ARGS}->{'StatusOp'},
 756                 );
 757             }
 758         }
 759         else {
 760             $session{'tickets'}->LimitStatus(
 761                 VALUE    => $args{ARGS}->{'ValueOfStatus'},
 762                 OPERATOR => $args{ARGS}->{'StatusOp'},
 763             );
 764         }
 765
 766     }
 767
 768     # }}}
 769     # {{{ Limit Subject
 770     if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
 771             my $val = $args{ARGS}->{'ValueOfSubject'};
 772         if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
 773             $val = "%".$val."%";
 774         }
 775         $session{'tickets'}->LimitSubject(
 776             VALUE    => $val,
 777             OPERATOR => $args{ARGS}->{'SubjectOp'},
 778         );
 779     }
 780
 781     # }}}
 782     # {{{ Limit Dates
 783     if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
 784         my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
 785         $args{ARGS}->{'DateType'} =~ s/_Date$//;
 786
 787         if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
 788             $session{'tickets'}->LimitTransactionDate(
 789                                             VALUE    => $date,
 790                                             OPERATOR => $args{ARGS}->{'DateOp'},
 791             );
 792         }
 793         else {
 794             $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
 795                                             VALUE => $date,
 796                                             OPERATOR => $args{ARGS}->{'DateOp'},
 797             );
 798         }
 799     }
 800
 801     # }}}
 802     # {{{ Limit Content
 803     if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
 804         my $val = $args{ARGS}->{'ValueOfAttachmentField'};
 805         if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
 806             $val = "%".$val."%";
 807         }
 808         $session{'tickets'}->Limit(
 809             FIELD   => $args{ARGS}->{'AttachmentField'},
 810             VALUE    => $val,
 811             OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
 812         );
 813     }
 814
 815     # }}}
 816
 817  # {{{ Limit CustomFields
 818
 819     foreach my $arg ( keys %{ $args{ARGS} } ) {
 820         my $id;
 821         if ( $arg =~ /^CustomField(\d+)$/ ) {
 822             $id = $1;
 823         }
 824         else {
 825             next;
 826         }
 827         next unless ( $args{ARGS}->{$arg} );
 828
 829         my $form = $args{ARGS}->{$arg};
 830         my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
 831         foreach my $value ( ref($form) ? @{$form} : ($form) ) {
 832             my $quote = 1;
 833             if ($oper =~ /like/i) {
 834                 $value = "%".$value."%";
 835             }
 836             if ( $value =~ /^null$/i ) {
 837
 838                 #Don't quote the string 'null'
 839                 $quote = 0;
 840
 841                 # Convert the operator to something apropriate for nulls
 842                 $oper = 'IS'     if ( $oper eq '=' );
 843                 $oper = 'IS NOT' if ( $oper eq '!=' );
 844             }
 845             $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
 846                                                    OPERATOR    => $oper,
 847                                                    QUOTEVALUE  => $quote,
 848                                                    VALUE       => $value );
 849         }
 850     }
 851
 852     # }}}
 853
 854
 855 }
 856
 857 # }}}
 858
 859 # {{{ sub ParseDateToISO
 860
 861 =head2 ParseDateToISO
 862
 863 Takes a date in an arbitrary format.
 864 Returns an ISO date and time in GMT
 865
 866 =cut
 867
 868 sub ParseDateToISO {
 869     my $date = shift;
 870
 871     my $date_obj = RT::Date->new($session{'CurrentUser'});
 872     $date_obj->Set(
 873         Format => 'unknown',
 874         Value  => $date
 875     );
 876     return ( $date_obj->ISO );
 877 }
 878
 879 # }}}
 880
 881 # {{{ sub ProcessACLChanges
 882
 883 sub ProcessACLChanges {
 884     my $ARGSref = shift;
 885
 886     my %ARGS     = %$ARGSref;
 887
 888     my ( $ACL, @results );
 889
 890
 891     foreach my $arg (keys %ARGS) {
 892         if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
 893             my $principal_id = $1;
 894             my $object_type = $2;
 895             my $object_id = $3;
 896             my $rights = $ARGS{$arg};
 897
 898             my $principal = RT::Principal->new($session{'CurrentUser'});
 899             $principal->Load($principal_id);
 900
 901             my $obj;
 902
 903              if ($object_type eq 'RT::System') {
 904                 $obj = $RT::System;
 905             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
 906                 $obj = $object_type->new($session{'CurrentUser'});
 907                 $obj->Load($object_id);
 908             } else {
 909                 push (@results, loc("System Error"). ': '.
 910                                 loc("Rights could not be granted for [_1]", $object_type));
 911                 next;
 912             }
 913
 914             my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
 915             foreach my $right (@rights) {
 916                 next unless ($right);
 917                 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
 918                 push (@results, $msg);
 919             }
 920         }
 921        elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
 922             my $principal_id = $1;
 923             my $object_type = $2;
 924             my $object_id = $3;
 925             my $right = $4;
 926
 927             my $principal = RT::Principal->new($session{'CurrentUser'});
 928             $principal->Load($principal_id);
 929             next unless ($right);
 930             my $obj;
 931
 932              if ($object_type eq 'RT::System') {
 933                 $obj = $RT::System;
 934             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
 935                 $obj = $object_type->new($session{'CurrentUser'});
 936                 $obj->Load($object_id);
 937             } else {
 938                 push (@results, loc("System Error"). ': '.
 939                                 loc("Rights could not be revoked for [_1]", $object_type));
 940                 next;
 941             }
 942             my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
 943             push (@results, $msg);
 944         }
 945
 946
 947     }
 948
 949     return (@results);
 950
 951     }
 952
 953 # }}}
 954
 955 # {{{ sub UpdateRecordObj
 956
 957 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
 958
 959 @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.
 960
 961 Returns an array of success/failure messages
 962
 963 =cut
 964
 965 sub UpdateRecordObject {
 966     my %args = (
 967         ARGSRef       => undef,
 968         AttributesRef => undef,
 969         Object        => undef,
 970         AttributePrefix => undef,
 971         @_
 972     );
 973
 974     my $Object = $args{'Object'};
 975     my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
 976                                   ARGSRef       => $args{'ARGSRef'},
 977                   AttributePrefix => $args{'AttributePrefix'}
 978                                   );
 979
 980     return (@results);
 981 }
 982
 983 # }}}
 984
 985 # {{{ Sub ProcessCustomFieldUpdates
 986
 987 sub ProcessCustomFieldUpdates {
 988     my %args = (
 989         CustomFieldObj => undef,
 990         ARGSRef        => undef,
 991         @_
 992     );
 993
 994     my $Object  = $args{'CustomFieldObj'};
 995     my $ARGSRef = $args{'ARGSRef'};
 996
 997     my @attribs = qw( Name Type Description Queue SortOrder);
 998     my @results = UpdateRecordObject(
 999         AttributesRef => \@attribs,
1000         Object        => $Object,
1001         ARGSRef       => $ARGSRef
1002     );
1003
1004     if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
1005
1006         my ( $addval, $addmsg ) = $Object->AddValue(
1007             Name =>
1008               $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1009             Description => $ARGSRef->{ "CustomField-"
1010                   . $Object->Id
1011                   . "-AddValue-Description" },
1012             SortOrder => $ARGSRef->{ "CustomField-"
1013                   . $Object->Id
1014                   . "-AddValue-SortOrder" },
1015         );
1016         push ( @results, $addmsg );
1017     }
1018     my @delete_values = (
1019         ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1020           'ARRAY' )
1021       ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
1022       : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
1023     foreach my $id (@delete_values) {
1024         next unless defined $id;
1025         my ( $err, $msg ) = $Object->DeleteValue($id);
1026         push ( @results, $msg );
1027     }
1028
1029     my $vals = $Object->Values();
1030     while (my $cfv = $vals->Next()) {
1031         if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
1032             if ($cfv->SortOrder != $so) {
1033                 my ( $err, $msg ) = $cfv->SetSortOrder($so);
1034                 push ( @results, $msg );
1035             }
1036         }
1037     }
1038
1039     return (@results);
1040 }
1041
1042 # }}}
1043
1044 # {{{ sub ProcessTicketBasics
1045
1046 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1047
1048 Returns an array of results messages.
1049
1050 =cut
1051
1052 sub ProcessTicketBasics {
1053
1054     my %args = (
1055         TicketObj => undef,
1056         ARGSRef   => undef,
1057         @_
1058     );
1059
1060     my $TicketObj = $args{'TicketObj'};
1061     my $ARGSRef   = $args{'ARGSRef'};
1062
1063     # {{{ Set basic fields
1064     my @attribs = qw(
1065       Subject
1066       FinalPriority
1067       Priority
1068       TimeEstimated
1069       TimeWorked
1070       TimeLeft
1071       Type
1072       Status
1073       Queue
1074     );
1075
1076     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
1077         my $tempqueue = RT::Queue->new($RT::SystemUser);
1078         $tempqueue->Load( $ARGSRef->{'Queue'} );
1079         if ( $tempqueue->id ) {
1080             $ARGSRef->{'Queue'} = $tempqueue->Id();
1081         }
1082     }
1083
1084
1085    # Status isn't a field that can be set to a null value.
1086    # RT core complains if you try
1087     delete $ARGSRef->{'Status'} unless ($ARGSRef->{'Status'});
1088
1089     my @results = UpdateRecordObject(
1090         AttributesRef => \@attribs,
1091         Object        => $TicketObj,
1092         ARGSRef       => $ARGSRef
1093     );
1094
1095     # We special case owner changing, so we can use ForceOwnerChange
1096     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1097         my ($ChownType);
1098         if ( $ARGSRef->{'ForceOwnerChange'} ) {
1099             $ChownType = "Force";
1100         }
1101         else {
1102             $ChownType = "Give";
1103         }
1104
1105         my ( $val, $msg ) =
1106           $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1107         push ( @results, $msg );
1108     }
1109
1110     # }}}
1111
1112     return (@results);
1113 }
1114
1115 # }}}
1116
1117 sub ProcessTicketCustomFieldUpdates {
1118     my %args = @_;
1119     $args{'Object'} = delete $args{'TicketObj'};
1120     my $ARGSRef = { %{ $args{'ARGSRef'} } };
1121
1122     # Build up a list of objects that we want to work with
1123     my %custom_fields_to_mod;
1124     foreach my $arg ( keys %$ARGSRef ) {
1125         if ( $arg =~ /^Ticket-(\d+-.*)/) {
1126             $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
1127         }
1128         elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1129             $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1130         }
1131     }
1132
1133     return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1134 }
1135
1136 sub ProcessObjectCustomFieldUpdates {
1137     my %args = @_;
1138     my $ARGSRef = $args{'ARGSRef'};
1139     my @results;
1140
1141     # Build up a list of objects that we want to work with
1142     my %custom_fields_to_mod;
1143     foreach my $arg ( keys %$ARGSRef ) {
1144         # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands>
1145         next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/;
1146
1147         # For each of those objects, find out what custom fields we want to work with.
1148         $custom_fields_to_mod{ $1 }{ $2 || 0 }{ $3 }{ $4 } = $ARGSRef->{ $arg };
1149     }
1150
1151     # For each of those objects
1152     foreach my $class ( keys %custom_fields_to_mod ) {
1153         foreach my $id ( keys %{$custom_fields_to_mod{$class}} ) {
1154             my $Object = $args{'Object'};
1155             $Object = $class->new( $session{'CurrentUser'} )
1156                 unless $Object && ref $Object eq $class;
1157
1158             $Object->Load( $id ) unless ($Object->id || 0) == $id;
1159             unless ( $Object->id ) {
1160                 $RT::Logger->warning("Couldn't load object $class #$id");
1161                 next;
1162             }
1163
1164             foreach my $cf ( keys %{ $custom_fields_to_mod{ $class }{ $id } } ) {
1165                 my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} );
1166                 $CustomFieldObj->LoadById( $cf );
1167                 unless ( $CustomFieldObj->id ) {
1168                     $RT::Logger->warning("Couldn't load custom field #$id");
1169                     next;
1170                 }
1171                 push @results, _ProcessObjectCustomFieldUpdates(
1172                     Prefix      => "Object-$class-$id-CustomField-$cf-",
1173                     Object      => $Object,
1174                     CustomField => $CustomFieldObj,
1175                     ARGS        => $custom_fields_to_mod{$class}{$id}{$cf},
1176                 );
1177             }
1178         }
1179     }
1180     return @results;
1181 }
1182
1183 sub _ProcessObjectCustomFieldUpdates {
1184     my %args = @_;
1185     my $cf = $args{'CustomField'};
1186     my $cf_type = $cf->Type;
1187
1188     my @results;
1189     foreach my $arg ( keys %{ $args{'ARGS'} } ) {
1190
1191         # since http won't pass in a form element with a null value, we need
1192         # to fake it
1193         if ( $arg eq 'Values-Magic' ) {
1194             # We don't care about the magic, if there's really a values element;
1195             next if $args{'ARGS'}->{'Value'} || $args{'ARGS'}->{'Values'};
1196
1197             # "Empty" values does not mean anything for Image and Binary fields
1198             next if $cf_type =~ /^(?:Image|Binary)$/;
1199
1200             $arg = 'Values';
1201             $args{'ARGS'}->{'Values'} = undef;
1202         }
1203
1204         my @values = ();
1205         if ( ref $args{'ARGS'}->{ $arg } eq 'ARRAY' ) {
1206             @values = @{ $args{'ARGS'}->{$arg} };
1207         } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext
1208             @values = ($args{'ARGS'}->{$arg});
1209         } else {
1210             @values = split /\n/, $args{'ARGS'}->{ $arg };
1211         }
1212
1213         if ( ( $cf_type eq 'Freeform' && !$cf->SingleValue ) || $cf_type =~ /text/i ) {
1214             s/\r//g foreach @values;
1215         }
1216         @values = grep defined && $_ ne '', @values;
1217
1218         if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
1219             foreach my $value (@values) {
1220                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1221                     Field => $cf->id,
1222                     Value => $value
1223                 );
1224                 push ( @results, $msg );
1225             }
1226         }
1227         elsif ( $arg eq 'Upload' ) {
1228             my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
1229             my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1230                 %$value_hash,
1231                 Field => $cf,
1232             );
1233             push ( @results, $msg );
1234         }
1235         elsif ( $arg eq 'DeleteValues' ) {
1236             foreach my $value ( @values ) {
1237                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1238                     Field => $cf,
1239                     Value => $value,
1240                 );
1241                 push ( @results, $msg );
1242             }
1243         }
1244         elsif ( $arg eq 'DeleteValueIds' ) {
1245             foreach my $value ( @values ) {
1246                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1247                     Field   => $cf,
1248                     ValueId => $value,
1249                 );
1250                 push ( @results, $msg );
1251             }
1252         }
1253         elsif ( $arg eq 'Values' && !$cf->Repeated ) {
1254             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1255
1256             my %values_hash;
1257             foreach my $value ( @values ) {
1258                 # build up a hash of values that the new set has
1259                 $values_hash{$value} = 1;
1260                 next if $cf_values->HasEntry( $value );
1261
1262                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1263                     Field => $cf,
1264                     Value => $value
1265                 );
1266                 push ( @results, $msg );
1267             }
1268
1269             $cf_values->RedoSearch;
1270             while ( my $cf_value = $cf_values->Next ) {
1271                 next if $values_hash{ $cf_value->Content };
1272
1273                 my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
1274                     Field => $cf,
1275                     Value => $cf_value->Content
1276                 );
1277                 push ( @results, $msg);
1278             }
1279         }
1280         elsif ( $arg eq 'Values' ) {
1281             my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
1282
1283             # keep everything up to the point of difference, delete the rest
1284             my $delete_flag;
1285             foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1286                 if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1287                     shift @values;
1288                     next;
1289                 }
1290
1291                 $delete_flag ||= 1;
1292                 $old_cf->Delete;
1293             }
1294
1295             # now add/replace extra things, if any
1296             foreach my $value ( @values ) {
1297                 my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
1298                     Field => $cf,
1299                     Value => $value
1300                 );
1301                 push ( @results, $msg );
1302             }
1303         }
1304         else {
1305             push ( @results, loc("User asked for an unknown update type"
1306                 ." for custom field [_1] for [_2] object #[_3]",
1307                 $cf->Name, ref $args{'Object'}, $args{'Object'}->id )
1308             );
1309         }
1310     }
1311     return @results;
1312 }
1313
1314 # {{{ sub ProcessTicketWatchers
1315
1316 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1317
1318 Returns an array of results messages.
1319
1320 =cut
1321
1322 sub ProcessTicketWatchers {
1323     my %args = (
1324         TicketObj => undef,
1325         ARGSRef   => undef,
1326         @_
1327     );
1328     my (@results);
1329
1330     my $Ticket  = $args{'TicketObj'};
1331     my $ARGSRef = $args{'ARGSRef'};
1332
1333     # {{{ Munge watchers
1334
1335     foreach my $key ( keys %$ARGSRef ) {
1336
1337         # {{{ Delete deletable watchers
1338         if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ )  ) {
1339             my ( $code, $msg ) =
1340                 $Ticket->DeleteWatcher(PrincipalId => $2,
1341                                        Type => $1);
1342             push @results, $msg;
1343         }
1344
1345         # Delete watchers in the simple style demanded by the bulk manipulator
1346         elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1347             my ( $code, $msg ) = $Ticket->DeleteWatcher( Email => $ARGSRef->{$key}, Type => $1 );
1348             push @results, $msg;
1349         }
1350
1351         # }}}
1352
1353         # Add new wathchers by email address
1354         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1355             and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1356         {
1357
1358             #They're in this order because otherwise $1 gets clobbered :/
1359             my ( $code, $msg ) = $Ticket->AddWatcher(
1360                 Type  => $ARGSRef->{$key},
1361                 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1362             );
1363             push @results, $msg;
1364         }
1365
1366         #Add requestors in the simple style demanded by the bulk manipulator
1367         elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1368             my ( $code, $msg ) = $Ticket->AddWatcher(
1369                 Type  => $1,
1370                 Email => $ARGSRef->{$key}
1371             );
1372             push @results, $msg;
1373         }
1374
1375         # Add new  watchers by owner
1376         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1377             and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
1378
1379             #They're in this order because otherwise $1 gets clobbered :/
1380             my ( $code, $msg ) =
1381               $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1382             push @results, $msg;
1383         }
1384     }
1385
1386     # }}}
1387
1388     return (@results);
1389 }
1390
1391 # }}}
1392
1393 # {{{ sub ProcessTicketDates
1394
1395 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1396
1397 Returns an array of results messages.
1398
1399 =cut
1400
1401 sub ProcessTicketDates {
1402     my %args = (
1403         TicketObj => undef,
1404         ARGSRef   => undef,
1405         @_
1406     );
1407
1408     my $Ticket  = $args{'TicketObj'};
1409     my $ARGSRef = $args{'ARGSRef'};
1410
1411     my (@results);
1412
1413     # {{{ Set date fields
1414     my @date_fields = qw(
1415       Told
1416       Resolved
1417       Starts
1418       Started
1419       Due
1420     );
1421
1422     #Run through each field in this list. update the value if apropriate
1423     foreach my $field (@date_fields) {
1424         my ( $code, $msg );
1425
1426         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1427
1428         #If it's something other than just whitespace
1429         if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1430             $DateObj->Set(
1431                 Format => 'unknown',
1432                 Value  => $ARGSRef->{ $field . '_Date' }
1433             );
1434             my $obj = $field . "Obj";
1435             if ( ( defined $DateObj->Unix )
1436                 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1437             {
1438                 my $method = "Set$field";
1439                 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1440                 push @results, "$msg";
1441             }
1442         }
1443     }
1444
1445     # }}}
1446     return (@results);
1447 }
1448
1449 # }}}
1450
1451 # {{{ sub ProcessTicketLinks
1452
1453 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1454
1455 Returns an array of results messages.
1456
1457 =cut
1458
1459 sub ProcessTicketLinks {
1460     my %args = ( TicketObj => undef,
1461                  ARGSRef   => undef,
1462                  @_ );
1463
1464     my $Ticket  = $args{'TicketObj'};
1465     my $ARGSRef = $args{'ARGSRef'};
1466
1467
1468     my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1469                                        ARGSRef => $ARGSRef);
1470
1471     #Merge if we need to
1472     if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1473         my ( $val, $msg ) =
1474           $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1475         push @results, $msg;
1476     }
1477
1478     return (@results);
1479 }
1480
1481 # }}}
1482
1483 sub ProcessRecordLinks {
1484     my %args = ( RecordObj => undef,
1485                  ARGSRef   => undef,
1486                  @_ );
1487
1488     my $Record  = $args{'RecordObj'};
1489     my $ARGSRef = $args{'ARGSRef'};
1490
1491     my (@results);
1492
1493     # Delete links that are gone gone gone.
1494     foreach my $arg ( keys %$ARGSRef ) {
1495         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1496             my $base   = $1;
1497             my $type   = $2;
1498             my $target = $3;
1499
1500             push @results,
1501               "Trying to delete: Base: $base Target: $target  Type $type";
1502             my ( $val, $msg ) = $Record->DeleteLink( Base   => $base,
1503                                                      Type   => $type,
1504                                                      Target => $target );
1505
1506             push @results, $msg;
1507
1508         }
1509
1510     }
1511
1512     my @linktypes = qw( DependsOn MemberOf RefersTo );
1513
1514     foreach my $linktype (@linktypes) {
1515         if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
1516             for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
1517                 $luri =~ s/\s*$//;    # Strip trailing whitespace
1518                 my ( $val, $msg ) = $Record->AddLink( Target => $luri,
1519                                                       Type   => $linktype );
1520                 push @results, $msg;
1521             }
1522         }
1523         if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1524
1525             for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1526                 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1527                                                       Type => $linktype );
1528
1529                 push @results, $msg;
1530             }
1531         }
1532     }
1533
1534     return (@results);
1535 }
1536
1537
1538 =head2 _UploadedFile ( $arg );
1539
1540 Takes a CGI parameter name; if a file is uploaded under that name,
1541 return a hash reference suitable for AddCustomFieldValue's use:
1542 C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
1543
1544 Returns C<undef> if no files were uploaded in the C<$arg> field.
1545
1546 =cut
1547
1548 sub _UploadedFile {
1549     my $arg = shift;
1550     my $cgi_object = $m->cgi_object;
1551     my $fh = $cgi_object->upload($arg) or return undef;
1552     my $upload_info = $cgi_object->uploadInfo($fh);
1553
1554     my $filename = "$fh";
1555     $filename =~ s#^.*[\\/]##;
1556     binmode($fh);
1557
1558     return {
1559         Value => $filename,
1560         LargeContent => do { local $/; scalar <$fh> },
1561         ContentType => $upload_info->{'Content-Type'},
1562     };
1563 }
1564
1565 eval "require RT::Interface::Web_Vendor";
1566 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1567 eval "require RT::Interface::Web_Local";
1568 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});
1569
1570 1;