rt/lib/RT/Interface/Web.pm

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