rt/lib/RT/Interface/Web.pm

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