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         $MIMEObj->make_multipart;
 293         $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}};
 294     }
 295
 296     my %create_args = (
 297         Type            => $ARGS{'Type'} || 'ticket',
 298         Queue           => $ARGS{'Queue'},
 299         Owner           => $ARGS{'Owner'},
 300         InitialPriority => $ARGS{'InitialPriority'},
 301         FinalPriority   => $ARGS{'FinalPriority'},
 302         TimeLeft        => $ARGS{'TimeLeft'},
 303         TimeEstimated        => $ARGS{'TimeEstimated'},
 304         TimeWorked      => $ARGS{'TimeWorked'},
 305         Requestor       => \@Requestors,
 306         Cc              => \@Cc,
 307         AdminCc         => \@AdminCc,
 308         Subject         => $ARGS{'Subject'},
 309         Status          => $ARGS{'Status'},
 310         Due             => $due->ISO,
 311         Starts          => $starts->ISO,
 312         MIMEObj         => $MIMEObj
 313     );
 314     foreach my $arg (keys %ARGS) {
 315             my $cfid = $1;
 316
 317             next if ($arg =~ /-Magic$/);
 318        #Object-RT::Ticket--CustomField-3-Values
 319         if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
 320             $create_args{$arg} = $ARGS{$arg};
 321         }
 322         elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
 323             my $cfid = $1;
 324             my $cf = RT::CustomField->new( $session{'CurrentUser'});
 325             $cf->Load($cfid);
 326
 327             if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
 328                 $ARGS{$arg} =~ s/\r\n/\n/g;
 329                 $ARGS{$arg} = [split('\n', $ARGS{$arg})];
 330             }
 331
 332             if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
 333                 $ARGS{$arg} =~ s/\r//g;
 334             }
 335
 336             if ( $arg =~ /-Upload$/ ) {
 337                 $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
 338             }
 339             else {
 340                 $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
 341             }
 342         }
 343     }
 344
 345
 346     # XXX TODO This code should be about six lines. and badly needs refactoring.
 347
 348     # {{{ turn new link lists into arrays, and pass in the proper arguments
 349     my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
 350
 351     foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
 352         $luri =~ s/\s*$//;    # Strip trailing whitespace
 353         push @dependson, $luri;
 354     }
 355     $create_args{'DependsOn'} = \@dependson;
 356
 357     foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
 358         push @dependedonby, $luri;
 359     }
 360     $create_args{'DependedOnBy'} = \@dependedonby;
 361
 362     foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
 363         $luri =~ s/\s*$//;    # Strip trailing whitespace
 364         push @parents, $luri;
 365     }
 366     $create_args{'Parents'} = \@parents;
 367
 368     foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
 369         push @children, $luri;
 370     }
 371     $create_args{'Children'} = \@children;
 372
 373     foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
 374         $luri =~ s/\s*$//;    # Strip trailing whitespace
 375         push @refersto, $luri;
 376     }
 377     $create_args{'RefersTo'} = \@refersto;
 378
 379     foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
 380         push @referredtoby, $luri;
 381     }
 382     $create_args{'ReferredToBy'} = \@referredtoby;
 383     # }}}
 384
 385
 386     my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
 387     unless ( $id && $Trans ) {
 388         Abort($ErrMsg);
 389     }
 390
 391     push ( @Actions, split("\n", $ErrMsg) );
 392     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
 393         Abort( "No permission to view newly created ticket #"
 394             . $Ticket->id . "." );
 395     }
 396     return ( $Ticket, @Actions );
 397
 398 }
 399
 400 # }}}
 401
 402 # {{{ sub LoadTicket - loads a ticket
 403
 404 =head2  LoadTicket id
 405
 406 Takes a ticket id as its only variable. if it's handed an array, it takes
 407 the first value.
 408
 409 Returns an RT::Ticket object as the current user.
 410
 411 =cut
 412
 413 sub LoadTicket {
 414     my $id = shift;
 415
 416     if ( ref($id) eq "ARRAY" ) {
 417         $id = $id->[0];
 418     }
 419
 420     unless ($id) {
 421         Abort("No ticket specified");
 422     }
 423
 424     my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 425     $Ticket->Load($id);
 426     unless ( $Ticket->id ) {
 427         Abort("Could not load ticket $id");
 428     }
 429     return $Ticket;
 430 }
 431
 432 # }}}
 433
 434 # {{{ sub ProcessUpdateMessage
 435
 436 sub ProcessUpdateMessage {
 437
 438     #TODO document what else this takes.
 439     my %args = (
 440         ARGSRef   => undef,
 441         Actions   => undef,
 442         TicketObj => undef,
 443         @_
 444     );
 445
 446     #Make the update content have no 'weird' newlines in it
 447     if (   $args{ARGSRef}->{'UpdateTimeWorked'}
 448         || $args{ARGSRef}->{'UpdateContent'}
 449         || $args{ARGSRef}->{'UpdateAttachments'} )
 450     {
 451
 452         if (
 453             $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
 454         {
 455             $args{ARGSRef}->{'UpdateSubject'} = undef;
 456         }
 457
 458         my $Message = MakeMIMEEntity(
 459             Subject => $args{ARGSRef}->{'UpdateSubject'},
 460             Body    => $args{ARGSRef}->{'UpdateContent'},
 461         );
 462
 463         $Message->head->add( 'Message-ID' =>
 464               "<rt-"
 465               . $RT::VERSION . "-"
 466               . $$ . "-"
 467               . CORE::time() . "-"
 468               . int(rand(2000)) . "."
 469               . $args{'TicketObj'}->id . "-"
 470               . "0" . "-"  # Scrip
 471               . "0" . "@"  # Email sent
 472               . $RT::Organization
 473               . ">" );
 474         my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
 475         if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
 476             $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
 477         }
 478         else {
 479             $old_txn = $args{TicketObj}->Transactions->First();
 480         }
 481
 482         if ( $old_txn->Message && $old_txn->Message->First ) {
 483             my @in_reply_to = split(/\s+/m, $old_txn->Message->First->GetHeader('In-Reply-To') || '');
 484             my @references = split(/\s+/m, $old_txn->Message->First->GetHeader('References') || '' );
 485             my @msgid = split(/\s+/m,$old_txn->Message->First->GetHeader('Message-ID') || '');
 486             my @rtmsgid = split(/\s+/m,$old_txn->Message->First->GetHeader('RT-Message-ID') || '');
 487
 488             $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
 489             $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
 490         }
 491
 492     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
 493         $Message->make_multipart;
 494         $Message->add_part($_)
 495           foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
 496     }
 497
 498     ## TODO: Implement public comments
 499     if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
 500         my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(
 501             CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 502             BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 503             MIMEObj      => $Message,
 504             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 505         );
 506         push( @{ $args{Actions} }, $Description );
 507         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 508     }
 509     elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
 510         my ( $Transaction, $Description, $Object ) =
 511           $args{TicketObj}->Correspond(
 512             CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 513             BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 514             MIMEObj      => $Message,
 515             TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 516           );
 517         push( @{ $args{Actions} }, $Description );
 518         $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 519     }
 520     else {
 521         push(
 522             @{ $args{'Actions'} },
 523             loc("Update type was neither correspondence nor comment.") . " "
 524               . loc("Update not recorded.")
 525         );
 526     }
 527 }
 528 }
 529
 530 # }}}
 531
 532 # {{{ sub MakeMIMEEntity
 533
 534 =head2 MakeMIMEEntity PARAMHASH
 535
 536 Takes a paramhash Subject, Body and AttachmentFieldName.
 537
 538   Returns a MIME::Entity.
 539
 540 =cut
 541
 542 sub MakeMIMEEntity {
 543
 544     #TODO document what else this takes.
 545     my %args = (
 546         Subject             => undef,
 547         From                => undef,
 548         Cc                  => undef,
 549         Body                => undef,
 550         AttachmentFieldName => undef,
 551 #        map Encode::encode_utf8($_), @_,
 552         @_,
 553     );
 554
 555     #Make the update content have no 'weird' newlines in it
 556
 557     $args{'Body'} =~ s/\r\n/\n/gs;
 558     my $Message;
 559     {
 560         # MIME::Head is not happy in utf-8 domain.  This only happens
 561         # when processing an incoming email (so far observed).
 562         no utf8;
 563         use bytes;
 564         $Message = MIME::Entity->build(
 565             Subject => $args{'Subject'} || "",
 566             From    => $args{'From'},
 567             Cc      => $args{'Cc'},
 568             Charset => 'utf8',
 569             Data    => [ $args{'Body'} ]
 570         );
 571     }
 572
 573     my $cgi_object = $m->cgi_object;
 574
 575     if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
 576
 577
 578
 579     use File::Temp qw(tempfile tempdir);
 580
 581     #foreach my $filehandle (@filenames) {
 582
 583     my ( $fh, $temp_file );
 584     for ( 1 .. 10 ) {
 585         # on NFS and NTFS, it is possible that tempfile() conflicts
 586         # with other processes, causing a race condition. we try to
 587         # accommodate this by pausing and retrying.
 588         last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) };
 589         sleep 1;
 590     }
 591
 592     binmode $fh;    #thank you, windows
 593     my ($buffer);
 594     while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
 595         print $fh $buffer;
 596     }
 597
 598     my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 599
 600     # Prefer the cached name first over CGI.pm stringification.
 601     my $filename = $RT::Mason::CGI::Filename;
 602     $filename = "$filehandle" unless defined($filename);
 603
 604     $filename =~ s#^.*[\\/]##;
 605
 606     $Message->attach(
 607         Path     => $temp_file,
 608         Filename => Encode::decode_utf8($filename),
 609         Type     => $uploadinfo->{'Content-Type'},
 610     );
 611     close($fh);
 612
 613     #   }
 614
 615     }
 616
 617     $Message->make_singlepart();
 618     RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
 619
 620     return ($Message);
 621
 622 }
 623
 624 # }}}
 625
 626 # {{{ sub ProcessSearchQuery
 627
 628 =head2 ProcessSearchQuery
 629
 630   Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
 631
 632 TODO Doc exactly what comes in the paramhash
 633
 634
 635 =cut
 636
 637 sub ProcessSearchQuery {
 638     my %args = @_;
 639
 640     ## TODO: The only parameter here is %ARGS.  Maybe it would be
 641     ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
 642     ## instead of $args{ARGS}->{...} ? :)
 643
 644     #Searches are sticky.
 645     if ( defined $session{'tickets'} ) {
 646
 647         # Reset the old search
 648         $session{'tickets'}->GotoFirstItem;
 649     }
 650     else {
 651
 652         # Init a new search
 653         $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
 654     }
 655
 656     #Import a bookmarked search if we have one
 657     if ( defined $args{ARGS}->{'Bookmark'} ) {
 658         $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
 659     }
 660
 661     # {{{ Goto next/prev page
 662     if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
 663         $session{'tickets'}->NextPage;
 664     }
 665     elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
 666         $session{'tickets'}->PrevPage;
 667     }
 668     elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
 669         $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
 670     }
 671
 672     # }}}
 673
 674     # {{{ Deal with limiting the search
 675
 676     if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
 677         $session{'tickets_refresh_interval'} =
 678           $args{ARGS}->{'RefreshSearchInterval'};
 679     }
 680
 681     if ( $args{ARGS}->{'TicketsSortBy'} ) {
 682         $session{'tickets_sort_by'}    = $args{ARGS}->{'TicketsSortBy'};
 683         $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
 684         $session{'tickets'}->OrderBy(
 685             FIELD => $args{ARGS}->{'TicketsSortBy'},
 686             ORDER => $args{ARGS}->{'TicketsSortOrder'}
 687         );
 688     }
 689
 690     # }}}
 691
 692     # {{{ Set the query limit
 693     if ( defined $args{ARGS}->{'RowsPerPage'} ) {
 694         $RT::Logger->debug(
 695             "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
 696
 697         $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
 698         $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
 699     }
 700
 701     # }}}
 702     # {{{ Limit priority
 703     if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
 704         $session{'tickets'}->LimitPriority(
 705             VALUE    => $args{ARGS}->{'ValueOfPriority'},
 706             OPERATOR => $args{ARGS}->{'PriorityOp'}
 707         );
 708     }
 709
 710     # }}}
 711     # {{{ Limit owner
 712     if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
 713         $session{'tickets'}->LimitOwner(
 714             VALUE    => $args{ARGS}->{'ValueOfOwner'},
 715             OPERATOR => $args{ARGS}->{'OwnerOp'}
 716         );
 717     }
 718
 719     # }}}
 720     # {{{ Limit requestor email
 721      if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
 722          $session{'tickets'}->LimitWatcher(
 723              TYPE     => $args{ARGS}->{'WatcherRole'},
 724              VALUE    => $args{ARGS}->{'ValueOfWatcherRole'},
 725              OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
 726
 727         );
 728     }
 729
 730     # }}}
 731     # {{{ Limit Queue
 732     if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
 733         $session{'tickets'}->LimitQueue(
 734             VALUE    => $args{ARGS}->{'ValueOfQueue'},
 735             OPERATOR => $args{ARGS}->{'QueueOp'}
 736         );
 737     }
 738
 739     # }}}
 740     # {{{ Limit Status
 741     if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
 742         if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
 743             foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
 744                 $session{'tickets'}->LimitStatus(
 745                     VALUE    => $value,
 746                     OPERATOR => $args{ARGS}->{'StatusOp'},
 747                 );
 748             }
 749         }
 750         else {
 751             $session{'tickets'}->LimitStatus(
 752                 VALUE    => $args{ARGS}->{'ValueOfStatus'},
 753                 OPERATOR => $args{ARGS}->{'StatusOp'},
 754             );
 755         }
 756
 757     }
 758
 759     # }}}
 760     # {{{ Limit Subject
 761     if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
 762             my $val = $args{ARGS}->{'ValueOfSubject'};
 763         if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
 764             $val = "%".$val."%";
 765         }
 766         $session{'tickets'}->LimitSubject(
 767             VALUE    => $val,
 768             OPERATOR => $args{ARGS}->{'SubjectOp'},
 769         );
 770     }
 771
 772     # }}}
 773     # {{{ Limit Dates
 774     if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
 775         my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
 776         $args{ARGS}->{'DateType'} =~ s/_Date$//;
 777
 778         if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
 779             $session{'tickets'}->LimitTransactionDate(
 780                                             VALUE    => $date,
 781                                             OPERATOR => $args{ARGS}->{'DateOp'},
 782             );
 783         }
 784         else {
 785             $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
 786                                             VALUE => $date,
 787                                             OPERATOR => $args{ARGS}->{'DateOp'},
 788             );
 789         }
 790     }
 791
 792     # }}}
 793     # {{{ Limit Content
 794     if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
 795         my $val = $args{ARGS}->{'ValueOfAttachmentField'};
 796         if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
 797             $val = "%".$val."%";
 798         }
 799         $session{'tickets'}->Limit(
 800             FIELD   => $args{ARGS}->{'AttachmentField'},
 801             VALUE    => $val,
 802             OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
 803         );
 804     }
 805
 806     # }}}
 807
 808  # {{{ Limit CustomFields
 809
 810     foreach my $arg ( keys %{ $args{ARGS} } ) {
 811         my $id;
 812         if ( $arg =~ /^CustomField(\d+)$/ ) {
 813             $id = $1;
 814         }
 815         else {
 816             next;
 817         }
 818         next unless ( $args{ARGS}->{$arg} );
 819
 820         my $form = $args{ARGS}->{$arg};
 821         my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
 822         foreach my $value ( ref($form) ? @{$form} : ($form) ) {
 823             my $quote = 1;
 824             if ($oper =~ /like/i) {
 825                 $value = "%".$value."%";
 826             }
 827             if ( $value =~ /^null$/i ) {
 828
 829                 #Don't quote the string 'null'
 830                 $quote = 0;
 831
 832                 # Convert the operator to something apropriate for nulls
 833                 $oper = 'IS'     if ( $oper eq '=' );
 834                 $oper = 'IS NOT' if ( $oper eq '!=' );
 835             }
 836             $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
 837                                                    OPERATOR    => $oper,
 838                                                    QUOTEVALUE  => $quote,
 839                                                    VALUE       => $value );
 840         }
 841     }
 842
 843     # }}}
 844
 845
 846 }
 847
 848 # }}}
 849
 850 # {{{ sub ParseDateToISO
 851
 852 =head2 ParseDateToISO
 853
 854 Takes a date in an arbitrary format.
 855 Returns an ISO date and time in GMT
 856
 857 =cut
 858
 859 sub ParseDateToISO {
 860     my $date = shift;
 861
 862     my $date_obj = RT::Date->new($session{'CurrentUser'});
 863     $date_obj->Set(
 864         Format => 'unknown',
 865         Value  => $date
 866     );
 867     return ( $date_obj->ISO );
 868 }
 869
 870 # }}}
 871
 872 # {{{ sub ProcessACLChanges
 873
 874 sub ProcessACLChanges {
 875     my $ARGSref = shift;
 876
 877     my %ARGS     = %$ARGSref;
 878
 879     my ( $ACL, @results );
 880
 881
 882     foreach my $arg (keys %ARGS) {
 883         if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
 884             my $principal_id = $1;
 885             my $object_type = $2;
 886             my $object_id = $3;
 887             my $rights = $ARGS{$arg};
 888
 889             my $principal = RT::Principal->new($session{'CurrentUser'});
 890             $principal->Load($principal_id);
 891
 892             my $obj;
 893
 894              if ($object_type eq 'RT::System') {
 895                 $obj = $RT::System;
 896             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
 897                 $obj = $object_type->new($session{'CurrentUser'});
 898                 $obj->Load($object_id);
 899             } else {
 900                 push (@results, loc("System Error"). ': '.
 901                                 loc("Rights could not be granted for [_1]", $object_type));
 902                 next;
 903             }
 904
 905             my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
 906             foreach my $right (@rights) {
 907                 next unless ($right);
 908                 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
 909                 push (@results, $msg);
 910             }
 911         }
 912        elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
 913             my $principal_id = $1;
 914             my $object_type = $2;
 915             my $object_id = $3;
 916             my $right = $4;
 917
 918             my $principal = RT::Principal->new($session{'CurrentUser'});
 919             $principal->Load($principal_id);
 920             next unless ($right);
 921             my $obj;
 922
 923              if ($object_type eq 'RT::System') {
 924                 $obj = $RT::System;
 925             } elsif ($RT::ACE::OBJECT_TYPES{$object_type}) {
 926                 $obj = $object_type->new($session{'CurrentUser'});
 927                 $obj->Load($object_id);
 928             } else {
 929                 push (@results, loc("System Error"). ': '.
 930                                 loc("Rights could not be revoked for [_1]", $object_type));
 931                 next;
 932             }
 933             my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
 934             push (@results, $msg);
 935         }
 936
 937
 938     }
 939
 940     return (@results);
 941
 942     }
 943
 944 # }}}
 945
 946 # {{{ sub UpdateRecordObj
 947
 948 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
 949
 950 @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.
 951
 952 Returns an array of success/failure messages
 953
 954 =cut
 955
 956 sub UpdateRecordObject {
 957     my %args = (
 958         ARGSRef       => undef,
 959         AttributesRef => undef,
 960         Object        => undef,
 961         AttributePrefix => undef,
 962         @_
 963     );
 964
 965     my $Object = $args{'Object'};
 966     my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
 967                                   ARGSRef       => $args{'ARGSRef'},
 968                   AttributePrefix => $args{'AttributePrefix'}
 969                                   );
 970
 971     return (@results);
 972 }
 973
 974 # }}}
 975
 976 # {{{ Sub ProcessCustomFieldUpdates
 977
 978 sub ProcessCustomFieldUpdates {
 979     my %args = (
 980         CustomFieldObj => undef,
 981         ARGSRef        => undef,
 982         @_
 983     );
 984
 985     my $Object  = $args{'CustomFieldObj'};
 986     my $ARGSRef = $args{'ARGSRef'};
 987
 988     my @attribs = qw( Name Type Description Queue SortOrder);
 989     my @results = UpdateRecordObject(
 990         AttributesRef => \@attribs,
 991         Object        => $Object,
 992         ARGSRef       => $ARGSRef
 993     );
 994
 995     if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
 996
 997         my ( $addval, $addmsg ) = $Object->AddValue(
 998             Name =>
 999               $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
1000             Description => $ARGSRef->{ "CustomField-"
1001                   . $Object->Id
1002                   . "-AddValue-Description" },
1003             SortOrder => $ARGSRef->{ "CustomField-"
1004                   . $Object->Id
1005                   . "-AddValue-SortOrder" },
1006         );
1007         push ( @results, $addmsg );
1008     }
1009     my @delete_values = (
1010         ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
1011           'ARRAY' )
1012       ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
1013       : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
1014     foreach my $id (@delete_values) {
1015         next unless defined $id;
1016         my ( $err, $msg ) = $Object->DeleteValue($id);
1017         push ( @results, $msg );
1018     }
1019
1020     my $vals = $Object->Values();
1021     while (my $cfv = $vals->Next()) {
1022         if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
1023             if ($cfv->SortOrder != $so) {
1024                 my ( $err, $msg ) = $cfv->SetSortOrder($so);
1025                 push ( @results, $msg );
1026             }
1027         }
1028     }
1029
1030     return (@results);
1031 }
1032
1033 # }}}
1034
1035 # {{{ sub ProcessTicketBasics
1036
1037 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1038
1039 Returns an array of results messages.
1040
1041 =cut
1042
1043 sub ProcessTicketBasics {
1044
1045     my %args = (
1046         TicketObj => undef,
1047         ARGSRef   => undef,
1048         @_
1049     );
1050
1051     my $TicketObj = $args{'TicketObj'};
1052     my $ARGSRef   = $args{'ARGSRef'};
1053
1054     # {{{ Set basic fields
1055     my @attribs = qw(
1056       Subject
1057       FinalPriority
1058       Priority
1059       TimeEstimated
1060       TimeWorked
1061       TimeLeft
1062       Type
1063       Status
1064       Queue
1065     );
1066
1067     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
1068         my $tempqueue = RT::Queue->new($RT::SystemUser);
1069         $tempqueue->Load( $ARGSRef->{'Queue'} );
1070         if ( $tempqueue->id ) {
1071             $ARGSRef->{'Queue'} = $tempqueue->Id();
1072         }
1073     }
1074
1075
1076    # Status isn't a field that can be set to a null value.
1077    # RT core complains if you try
1078     delete $ARGSRef->{'Status'} unless ($ARGSRef->{'Status'});
1079
1080     my @results = UpdateRecordObject(
1081         AttributesRef => \@attribs,
1082         Object        => $TicketObj,
1083         ARGSRef       => $ARGSRef
1084     );
1085
1086     # We special case owner changing, so we can use ForceOwnerChange
1087     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1088         my ($ChownType);
1089         if ( $ARGSRef->{'ForceOwnerChange'} ) {
1090             $ChownType = "Force";
1091         }
1092         else {
1093             $ChownType = "Give";
1094         }
1095
1096         my ( $val, $msg ) =
1097           $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1098         push ( @results, $msg );
1099     }
1100
1101     # }}}
1102
1103     return (@results);
1104 }
1105
1106 # }}}
1107
1108 sub ProcessTicketCustomFieldUpdates {
1109     my %args = @_;
1110     $args{'Object'} = delete $args{'TicketObj'};
1111     my $ARGSRef = { %{ $args{'ARGSRef'} } };
1112
1113     # Build up a list of objects that we want to work with
1114     my %custom_fields_to_mod;
1115     foreach my $arg ( keys %$ARGSRef ) {
1116         if ( $arg =~ /^Ticket-(\d+-.*)/) {
1117             $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
1118         }
1119         elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
1120             $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
1121         }
1122     }
1123
1124     return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
1125 }
1126
1127 sub ProcessObjectCustomFieldUpdates {
1128     my %args = @_;
1129     my $ARGSRef = $args{'ARGSRef'};
1130     my @results;
1131
1132     # Build up a list of objects that we want to work with
1133     my %custom_fields_to_mod;
1134     foreach my $arg ( keys %$ARGSRef ) {
1135         if ( $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-/ ) {
1136             # For each of those objects, find out what custom fields we want to work with.
1137             $custom_fields_to_mod{$1}{$2 || $args{'Object'}->Id}{$3} = 1;
1138         }
1139     }
1140
1141     # For each of those objects
1142     foreach my $class ( keys %custom_fields_to_mod ) {
1143         foreach my $id ( keys %{$custom_fields_to_mod{$class}} ) {
1144             my $Object = $args{'Object'};
1145             if (!$Object or ref($Object) ne $class or $Object->id != $id) {
1146                 $Object = $class->new( $session{'CurrentUser'} );
1147                 $Object->Load($id);
1148         }
1149
1150             # For each custom field
1151             foreach my $cf ( keys %{ $custom_fields_to_mod{$class}{$id} } ) {
1152             my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
1153             $CustomFieldObj->LoadById($cf);
1154
1155                 foreach my $arg ( keys %{$ARGSRef} ) {
1156                     # Only interested in args for the current CF:
1157                     next unless ( $arg =~ /^Object-$class-(?:$id)?-CustomField-$cf-/ );
1158
1159                     # since http won't pass in a form element with a null value, we need
1160                     # to fake it
1161                     if ($arg =~ /^(.*?)-Values-Magic$/ ) {
1162                         # We don't care about the magic, if there's really a values element;
1163                         next if ($ARGSRef->{$1.'-Value'} || $ARGSRef->{$1.'-Values'}) ;
1164
1165                         # "Empty" values does not mean anything for Image and Binary fields
1166                         next if $CustomFieldObj->Type =~ /^(?:Image|Binary)$/;
1167
1168                         $arg = $1."-Values";
1169                         $ARGSRef->{$1."-Values"} = undef;
1170
1171                     }
1172                     my @values = ();
1173                     if (ref( $ARGSRef->{$arg} ) eq 'ARRAY' ) {
1174                         @values = @{ $ARGSRef->{$arg} };
1175                     } elsif ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
1176                         @values = ($ARGSRef->{$arg});
1177                     } else {
1178                         @values = split /\n/, $ARGSRef->{$arg};
1179                     }
1180
1181                     if ( ($CustomFieldObj->Type eq 'Freeform'
1182                           && ! $CustomFieldObj->SingleValue) ||
1183                           $CustomFieldObj->Type =~ /text/i) {
1184                         foreach my $val (@values) {
1185                             $val =~ s/\r//g;
1186                         }
1187                     }
1188
1189                     if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
1190                         foreach my $value (@values) {
1191                             next unless length($value);
1192                             my ( $val, $msg ) = $Object->AddCustomFieldValue(
1193                                 Field => $cf,
1194                                 Value => $value
1195                             );
1196                             push ( @results, $msg );
1197                         }
1198                     }
1199                     elsif ( $arg =~ /-Upload$/ ) {
1200                         my $value_hash = _UploadedFile($arg) or next;
1201
1202                         my ( $val, $msg ) = $Object->AddCustomFieldValue(
1203                             %$value_hash,
1204                             Field => $cf,
1205                         );
1206                         push ( @results, $msg );
1207                     }
1208                     elsif ( $arg =~ /-DeleteValues$/ ) {
1209                         foreach my $value (@values) {
1210                             next unless length($value);
1211                             my ( $val, $msg ) = $Object->DeleteCustomFieldValue(
1212                                 Field => $cf,
1213                                 Value => $value
1214                             );
1215                             push ( @results, $msg );
1216                         }
1217                     }
1218                     elsif ( $arg =~ /-DeleteValueIds$/ ) {
1219                         foreach my $value (@values) {
1220                             next unless length($value);
1221                             my ( $val, $msg ) = $Object->DeleteCustomFieldValue(
1222                                 Field => $cf,
1223                                 ValueId => $value,
1224                             );
1225                             push ( @results, $msg );
1226                         }
1227                     }
1228                     elsif ( $arg =~ /-Values$/ and !$CustomFieldObj->Repeated) {
1229                         my $cf_values = $Object->CustomFieldValues($cf);
1230
1231                         my %values_hash;
1232                         foreach my $value (@values) {
1233                             next unless length($value);
1234
1235                             # build up a hash of values that the new set has
1236                             $values_hash{$value} = 1;
1237
1238                             unless ( $cf_values->HasEntry($value) ) {
1239                                 my ( $val, $msg ) = $Object->AddCustomFieldValue(
1240                                     Field => $cf,
1241                                     Value => $value
1242                                 );
1243                                 push ( @results, $msg );
1244                             }
1245
1246                         }
1247                         while ( my $cf_value = $cf_values->Next ) {
1248                             unless ( $values_hash{ $cf_value->Content } == 1 ) {
1249                                 my ( $val, $msg ) = $Object->DeleteCustomFieldValue(
1250                                     Field => $cf,
1251                                     Value => $cf_value->Content
1252                                 );
1253                                 push ( @results, $msg);
1254
1255                             }
1256                         }
1257                     }
1258                     elsif ( $arg =~ /-Values$/ ) {
1259                         my $cf_values = $Object->CustomFieldValues($cf);
1260
1261                     # keep everything up to the point of difference, delete the rest
1262                     my $delete_flag;
1263                     foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1264                         if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1265                             shift @values;
1266                             next;
1267                         }
1268
1269                         $delete_flag ||= 1;
1270                         $old_cf->Delete;
1271                     }
1272
1273                     # now add/replace extra things, if any
1274                     foreach my $value (@values) {
1275                             my ( $val, $msg ) = $Object->AddCustomFieldValue(
1276                             Field => $cf,
1277                             Value => $value
1278                         );
1279                         push ( @results, $msg );
1280                     }
1281                 }
1282                     else {
1283                         push ( @results, loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]", $cf->Name, $class, $Object->id ) );
1284                     }
1285                 }
1286             }
1287             return (@results);
1288         }
1289     }
1290 }
1291
1292 # {{{ sub ProcessTicketWatchers
1293
1294 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1295
1296 Returns an array of results messages.
1297
1298 =cut
1299
1300 sub ProcessTicketWatchers {
1301     my %args = (
1302         TicketObj => undef,
1303         ARGSRef   => undef,
1304         @_
1305     );
1306     my (@results);
1307
1308     my $Ticket  = $args{'TicketObj'};
1309     my $ARGSRef = $args{'ARGSRef'};
1310
1311     # {{{ Munge watchers
1312
1313     foreach my $key ( keys %$ARGSRef ) {
1314
1315         # {{{ Delete deletable watchers
1316         if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ )  ) {
1317             my ( $code, $msg ) =
1318                 $Ticket->DeleteWatcher(PrincipalId => $2,
1319                                        Type => $1);
1320             push @results, $msg;
1321         }
1322
1323         # Delete watchers in the simple style demanded by the bulk manipulator
1324         elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1325             my ( $code, $msg ) = $Ticket->DeleteWatcher( Email => $ARGSRef->{$key}, Type => $1 );
1326             push @results, $msg;
1327         }
1328
1329         # }}}
1330
1331         # Add new wathchers by email address
1332         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1333             and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1334         {
1335
1336             #They're in this order because otherwise $1 gets clobbered :/
1337             my ( $code, $msg ) = $Ticket->AddWatcher(
1338                 Type  => $ARGSRef->{$key},
1339                 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1340             );
1341             push @results, $msg;
1342         }
1343
1344         #Add requestors in the simple style demanded by the bulk manipulator
1345         elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1346             my ( $code, $msg ) = $Ticket->AddWatcher(
1347                 Type  => $1,
1348                 Email => $ARGSRef->{$key}
1349             );
1350             push @results, $msg;
1351         }
1352
1353         # Add new  watchers by owner
1354         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1355             and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
1356
1357             #They're in this order because otherwise $1 gets clobbered :/
1358             my ( $code, $msg ) =
1359               $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1360             push @results, $msg;
1361         }
1362     }
1363
1364     # }}}
1365
1366     return (@results);
1367 }
1368
1369 # }}}
1370
1371 # {{{ sub ProcessTicketDates
1372
1373 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1374
1375 Returns an array of results messages.
1376
1377 =cut
1378
1379 sub ProcessTicketDates {
1380     my %args = (
1381         TicketObj => undef,
1382         ARGSRef   => undef,
1383         @_
1384     );
1385
1386     my $Ticket  = $args{'TicketObj'};
1387     my $ARGSRef = $args{'ARGSRef'};
1388
1389     my (@results);
1390
1391     # {{{ Set date fields
1392     my @date_fields = qw(
1393       Told
1394       Resolved
1395       Starts
1396       Started
1397       Due
1398     );
1399
1400     #Run through each field in this list. update the value if apropriate
1401     foreach my $field (@date_fields) {
1402         my ( $code, $msg );
1403
1404         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1405
1406         #If it's something other than just whitespace
1407         if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1408             $DateObj->Set(
1409                 Format => 'unknown',
1410                 Value  => $ARGSRef->{ $field . '_Date' }
1411             );
1412             my $obj = $field . "Obj";
1413             if ( ( defined $DateObj->Unix )
1414                 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1415             {
1416                 my $method = "Set$field";
1417                 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1418                 push @results, "$msg";
1419             }
1420         }
1421     }
1422
1423     # }}}
1424     return (@results);
1425 }
1426
1427 # }}}
1428
1429 # {{{ sub ProcessTicketLinks
1430
1431 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1432
1433 Returns an array of results messages.
1434
1435 =cut
1436
1437 sub ProcessTicketLinks {
1438     my %args = ( TicketObj => undef,
1439                  ARGSRef   => undef,
1440                  @_ );
1441
1442     my $Ticket  = $args{'TicketObj'};
1443     my $ARGSRef = $args{'ARGSRef'};
1444
1445
1446     my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
1447                                        ARGSRef => $ARGSRef);
1448
1449     #Merge if we need to
1450     if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1451         my ( $val, $msg ) =
1452           $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1453         push @results, $msg;
1454     }
1455
1456     return (@results);
1457 }
1458
1459 # }}}
1460
1461 sub ProcessRecordLinks {
1462     my %args = ( RecordObj => undef,
1463                  ARGSRef   => undef,
1464                  @_ );
1465
1466     my $Record  = $args{'RecordObj'};
1467     my $ARGSRef = $args{'ARGSRef'};
1468
1469     my (@results);
1470
1471     # Delete links that are gone gone gone.
1472     foreach my $arg ( keys %$ARGSRef ) {
1473         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1474             my $base   = $1;
1475             my $type   = $2;
1476             my $target = $3;
1477
1478             push @results,
1479               "Trying to delete: Base: $base Target: $target  Type $type";
1480             my ( $val, $msg ) = $Record->DeleteLink( Base   => $base,
1481                                                      Type   => $type,
1482                                                      Target => $target );
1483
1484             push @results, $msg;
1485
1486         }
1487
1488     }
1489
1490     my @linktypes = qw( DependsOn MemberOf RefersTo );
1491
1492     foreach my $linktype (@linktypes) {
1493         if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
1494             for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
1495                 $luri =~ s/\s*$//;    # Strip trailing whitespace
1496                 my ( $val, $msg ) = $Record->AddLink( Target => $luri,
1497                                                       Type   => $linktype );
1498                 push @results, $msg;
1499             }
1500         }
1501         if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
1502
1503             for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
1504                 my ( $val, $msg ) = $Record->AddLink( Base => $luri,
1505                                                       Type => $linktype );
1506
1507                 push @results, $msg;
1508             }
1509         }
1510     }
1511
1512     return (@results);
1513 }
1514
1515
1516 =head2 _UploadedFile ( $arg );
1517
1518 Takes a CGI parameter name; if a file is uploaded under that name,
1519 return a hash reference suitable for AddCustomFieldValue's use:
1520 C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
1521
1522 Returns C<undef> if no files were uploaded in the C<$arg> field.
1523
1524 =cut
1525
1526 sub _UploadedFile {
1527     my $arg = shift;
1528     my $cgi_object = $m->cgi_object;
1529     my $fh = $cgi_object->upload($arg) or return undef;
1530     my $upload_info = $cgi_object->uploadInfo($fh);
1531
1532     my $filename = "$fh";
1533     $filename =~ s#^.*[\\/]##;
1534     binmode($fh);
1535
1536     return {
1537         Value => $filename,
1538         LargeContent => do { local $/; scalar <$fh> },
1539         ContentType => $upload_info->{'Content-Type'},
1540     };
1541 }
1542
1543 eval "require RT::Interface::Web_Vendor";
1544 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1545 eval "require RT::Interface::Web_Local";
1546 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});
1547
1548 1;