rt/lib/RT/Interface/Web.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   7 # This work is made available to you under the terms of Version 2 of
   8 # the GNU General Public License. A copy of that license should have
   9 # been provided with this software, but in any event can be snarfed
  10 # from www.gnu.org.
  11 #
  12 # This work is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # Unless otherwise specified, all modifications, corrections or
  18 # extensions to this work which alter its source code become the
  19 # property of Best Practical Solutions, LLC when submitted for
  20 # inclusion in the work.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
  25
  26 ## This is a library of static subs to be used by the Mason web
  27 ## interface to RT
  28
  29
  30 =head1 NAME
  31
  32 RT::Interface::Web
  33
  34 =begin testing
  35
  36 use_ok(RT::Interface::Web);
  37
  38 =end testing
  39
  40 =cut
  41
  42
  43 package RT::Interface::Web;
  44 use strict;
  45
  46
  47
  48
  49
  50 # {{{ sub NewApacheHandler
  51
  52 =head2 NewApacheHandler
  53
  54   Takes extra options to pass to HTML::Mason::ApacheHandler->new
  55   Returns a new Mason::ApacheHandler object
  56
  57 =cut
  58
  59 sub NewApacheHandler {
  60     require HTML::Mason::ApacheHandler;
  61     my $ah = new HTML::Mason::ApacheHandler(
  62
  63         comp_root                    => [
  64             [ local    => $RT::MasonLocalComponentRoot ],
  65             [ standard => $RT::MasonComponentRoot ]
  66         ],
  67         args_method => "CGI",
  68         default_escape_flags => 'h',
  69         allow_globals        => [qw(%session)],
  70         data_dir => "$RT::MasonDataDir",
  71         @_
  72     );
  73
  74     $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
  75
  76     return ($ah);
  77 }
  78
  79 # }}}
  80
  81 # {{{ sub NewCGIHandler
  82
  83 =head2 NewCGIHandler
  84
  85   Returns a new Mason::CGIHandler object
  86
  87 =cut
  88
  89 sub NewCGIHandler {
  90     my %args = (
  91         @_
  92     );
  93
  94     my $handler = HTML::Mason::CGIHandler->new(
  95         comp_root                    => [
  96             [ local    => $RT::MasonLocalComponentRoot ],
  97             [ standard => $RT::MasonComponentRoot ]
  98         ],
  99         data_dir => "$RT::MasonDataDir",
 100         default_escape_flags => 'h',
 101         allow_globals        => [qw(%session)]
 102     );
 103
 104
 105     $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
 106
 107
 108     return ($handler);
 109
 110 }
 111 # }}}
 112
 113
 114 # {{{ EscapeUTF8
 115
 116 =head2 EscapeUTF8 SCALARREF
 117
 118 does a css-busting but minimalist escaping of whatever html you're passing in.
 119
 120 =cut
 121
 122 sub EscapeUTF8  {
 123         my  $ref = shift;
 124         my $val = $$ref;
 125         use bytes;
 126         $val =~ s/&/&#38;/g;
 127         $val =~ s/</&lt;/g;
 128         $val =~ s/>/&gt;/g;
 129         $val =~ s/\(/&#40;/g;
 130         $val =~ s/\)/&#41;/g;
 131         $val =~ s/"/&#34;/g;
 132         $val =~ s/'/&#39;/g;
 133         $$ref = $val;
 134         Encode::_utf8_on($$ref);
 135
 136 }
 137
 138 # }}}
 139
 140
 141 package HTML::Mason::Commands;
 142 use strict;
 143 use vars qw/$r $m %session/;
 144
 145
 146 # {{{ loc
 147
 148 =head2 loc ARRAY
 149
 150 loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
 151 with whatever it's called with. If there is no $session{'CurrentUser'},
 152 it creates a temporary user, so we have something to get a localisation handle
 153 through
 154
 155 =cut
 156
 157 sub loc {
 158
 159     if ($session{'CurrentUser'} &&
 160         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 161         return($session{'CurrentUser'}->loc(@_));
 162     }
 163     else  {
 164         my $u = RT::CurrentUser->new($RT::SystemUser);
 165         return ($u->loc(@_));
 166     }
 167 }
 168
 169 # }}}
 170
 171
 172 # {{{ loc_fuzzy
 173
 174 =head2 loc_fuzzy STRING
 175
 176 loc_fuzzy is for handling localizations of messages that may already
 177 contain interpolated variables, typically returned from libraries
 178 outside RT's control.  It takes the message string and extracts the
 179 variable array automatically by matching against the candidate entries
 180 inside the lexicon file.
 181
 182 =cut
 183
 184 sub loc_fuzzy {
 185     my $msg  = shift;
 186
 187     if ($session{'CurrentUser'} &&
 188         UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
 189         return($session{'CurrentUser'}->loc_fuzzy($msg));
 190     }
 191     else  {
 192         my $u = RT::CurrentUser->new($RT::SystemUser);
 193         return ($u->loc_fuzzy($msg));
 194     }
 195 }
 196
 197 # }}}
 198
 199
 200 # {{{ sub Abort
 201 # Error - calls Error and aborts
 202 sub Abort {
 203
 204     if ($session{'ErrorDocument'} &&
 205         $session{'ErrorDocumentType'}) {
 206         $r->content_type($session{'ErrorDocumentType'});
 207         $m->comp($session{'ErrorDocument'} , Why => shift);
 208         $m->abort;
 209     }
 210     else  {
 211         $m->comp("/Elements/Error" , Why => shift);
 212         $m->abort;
 213     }
 214 }
 215
 216 # }}}
 217
 218 # {{{ sub CreateTicket
 219
 220 =head2 CreateTicket ARGS
 221
 222 Create a new ticket, using Mason's %ARGS.  returns @results.
 223
 224 =cut
 225
 226 sub CreateTicket {
 227     my %ARGS = (@_);
 228
 229     my (@Actions);
 230
 231     my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
 232
 233     my $Queue = new RT::Queue( $session{'CurrentUser'} );
 234     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
 235         Abort('Queue not found');
 236     }
 237
 238     unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
 239         Abort('You have no permission to create tickets in that queue.');
 240     }
 241
 242     my $due = new RT::Date( $session{'CurrentUser'} );
 243     $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
 244     my $starts = new RT::Date( $session{'CurrentUser'} );
 245     $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
 246
 247     my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} );
 248     my @Cc         = split ( /\s*,\s*/, $ARGS{'Cc'} );
 249     my @AdminCc    = split ( /\s*,\s*/, $ARGS{'AdminCc'} );
 250
 251     my $MIMEObj = MakeMIMEEntity(
 252         Subject             => $ARGS{'Subject'},
 253         From                => $ARGS{'From'},
 254         Cc                  => $ARGS{'Cc'},
 255         Body                => $ARGS{'Content'},
 256     );
 257
 258     if ($ARGS{'Attachments'}) {
 259         $MIMEObj->make_multipart;
 260         $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}};
 261     }
 262
 263     my %create_args = (
 264         Queue           => $ARGS{'Queue'},
 265         Owner           => $ARGS{'Owner'},
 266         InitialPriority => $ARGS{'InitialPriority'},
 267         FinalPriority   => $ARGS{'FinalPriority'},
 268         TimeLeft        => $ARGS{'TimeLeft'},
 269         TimeEstimated        => $ARGS{'TimeEstimated'},
 270         TimeWorked      => $ARGS{'TimeWorked'},
 271         Requestor       => \@Requestors,
 272         Cc              => \@Cc,
 273         AdminCc         => \@AdminCc,
 274         Subject         => $ARGS{'Subject'},
 275         Status          => $ARGS{'Status'},
 276         Due             => $due->ISO,
 277         Starts          => $starts->ISO,
 278         MIMEObj         => $MIMEObj
 279     );
 280   foreach my $arg (%ARGS) {
 281         if ($arg =~ /^CustomField-(\d+)(.*?)$/) {
 282             next if ($arg =~ /-Magic$/);
 283             $create_args{"CustomField-".$1} = $ARGS{"$arg"};
 284         }
 285     }
 286     my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
 287     unless ( $id && $Trans ) {
 288         Abort($ErrMsg);
 289     }
 290     my @linktypes = qw( DependsOn MemberOf RefersTo );
 291
 292     foreach my $linktype (@linktypes) {
 293         foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) {
 294             $luri =~ s/\s*$//;    # Strip trailing whitespace
 295             my ( $val, $msg ) = $Ticket->AddLink(
 296                 Target => $luri,
 297                 Type   => $linktype
 298             );
 299             push ( @Actions, $msg ) unless ($val);
 300         }
 301
 302         foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) {
 303             my ( $val, $msg ) = $Ticket->AddLink(
 304                 Base => $luri,
 305                 Type => $linktype
 306             );
 307
 308             push ( @Actions, $msg ) unless ($val);
 309         }
 310     }
 311
 312     push ( @Actions, split("\n", $ErrMsg) );
 313     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
 314         Abort( "No permission to view newly created ticket #"
 315             . $Ticket->id . "." );
 316     }
 317     return ( $Ticket, @Actions );
 318
 319 }
 320
 321 # }}}
 322
 323 # {{{ sub LoadTicket - loads a ticket
 324
 325 =head2  LoadTicket id
 326
 327 Takes a ticket id as its only variable. if it's handed an array, it takes
 328 the first value.
 329
 330 Returns an RT::Ticket object as the current user.
 331
 332 =cut
 333
 334 sub LoadTicket {
 335     my $id = shift;
 336
 337     if ( ref($id) eq "ARRAY" ) {
 338         $id = $id->[0];
 339     }
 340
 341     unless ($id) {
 342         Abort("No ticket specified");
 343     }
 344
 345     my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 346     $Ticket->Load($id);
 347     unless ( $Ticket->id ) {
 348         Abort("Could not load ticket $id");
 349     }
 350     return $Ticket;
 351 }
 352
 353 # }}}
 354
 355 # {{{ sub ProcessUpdateMessage
 356
 357 sub ProcessUpdateMessage {
 358
 359     #TODO document what else this takes.
 360     my %args = (
 361         ARGSRef   => undef,
 362         Actions   => undef,
 363         TicketObj => undef,
 364         @_
 365     );
 366
 367     #Make the update content have no 'weird' newlines in it
 368     if ( $args{ARGSRef}->{'UpdateContent'} ) {
 369
 370         if (
 371             $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
 372         {
 373             $args{ARGSRef}->{'UpdateSubject'} = undef;
 374         }
 375
 376         my $Message = MakeMIMEEntity(
 377             Subject             => $args{ARGSRef}->{'UpdateSubject'},
 378             Body                => $args{ARGSRef}->{'UpdateContent'},
 379         );
 380
 381         if ($args{ARGSRef}->{'UpdateAttachments'}) {
 382             $Message->make_multipart;
 383             $Message->add_part($_) foreach values %{$args{ARGSRef}->{'UpdateAttachments'}};
 384         }
 385
 386         ## TODO: Implement public comments
 387         if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
 388             my ( $Transaction, $Description ) = $args{TicketObj}->Comment(
 389                 CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 390                 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 391                 MIMEObj      => $Message,
 392                 TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 393             );
 394             push ( @{ $args{Actions} }, $Description );
 395         }
 396         elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
 397             my ( $Transaction, $Description ) = $args{TicketObj}->Correspond(
 398                 CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 399                 BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 400                 MIMEObj      => $Message,
 401                 TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 402             );
 403             push ( @{ $args{Actions} }, $Description );
 404         }
 405         else {
 406             push ( @{ $args{'Actions'} },
 407                 loc("Update type was neither correspondence nor comment.").
 408                 " ".
 409                 loc("Update not recorded.")
 410             );
 411         }
 412     }
 413 }
 414
 415 # }}}
 416
 417 # {{{ sub MakeMIMEEntity
 418
 419 =head2 MakeMIMEEntity PARAMHASH
 420
 421 Takes a paramhash Subject, Body and AttachmentFieldName.
 422
 423   Returns a MIME::Entity.
 424
 425 =cut
 426
 427 sub MakeMIMEEntity {
 428
 429     #TODO document what else this takes.
 430     my %args = (
 431         Subject             => undef,
 432         From                => undef,
 433         Cc                  => undef,
 434         Body                => undef,
 435         AttachmentFieldName => undef,
 436         map Encode::encode_utf8($_), @_,
 437     );
 438
 439     #Make the update content have no 'weird' newlines in it
 440
 441     $args{'Body'} =~ s/\r\n/\n/gs;
 442     my $Message;
 443     {
 444         # MIME::Head is not happy in utf-8 domain.  This only happens
 445         # when processing an incoming email (so far observed).
 446         no utf8;
 447         use bytes;
 448         $Message = MIME::Entity->build(
 449             Subject => $args{'Subject'} || "",
 450             From    => $args{'From'},
 451             Cc      => $args{'Cc'},
 452             Data    => [ $args{'Body'} ]
 453         );
 454     }
 455
 456     my $cgi_object = $m->cgi_object;
 457
 458     if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
 459
 460
 461
 462     use File::Temp qw(tempfile tempdir);
 463
 464     #foreach my $filehandle (@filenames) {
 465
 466     my ( $fh, $temp_file ) = tempfile();
 467
 468     binmode $fh;    #thank you, windows
 469     my ($buffer);
 470     while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
 471         print $fh $buffer;
 472     }
 473
 474     my $uploadinfo = $cgi_object->uploadInfo($filehandle);
 475
 476     # Prefer the cached name first over CGI.pm stringification.
 477     my $filename = $RT::Mason::CGI::Filename;
 478     $filename = "$filehandle" unless defined($filename);
 479
 480     $filename =~ s#^.*[\\/]##;
 481
 482     $Message->attach(
 483         Path     => $temp_file,
 484         Filename => $filename,
 485         Type     => $uploadinfo->{'Content-Type'},
 486     );
 487     close($fh);
 488
 489     #   }
 490
 491     }
 492
 493     $Message->make_singlepart();
 494     RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
 495
 496     return ($Message);
 497
 498 }
 499
 500 # }}}
 501
 502 # {{{ sub ProcessSearchQuery
 503
 504 =head2 ProcessSearchQuery
 505
 506   Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
 507
 508 TODO Doc exactly what comes in the paramhash
 509
 510
 511 =cut
 512
 513 sub ProcessSearchQuery {
 514     my %args = @_;
 515
 516     ## TODO: The only parameter here is %ARGS.  Maybe it would be
 517     ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
 518     ## instead of $args{ARGS}->{...} ? :)
 519
 520     #Searches are sticky.
 521     if ( defined $session{'tickets'} ) {
 522
 523         # Reset the old search
 524         $session{'tickets'}->GotoFirstItem;
 525     }
 526     else {
 527
 528         # Init a new search
 529         $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
 530     }
 531
 532     #Import a bookmarked search if we have one
 533     if ( defined $args{ARGS}->{'Bookmark'} ) {
 534         $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
 535     }
 536
 537     # {{{ Goto next/prev page
 538     if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
 539         $session{'tickets'}->NextPage;
 540     }
 541     elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
 542         $session{'tickets'}->PrevPage;
 543     }
 544     elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
 545         $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
 546     }
 547
 548     # }}}
 549
 550     # {{{ Deal with limiting the search
 551
 552     if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
 553         $session{'tickets_refresh_interval'} =
 554           $args{ARGS}->{'RefreshSearchInterval'};
 555     }
 556
 557     if ( $args{ARGS}->{'TicketsSortBy'} ) {
 558         $session{'tickets_sort_by'}    = $args{ARGS}->{'TicketsSortBy'};
 559         $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
 560         $session{'tickets'}->OrderBy(
 561             FIELD => $args{ARGS}->{'TicketsSortBy'},
 562             ORDER => $args{ARGS}->{'TicketsSortOrder'}
 563         );
 564     }
 565
 566     # }}}
 567
 568     # {{{ Set the query limit
 569     if ( defined $args{ARGS}->{'RowsPerPage'} ) {
 570         $RT::Logger->debug(
 571             "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
 572
 573         $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
 574         $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
 575     }
 576
 577     # }}}
 578     # {{{ Limit priority
 579     if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
 580         $session{'tickets'}->LimitPriority(
 581             VALUE    => $args{ARGS}->{'ValueOfPriority'},
 582             OPERATOR => $args{ARGS}->{'PriorityOp'}
 583         );
 584     }
 585
 586     # }}}
 587     # {{{ Limit owner
 588     if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
 589         $session{'tickets'}->LimitOwner(
 590             VALUE    => $args{ARGS}->{'ValueOfOwner'},
 591             OPERATOR => $args{ARGS}->{'OwnerOp'}
 592         );
 593     }
 594
 595     # }}}
 596     # {{{ Limit requestor email
 597
 598     if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) {
 599         my $alias = $session{'tickets'}->LimitRequestor(
 600             VALUE    => $args{ARGS}->{'ValueOfRequestor'},
 601             OPERATOR => $args{ARGS}->{'RequestorOp'},
 602         );
 603
 604     }
 605
 606     # }}}
 607     # {{{ Limit Queue
 608     if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
 609         $session{'tickets'}->LimitQueue(
 610             VALUE    => $args{ARGS}->{'ValueOfQueue'},
 611             OPERATOR => $args{ARGS}->{'QueueOp'}
 612         );
 613     }
 614
 615     # }}}
 616     # {{{ Limit Status
 617     if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
 618         if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
 619             foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
 620                 $session{'tickets'}->LimitStatus(
 621                     VALUE    => $value,
 622                     OPERATOR => $args{ARGS}->{'StatusOp'},
 623                 );
 624             }
 625         }
 626         else {
 627             $session{'tickets'}->LimitStatus(
 628                 VALUE    => $args{ARGS}->{'ValueOfStatus'},
 629                 OPERATOR => $args{ARGS}->{'StatusOp'},
 630             );
 631         }
 632
 633     }
 634
 635     # }}}
 636     # {{{ Limit Subject
 637     if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
 638             my $val = $args{ARGS}->{'ValueOfSubject'};
 639         if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
 640             $val = "%".$val."%";
 641         }
 642         $session{'tickets'}->LimitSubject(
 643             VALUE    => $val,
 644             OPERATOR => $args{ARGS}->{'SubjectOp'},
 645         );
 646     }
 647
 648     # }}}
 649     # {{{ Limit Dates
 650     if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
 651         my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
 652         $args{ARGS}->{'DateType'} =~ s/_Date$//;
 653
 654         if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
 655             $session{'tickets'}->LimitTransactionDate(
 656                                             VALUE    => $date,
 657                                             OPERATOR => $args{ARGS}->{'DateOp'},
 658             );
 659         }
 660         else {
 661             $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
 662                                             VALUE => $date,
 663                                             OPERATOR => $args{ARGS}->{'DateOp'},
 664             );
 665         }
 666     }
 667
 668     # }}}
 669     # {{{ Limit Content
 670     if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
 671         my $val = $args{ARGS}->{'ValueOfAttachmentField'};
 672         if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
 673             $val = "%".$val."%";
 674         }
 675         $session{'tickets'}->Limit(
 676             FIELD   => $args{ARGS}->{'AttachmentField'},
 677             VALUE    => $val,
 678             OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
 679         );
 680     }
 681
 682     # }}}
 683
 684  # {{{ Limit CustomFields
 685
 686     foreach my $arg ( keys %{ $args{ARGS} } ) {
 687         my $id;
 688         if ( $arg =~ /^CustomField(\d+)$/ ) {
 689             $id = $1;
 690         }
 691         else {
 692             next;
 693         }
 694         next unless ( $args{ARGS}->{$arg} );
 695
 696         my $form = $args{ARGS}->{$arg};
 697         my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
 698         foreach my $value ( ref($form) ? @{$form} : ($form) ) {
 699             my $quote = 1;
 700             if ($oper =~ /like/i) {
 701                 $value = "%".$value."%";
 702             }
 703             if ( $value =~ /^null$/i ) {
 704
 705                 #Don't quote the string 'null'
 706                 $quote = 0;
 707
 708                 # Convert the operator to something apropriate for nulls
 709                 $oper = 'IS'     if ( $oper eq '=' );
 710                 $oper = 'IS NOT' if ( $oper eq '!=' );
 711             }
 712             $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
 713                                                    OPERATOR    => $oper,
 714                                                    QUOTEVALUE  => $quote,
 715                                                    VALUE       => $value );
 716         }
 717     }
 718
 719     # }}}
 720
 721
 722 }
 723
 724 # }}}
 725
 726 # {{{ sub ParseDateToISO
 727
 728 =head2 ParseDateToISO
 729
 730 Takes a date in an arbitrary format.
 731 Returns an ISO date and time in GMT
 732
 733 =cut
 734
 735 sub ParseDateToISO {
 736     my $date = shift;
 737
 738     my $date_obj = RT::Date->new($session{'CurrentUser'});
 739     $date_obj->Set(
 740         Format => 'unknown',
 741         Value  => $date
 742     );
 743     return ( $date_obj->ISO );
 744 }
 745
 746 # }}}
 747
 748 # {{{ sub Config
 749 # TODO: This might eventually read the cookies, user configuration
 750 # information from the DB, queue configuration information from the
 751 # DB, etc.
 752
 753 sub Config {
 754     my $args = shift;
 755     my $key  = shift;
 756     return $args->{$key} || $RT::WebOptions{$key};
 757 }
 758
 759 # }}}
 760
 761 # {{{ sub ProcessACLChanges
 762
 763 sub ProcessACLChanges {
 764     my $ARGSref = shift;
 765
 766     my %ARGS     = %$ARGSref;
 767
 768     my ( $ACL, @results );
 769
 770
 771     foreach my $arg (keys %ARGS) {
 772         if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
 773             my $principal_id = $1;
 774             my $object_type = $2;
 775             my $object_id = $3;
 776             my $rights = $ARGS{$arg};
 777
 778             my $principal = RT::Principal->new($session{'CurrentUser'});
 779             $principal->Load($principal_id);
 780
 781             my $obj;
 782
 783             if ($object_type eq 'RT::Queue') {
 784                 $obj = RT::Queue->new($session{'CurrentUser'});
 785                 $obj->Load($object_id);
 786             } elsif ($object_type eq 'RT::Group') {
 787                 $obj = RT::Group->new($session{'CurrentUser'});
 788                 $obj->Load($object_id);
 789
 790             } elsif ($object_type eq 'RT::System') {
 791                 $obj = $RT::System;
 792             } else {
 793                 push (@results, loc("System Error").
 794                                 loc("Rights could not be granted for [_1]", $object_type));
 795                 next;
 796             }
 797
 798             my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
 799             foreach my $right (@rights) {
 800                 next unless ($right);
 801                 my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
 802                 push (@results, $msg);
 803             }
 804         }
 805        elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
 806             my $principal_id = $1;
 807             my $object_type = $2;
 808             my $object_id = $3;
 809             my $right = $4;
 810
 811             my $principal = RT::Principal->new($session{'CurrentUser'});
 812             $principal->Load($principal_id);
 813             next unless ($right);
 814             my $obj;
 815
 816             if ($object_type eq 'RT::Queue') {
 817                 $obj = RT::Queue->new($session{'CurrentUser'});
 818                 $obj->Load($object_id);
 819             } elsif ($object_type eq 'RT::Group') {
 820                 $obj = RT::Group->new($session{'CurrentUser'});
 821                 $obj->Load($object_id);
 822
 823             } elsif ($object_type eq 'RT::System') {
 824                 $obj = $RT::System;
 825             } else {
 826                 push (@results, loc("System Error").
 827                                 loc("Rights could not be revoked for [_1]", $object_type));
 828                 next;
 829             }
 830             my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
 831             push (@results, $msg);
 832         }
 833
 834
 835     }
 836
 837     return (@results);
 838
 839     }
 840
 841 # }}}
 842
 843 # {{{ sub UpdateRecordObj
 844
 845 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
 846
 847 @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.
 848
 849 Returns an array of success/failure messages
 850
 851 =cut
 852
 853 sub UpdateRecordObject {
 854     my %args = (
 855         ARGSRef       => undef,
 856         AttributesRef => undef,
 857         Object        => undef,
 858         AttributePrefix => undef,
 859         @_
 860     );
 861
 862     my (@results);
 863
 864     my $object     = $args{'Object'};
 865     my $attributes = $args{'AttributesRef'};
 866     my $ARGSRef    = $args{'ARGSRef'};
 867     foreach my $attribute (@$attributes) {
 868         my $value;
 869         if ( defined $ARGSRef->{$attribute} ) {
 870             $value = $ARGSRef->{$attribute};
 871         }
 872         elsif (
 873               defined( $args{'AttributePrefix'} )
 874               && defined(
 875                   $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
 876               )
 877           ) {
 878             $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
 879
 880         } else {
 881                 next;
 882         }
 883
 884             $value =~ s/\r\n/\n/gs;
 885
 886         if ($value ne $object->$attribute()){
 887
 888               my $method = "Set$attribute";
 889               my ( $code, $msg ) = $object->$method($value);
 890
 891               push @results, loc($attribute) . ': ' . loc_fuzzy($msg);
 892 =for loc
 893                                    "[_1] could not be set to [_2].",       # loc
 894                                    "That is already the current value",    # loc
 895                                    "No value sent to _Set!\n",             # loc
 896                                    "Illegal value for [_1]",               # loc
 897                                    "The new value has been set.",          # loc
 898                                    "No column specified",                  # loc
 899                                    "Immutable field",                      # loc
 900                                    "Nonexistant field?",                   # loc
 901                                    "Invalid data",                         # loc
 902                                    "Couldn't find row",                    # loc
 903                                    "Missing a primary key?: [_1]",         # loc
 904                                    "Found Object",                         # loc
 905 =cut
 906           };
 907     }
 908     return (@results);
 909 }
 910
 911 # }}}
 912
 913 # {{{ Sub ProcessCustomFieldUpdates
 914
 915 sub ProcessCustomFieldUpdates {
 916     my %args = (
 917         CustomFieldObj => undef,
 918         ARGSRef        => undef,
 919         @_
 920     );
 921
 922     my $Object  = $args{'CustomFieldObj'};
 923     my $ARGSRef = $args{'ARGSRef'};
 924
 925     my @attribs = qw( Name Type Description Queue SortOrder);
 926     my @results = UpdateRecordObject(
 927         AttributesRef => \@attribs,
 928         Object        => $Object,
 929         ARGSRef       => $ARGSRef
 930     );
 931
 932     if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
 933
 934         my ( $addval, $addmsg ) = $Object->AddValue(
 935             Name =>
 936               $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
 937             Description => $ARGSRef->{ "CustomField-"
 938                   . $Object->Id
 939                   . "-AddValue-Description" },
 940             SortOrder => $ARGSRef->{ "CustomField-"
 941                   . $Object->Id
 942                   . "-AddValue-SortOrder" },
 943         );
 944         push ( @results, $addmsg );
 945     }
 946     my @delete_values = (
 947         ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
 948           'ARRAY' )
 949       ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
 950       : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
 951     foreach my $id (@delete_values) {
 952         next unless defined $id;
 953         my ( $err, $msg ) = $Object->DeleteValue($id);
 954         push ( @results, $msg );
 955     }
 956     return (@results);
 957 }
 958
 959 # }}}
 960
 961 # {{{ sub ProcessTicketBasics
 962
 963 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 964
 965 Returns an array of results messages.
 966
 967 =cut
 968
 969 sub ProcessTicketBasics {
 970
 971     my %args = (
 972         TicketObj => undef,
 973         ARGSRef   => undef,
 974         @_
 975     );
 976
 977     my $TicketObj = $args{'TicketObj'};
 978     my $ARGSRef   = $args{'ARGSRef'};
 979
 980     # {{{ Set basic fields
 981     my @attribs = qw(
 982       Subject
 983       FinalPriority
 984       Priority
 985       TimeEstimated
 986       TimeWorked
 987       TimeLeft
 988       Status
 989       Queue
 990     );
 991
 992     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
 993         my $tempqueue = RT::Queue->new($RT::SystemUser);
 994         $tempqueue->Load( $ARGSRef->{'Queue'} );
 995         if ( $tempqueue->id ) {
 996             $ARGSRef->{'Queue'} = $tempqueue->Id();
 997         }
 998     }
 999
