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