1000     my @results = UpdateRecordObject(
1001         AttributesRef => \@attribs,
1002         Object        => $TicketObj,
1003         ARGSRef       => $ARGSRef
1004     );
1005
1006     # We special case owner changing, so we can use ForceOwnerChange
1007     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
1008         my ($ChownType);
1009         if ( $ARGSRef->{'ForceOwnerChange'} ) {
1010             $ChownType = "Force";
1011         }
1012         else {
1013             $ChownType = "Give";
1014         }
1015
1016         my ( $val, $msg ) =
1017           $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
1018         push ( @results, $msg );
1019     }
1020
1021     # }}}
1022
1023     return (@results);
1024 }
1025
1026 # }}}
1027
1028 # {{{ Sub ProcessTicketCustomFieldUpdates
1029
1030 sub ProcessTicketCustomFieldUpdates {
1031     my %args = (
1032         ARGSRef => undef,
1033         @_
1034     );
1035
1036     my @results;
1037
1038     my $ARGSRef = $args{'ARGSRef'};
1039
1040     # Build up a list of tickets that we want to work with
1041     my %tickets_to_mod;
1042     my %custom_fields_to_mod;
1043     foreach my $arg ( keys %{$ARGSRef} ) {
1044         if ( $arg =~ /^Ticket-(\d+)-CustomField-(\d+)-/ ) {
1045
1046             # For each of those tickets, find out what custom fields we want to work with.
1047             $custom_fields_to_mod{$1}{$2} = 1;
1048         }
1049     }
1050
1051     # For each of those tickets
1052     foreach my $tick ( keys %custom_fields_to_mod ) {
1053         my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
1054         $Ticket->Load($tick);
1055
1056         # For each custom field
1057         foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) {
1058
1059             my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'});
1060             $CustomFieldObj->LoadById($cf);
1061
1062             foreach my $arg ( keys %{$ARGSRef} ) {
1063                 # since http won't pass in a form element with a null value, we need
1064                 # to fake it
1065                 if ($arg =~ /^(.*?)-Values-Magic$/ ) {
1066                     # We don't care about the magic, if there's really a values element;
1067                     next if (exists $ARGSRef->{$1.'-Values'}) ;
1068
1069                     $arg = $1."-Values";
1070                     $ARGSRef->{$1."-Values"} = undef;
1071
1072                 }
1073                 next unless ( $arg =~ /^Ticket-$tick-CustomField-$cf-/ );
1074                 my @values =
1075                   ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' )
1076                   ? @{ $ARGSRef->{$arg} }
1077                   : ( $ARGSRef->{$arg} );
1078                 if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) {
1079                     foreach my $value (@values) {
1080                         next unless ($value);
1081                         my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1082                             Field => $cf,
1083                             Value => $value
1084                         );
1085                         push ( @results, $msg );
1086                     }
1087                 }
1088                 elsif ( $arg =~ /-DeleteValues$/ ) {
1089                     foreach my $value (@values) {
1090                         next unless ($value);
1091                         my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
1092                             Field => $cf,
1093                             Value => $value
1094                         );
1095                         push ( @results, $msg );
1096                     }
1097                 }
1098                 elsif ( $arg =~ /-Values$/ and $CustomFieldObj->Type !~ /Entry/) {
1099                     my $cf_values = $Ticket->CustomFieldValues($cf);
1100
1101                     my %values_hash;
1102                     foreach my $value (@values) {
1103                         next unless ($value);
1104
1105                         # build up a hash of values that the new set has
1106                         $values_hash{$value} = 1;
1107
1108                         unless ( $cf_values->HasEntry($value) ) {
1109                             my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1110                                 Field => $cf,
1111                                 Value => $value
1112                             );
1113                             push ( @results, $msg );
1114                         }
1115
1116                     }
1117                     while ( my $cf_value = $cf_values->Next ) {
1118                         unless ( $values_hash{ $cf_value->Content } == 1 ) {
1119                             my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue(
1120                                 Field => $cf,
1121                                 Value => $cf_value->Content
1122                             );
1123                             push ( @results, $msg);
1124
1125                         }
1126
1127                     }
1128                 }
1129                 elsif ( $arg =~ /-Values$/ ) {
1130                     my $cf_values = $Ticket->CustomFieldValues($cf);
1131
1132                     # keep everything up to the point of difference, delete the rest
1133                     my $delete_flag;
1134                     foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
1135                         if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
1136                             shift @values;
1137                             next;
1138                         }
1139
1140                         $delete_flag ||= 1;
1141                         $old_cf->Delete;
1142                     }
1143
1144                     # now add/replace extra things, if any
1145                     foreach my $value (@values) {
1146                         my ( $val, $msg ) = $Ticket->AddCustomFieldValue(
1147                             Field => $cf,
1148                             Value => $value
1149                         );
1150                         push ( @results, $msg );
1151                     }
1152                 }
1153                 else {
1154                     push ( @results, "User asked for an unknown update type for custom field " . $cf->Name . " for ticket " . $Ticket->id );
1155                 }
1156             }
1157         }
1158         return (@results);
1159     }
1160 }
1161
1162 # }}}
1163
1164 # {{{ sub ProcessTicketWatchers
1165
1166 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1167
1168 Returns an array of results messages.
1169
1170 =cut
1171
1172 sub ProcessTicketWatchers {
1173     my %args = (
1174         TicketObj => undef,
1175         ARGSRef   => undef,
1176         @_
1177     );
1178     my (@results);
1179
1180     my $Ticket  = $args{'TicketObj'};
1181     my $ARGSRef = $args{'ARGSRef'};
1182
1183     # {{{ Munge watchers
1184
1185     foreach my $key ( keys %$ARGSRef ) {
1186
1187         # {{{ Delete deletable watchers
1188         if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ )  ) {
1189             my ( $code, $msg ) =
1190                 $Ticket->DeleteWatcher(PrincipalId => $2,
1191                                        Type => $1);
1192             push @results, $msg;
1193         }
1194
1195         # Delete watchers in the simple style demanded by the bulk manipulator
1196         elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
1197             my ( $code, $msg ) = $Ticket->DeleteWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1198             push @results, $msg;
1199         }
1200
1201         # }}}
1202
1203         # Add new wathchers by email address
1204         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1205             and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
1206         {
1207
1208             #They're in this order because otherwise $1 gets clobbered :/
1209             my ( $code, $msg ) = $Ticket->AddWatcher(
1210                 Type  => $ARGSRef->{$key},
1211                 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1212             );
1213             push @results, $msg;
1214         }
1215
1216         #Add requestors in the simple style demanded by the bulk manipulator
1217         elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1218             my ( $code, $msg ) = $Ticket->AddWatcher(
1219                 Type  => $1,
1220                 Email => $ARGSRef->{$key}
1221             );
1222             push @results, $msg;
1223         }
1224
1225         # Add new  watchers by owner
1226         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1227             and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) {
1228
1229             #They're in this order because otherwise $1 gets clobbered :/
1230             my ( $code, $msg ) =
1231               $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 );
1232             push @results, $msg;
1233         }
1234     }
1235
1236     # }}}
1237
1238     return (@results);
1239 }
1240
1241 # }}}
1242
1243 # {{{ sub ProcessTicketDates
1244
1245 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1246
1247 Returns an array of results messages.
1248
1249 =cut
1250
1251 sub ProcessTicketDates {
1252     my %args = (
1253         TicketObj => undef,
1254         ARGSRef   => undef,
1255         @_
1256     );
1257
1258     my $Ticket  = $args{'TicketObj'};
1259     my $ARGSRef = $args{'ARGSRef'};
1260
1261     my (@results);
1262
1263     # {{{ Set date fields
1264     my @date_fields = qw(
1265       Told
1266       Resolved
1267       Starts
1268       Started
1269       Due
1270     );
1271
1272     #Run through each field in this list. update the value if apropriate
1273     foreach my $field (@date_fields) {
1274         my ( $code, $msg );
1275
1276         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1277
1278         #If it's something other than just whitespace
1279         if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1280             $DateObj->Set(
1281                 Format => 'unknown',
1282                 Value  => $ARGSRef->{ $field . '_Date' }
1283             );
1284             my $obj = $field . "Obj";
1285             if ( ( defined $DateObj->Unix )
1286                 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1287             {
1288                 my $method = "Set$field";
1289                 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1290                 push @results, "$msg";
1291             }
1292         }
1293     }
1294
1295     # }}}
1296     return (@results);
1297 }
1298
1299 # }}}
1300
1301 # {{{ sub ProcessTicketLinks
1302
1303 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1304
1305 Returns an array of results messages.
1306
1307 =cut
1308
1309 sub ProcessTicketLinks {
1310     my %args = ( TicketObj => undef,
1311                  ARGSRef   => undef,
1312                  @_ );
1313
1314     my $Ticket  = $args{'TicketObj'};
1315     my $ARGSRef = $args{'ARGSRef'};
1316
1317     my (@results);
1318
1319     # Delete links that are gone gone gone.
1320     foreach my $arg ( keys %$ARGSRef ) {
1321         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1322             my $base   = $1;
1323             my $type   = $2;
1324             my $target = $3;
1325
1326             push @results,
1327               "Trying to delete: Base: $base Target: $target  Type $type";
1328             my ( $val, $msg ) = $Ticket->DeleteLink( Base   => $base,
1329                                                      Type   => $type,
1330                                                      Target => $target );
1331
1332             push @results, $msg;
1333
1334         }
1335
1336     }
1337
1338     my @linktypes = qw( DependsOn MemberOf RefersTo );
1339
1340     foreach my $linktype (@linktypes) {
1341         if ( $ARGSRef->{ $Ticket->Id . "-$linktype" } ) {
1342             for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) {
1343                 $luri =~ s/\s*$//;    # Strip trailing whitespace
1344                 my ( $val, $msg ) = $Ticket->AddLink( Target => $luri,
1345                                                       Type   => $linktype );
1346                 push @results, $msg;
1347             }
1348         }
1349         if ( $ARGSRef->{ "$linktype-" . $Ticket->Id } ) {
1350
1351             for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) {
1352                 my ( $val, $msg ) = $Ticket->AddLink( Base => $luri,
1353                                                       Type => $linktype );
1354
1355                 push @results, $msg;
1356             }
1357         }
1358     }
1359
1360     #Merge if we need to
1361     if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1362         my ( $val, $msg ) =
1363           $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1364         push @results, $msg;
1365     }
1366
1367     return (@results);
1368 }
1369
1370 # }}}
1371
1372 eval "require RT::Interface::Web_Vendor";
1373 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
1374 eval "require RT::Interface::Web_Local";
1375 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});
1376
1377 1;