rt/lib/RT/Interface/Web.pm

   1 ## $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Web.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $
   2
   3 ## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
   4 ## Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com>
   5
   6 ## This is a library of static subs to be used by the Mason web
   7 ## interface to RT
   8
   9 package RT::Interface::Web;
  10
  11 # {{{ sub NewParser
  12
  13 =head2 NewParser
  14
  15   Returns a new Mason::Parser object. Takes a param hash of things
  16   that get passed to HTML::Mason::Parser. Currently hard coded to only
  17   take the parameter 'allow_globals'.
  18
  19 =cut
  20
  21 sub NewParser {
  22     my %args = (
  23         allow_globals => undef,
  24         @_
  25     );
  26
  27     my $parser = new HTML::Mason::Parser(
  28         default_escape_flags => 'h',
  29         allow_globals        => $args{'allow_globals'}
  30     );
  31     return ($parser);
  32 }
  33
  34 # }}}
  35
  36 # {{{ sub NewInterp
  37
  38 =head2 NewInterp
  39
  40   Takes a paremeter hash. Needs a param called 'parser' which is a reference
  41   to an HTML::Mason::Parser.
  42   returns a new Mason::Interp object
  43
  44 =cut
  45
  46 sub NewInterp {
  47     my %params = (
  48         comp_root                    => [
  49             [ local    => $RT::MasonLocalComponentRoot ],
  50             [ standard => $RT::MasonComponentRoot ]
  51         ],
  52         data_dir => "$RT::MasonDataDir",
  53         @_
  54     );
  55
  56     #We allow recursive autohandlers to allow for RT auth.
  57
  58     use HTML::Mason::Interp;
  59     my $interp = new HTML::Mason::Interp(%params);
  60
  61 }
  62
  63 # }}}
  64
  65 # {{{ sub NewApacheHandler
  66
  67 =head2 NewApacheHandler
  68
  69   Takes a Mason::Interp object
  70   Returns a new Mason::ApacheHandler object
  71
  72 =cut
  73
  74 sub NewApacheHandler {
  75     my $interp = shift;
  76     my $ah = new HTML::Mason::ApacheHandler( interp => $interp );
  77     return ($ah);
  78 }
  79
  80 # }}}
  81
  82
  83 # {{{ sub NewMason11ApacheHandler
  84
  85 =head2 NewMason11ApacheHandler
  86
  87   Returns a new Mason::ApacheHandler object
  88
  89 =cut
  90
  91 sub NewMason11ApacheHandler {
  92         my %args = ( default_escape_flags => 'h',
  93                     allow_globals        => [%session],
  94         comp_root                    => [
  95             [ local    => $RT::MasonLocalComponentRoot ],
  96             [ standard => $RT::MasonComponentRoot ]
  97         ],
  98         data_dir => "$RT::MasonDataDir",
  99         args_method => 'CGI'
 100     );
 101     my $ah = new HTML::Mason::ApacheHandler(%args);
 102     return ($ah);
 103 }
 104
 105 # }}}
 106
 107
 108
 109
 110
 111 # }}}
 112
 113 package HTML::Mason::Commands;
 114
 115 # {{{ sub Abort
 116 # Error - calls Error and aborts
 117 sub Abort {
 118
 119     if ( $session{'ErrorDocument'} && $session{'ErrorDocumentType'} ) {
 120         SetContentType( $session{'ErrorDocumentType'} );
 121         $m->comp( $session{'ErrorDocument'}, Why => shift );
 122         $m->abort;
 123     }
 124     else {
 125         SetContentType('text/html');
 126         $m->comp( "/Elements/Error", Why => shift );
 127         $m->abort;
 128     }
 129 }
 130
 131 # }}}
 132
 133 # {{{ sub CreateTicket
 134
 135 =head2 CreateTicket ARGS
 136
 137 Create a new ticket, using Mason's %ARGS.  returns @results.
 138 =cut
 139
 140 sub CreateTicket {
 141     my %ARGS = (@_);
 142
 143     my (@Actions);
 144
 145     my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
 146
 147     my $Queue = new RT::Queue( $session{'CurrentUser'} );
 148     unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
 149         Abort('Queue not found');
 150     }
 151
 152     unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
 153         Abort('You have no permission to create tickets in that queue.');
 154     }
 155
 156     my $due = new RT::Date( $session{'CurrentUser'} );
 157     $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
 158     my $starts = new RT::Date( $session{'CurrentUser'} );
 159     $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
 160
 161     my @Requestors = split ( /,/, $ARGS{'Requestors'} );
 162     my @Cc         = split ( /,/, $ARGS{'Cc'} );
 163     my @AdminCc    = split ( /,/, $ARGS{'AdminCc'} );
 164
 165     my $MIMEObj = MakeMIMEEntity(
 166         Subject             => $ARGS{'Subject'},
 167         From                => $ARGS{'From'},
 168         Cc                  => $ARGS{'Cc'},
 169         Body                => $ARGS{'Content'},
 170         AttachmentFieldName => 'Attach'
 171     );
 172
 173     my %create_args = (
 174         Queue           => $ARGS{Queue},
 175         Owner           => $ARGS{Owner},
 176         InitialPriority => $ARGS{InitialPriority},
 177         FinalPriority   => $ARGS{FinalPriority},
 178         TimeLeft        => $ARGS{TimeLeft},
 179         TimeWorked      => $ARGS{TimeWorked},
 180         Requestor       => \@Requestors,
 181         Cc              => \@Cc,
 182         AdminCc         => \@AdminCc,
 183         Subject         => $ARGS{Subject},
 184         Status          => $ARGS{Status},
 185         Due             => $due->ISO,
 186         Starts          => $starts->ISO,
 187         MIMEObj         => $MIMEObj
 188     );
 189
 190     # we need to get any KeywordSelect-<integer> fields into %create_args..
 191     grep { $_ =~ /^KeywordSelect-/ &&{ $create_args{$_} = $ARGS{$_} } } %ARGS;
 192
 193     my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
 194     unless ( $id && $Trans ) {
 195         Abort($ErrMsg);
 196     }
 197     my @linktypes = qw( DependsOn MemberOf RefersTo );
 198
 199     foreach my $linktype (@linktypes) {
 200         foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) {
 201             $luri =~ s/\s*$//;    # Strip trailing whitespace
 202             my ( $val, $msg ) = $Ticket->AddLink(
 203                 Target => $luri,
 204                 Type   => $linktype
 205             );
 206             push ( @Actions, $msg ) unless ($val);
 207         }
 208
 209         foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) {
 210             my ( $val, $msg ) = $Ticket->AddLink(
 211                 Base => $luri,
 212                 Type => $linktype
 213             );
 214
 215             push ( @Actions, $msg ) unless ($val);
 216         }
 217     }
 218
 219     push ( @Actions, $ErrMsg );
 220     unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
 221         Abort( "No permission to view newly created ticket #"
 222             . $Ticket->id . "." );
 223     }
 224     return ( $Ticket, @Actions );
 225
 226 }
 227
 228 # }}}
 229
 230 # {{{ sub LoadTicket - loads a ticket
 231
 232 =head2  LoadTicket id
 233
 234 Takes a ticket id as its only variable. if it's handed an array, it takes
 235 the first value.
 236
 237 Returns an RT::Ticket object as the current user.
 238
 239 =cut
 240
 241 sub LoadTicket {
 242     my $id = shift;
 243
 244     if ( ref($id) eq "ARRAY" ) {
 245         $id = $id->[0];
 246     }
 247
 248     unless ($id) {
 249         Abort("No ticket specified");
 250     }
 251
 252     my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
 253     $Ticket->Load($id);
 254     unless ( $Ticket->id ) {
 255         Abort("Could not load ticket $id");
 256     }
 257     return $Ticket;
 258 }
 259
 260 # }}}
 261
 262 # {{{ sub ProcessUpdateMessage
 263
 264 sub ProcessUpdateMessage {
 265
 266     #TODO document what else this takes.
 267     my %args = (
 268         ARGSRef   => undef,
 269         Actions   => undef,
 270         TicketObj => undef,
 271         @_
 272     );
 273
 274     #Make the update content have no 'weird' newlines in it
 275     if ( $args{ARGSRef}->{'UpdateContent'} ) {
 276
 277         if (
 278             $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
 279         {
 280             $args{ARGSRef}->{'UpdateSubject'} = undef;
 281         }
 282
 283         my $Message = MakeMIMEEntity(
 284             Subject             => $args{ARGSRef}->{'UpdateSubject'},
 285             Body                => $args{ARGSRef}->{'UpdateContent'},
 286             AttachmentFieldName => 'UpdateAttachment'
 287         );
 288
 289         ## Check whether this was a refresh or not.
 290
 291         # Match Correspondence or Comments.
 292         my $trans_flag = -2;
 293         my $trans_type = undef;
 294         my $orig_trans = $args{ARGSRef}->{'UpdateType'};
 295         if ( $orig_trans =~ /^(private|public)$/ ) {
 296             $trans_type = "Comment";
 297         }elsif ( $orig_trans eq 'response' ) {
 298             $trans_type = "Correspond";
 299         }
 300
 301         # Do we have a transaction that we need to update on? session
 302         if( defined( $trans_type ) ){
 303             $trans_flag = 0;
 304
 305             # Prepare a checksum.
 306             # See perldoc -f unpack for example of this.
 307             my $this_checksum = unpack("%32C*", $Message->body_as_string ) % 65535;
 308
 309             # The above *could* generate duplicate checksums.  Crosscheck with
 310             # the length.
 311             my $this_length = length( $Message->body_as_string );
 312
 313             # Don't forget the ticket id.
 314             my $this_id = $args{TicketObj}->id;
 315
 316             # Check whether the previous transaction in the
 317             # ticket is the same as the current transaction.
 318             if( defined( $session{'prev_trans_type'} ) && defined( $session{'prev_trans_chksum'} ) && defined( $session{'prev_trans_length'} ) && defined( $session{'prev_trans_tickid'} ) ){
 319                 if( $session{'prev_trans_type'} eq $orig_trans && $session{'prev_trans_chksum'} == $this_checksum && $session{'prev_trans_length'} == $this_length && $session{'prev_trans_tickid'} == $this_id ){
 320                     # Its the same as the previous transaction for this user.
 321                     $trans_flag = -1;
 322                 }
 323             }
 324
 325             # Store them for next time.
 326             $session{'prev_trans_type'} = $orig_trans;
 327             $session{'prev_trans_chksum'} = $this_checksum;
 328             $session{'prev_trans_length'} = $this_length;
 329             $session{'prev_trans_tickid'} = $this_id;
 330
 331             if( $trans_flag == -1 ){
 332                 push ( @{ $args{'Actions'} },
 333 "This appears to be a duplicate of your previous update (please do not refresh this page)" );
 334             }
 335
 336
 337             if ( $trans_type eq 'Comment' && $trans_flag >= 0 ) {
 338                 my ( $Transaction, $Description ) = $args{TicketObj}->Comment(
 339                     CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 340                     BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 341                     MIMEObj      => $Message,
 342                     TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 343                 );
 344                 push ( @{ $args{Actions} }, $Description );
 345             }
 346             elsif ( $trans_type eq 'Correspond' && $trans_flag >= 0 ) {
 347                 my ( $Transaction, $Description ) = $args{TicketObj}->Correspond(
 348                     CcMessageTo  => $args{ARGSRef}->{'UpdateCc'},
 349                     BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
 350                     MIMEObj      => $Message,
 351                     TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'}
 352                 );
 353                 push ( @{ $args{Actions} }, $Description );
 354             }
 355         }
 356         else {
 357             push ( @{ $args{'Actions'} },
 358     "Update type was neither correspondence nor comment. Update not recorded"
 359                 );
 360         }
 361     }
 362 }
 363
 364 # }}}
 365
 366 # {{{ sub MakeMIMEEntity
 367
 368 =head2 MakeMIMEEntity PARAMHASH
 369
 370 Takes a paramhash Subject, Body and AttachmentFieldName.
 371
 372   Returns a MIME::Entity.
 373
 374 =cut
 375
 376 sub MakeMIMEEntity {
 377
 378     #TODO document what else this takes.
 379     my %args = (
 380         Subject             => undef,
 381         From                => undef,
 382         Cc                  => undef,
 383         Body                => undef,
 384         AttachmentFieldName => undef,
 385         @_
 386     );
 387
 388     #Make the update content have no 'weird' newlines in it
 389
 390     $args{'Body'} =~ s/\r\n/\n/gs;
 391     my $Message = MIME::Entity->build(
 392         Subject => $args{'Subject'} || "",
 393         From    => $args{'From'},
 394         Cc      => $args{'Cc'},
 395         Data    => [ $args{'Body'} ]
 396     );
 397
 398     my $cgi_object = CGIObject();
 399     if ( $cgi_object->param( $args{'AttachmentFieldName'} ) ) {
 400
 401         my $cgi_filehandle =
 402           $cgi_object->upload( $args{'AttachmentFieldName'} );
 403
 404         use File::Temp qw(tempfile tempdir);
 405
 406         #foreach my $filehandle (@filenames) {
 407
 408         # my ( $fh, $temp_file ) = tempfile();
 409
 410         #$binmode $fh;    #thank you, windows
 411
 412         # We're having trouble with tempfiles not getting created. Let's try it with
 413         # a scalar instead
 414
 415         my ( $buffer, @file );
 416
 417         while ( my $bytesread = read( $cgi_filehandle, $buffer, 4096 ) ) {
 418             push ( @file, $buffer );
 419         }
 420
 421         $RT::Logger->debug($file);
 422         my $filename = "$cgi_filehandle";
 423         $filename =~ s#^(.*)/##;
 424         $filename =~ s#^(.*)\\##;
 425         my $uploadinfo = $cgi_object->uploadInfo($cgi_filehandle);
 426         $Message->attach(
 427             Data => \@file,
 428
 429             #Path     => $temp_file,
 430             Filename => $filename,
 431             Type     => $uploadinfo->{'Content-Type'}
 432         );
 433
 434         #close($fh);
 435         #unlink($temp_file);
 436
 437         #       }
 438     }
 439     $Message->make_singlepart();
 440     return ($Message);
 441
 442 }
 443
 444 # }}}
 445
 446 # {{{ sub ProcessSearchQuery
 447
 448 =head2 ProcessSearchQuery
 449
 450   Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
 451
 452 TODO Doc exactly what comes in the paramhash
 453
 454
 455 =cut
 456
 457 sub ProcessSearchQuery {
 458     my %args = @_;
 459
 460     ## TODO: The only parameter here is %ARGS.  Maybe it would be
 461     ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
 462     ## instead of $args{ARGS}->{...} ? :)
 463
 464     #Searches are sticky.
 465     if ( defined $session{'tickets'} ) {
 466
 467         # Reset the old search
 468         $session{'tickets'}->GotoFirstItem;
 469     }
 470     else {
 471
 472         # Init a new search
 473         $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
 474     }
 475
 476     #Import a bookmarked search if we have one
 477     if ( defined $args{ARGS}->{'Bookmark'} ) {
 478         $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
 479     }
 480
 481     # {{{ Goto next/prev page
 482     if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
 483         $session{'tickets'}->NextPage;
 484     }
 485     elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
 486         $session{'tickets'}->PrevPage;
 487     }
 488
 489     # }}}
 490
 491     # {{{ Deal with limiting the search
 492
 493     if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
 494         $session{'tickets_refresh_interval'} =
 495           $args{ARGS}->{'RefreshSearchInterval'};
 496     }
 497
 498     if ( $args{ARGS}->{'TicketsSortBy'} ) {
 499         $session{'tickets_sort_by'}    = $args{ARGS}->{'TicketsSortBy'};
 500         $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
 501         $session{'tickets'}->OrderBy(
 502             FIELD => $args{ARGS}->{'TicketsSortBy'},
 503             ORDER => $args{ARGS}->{'TicketsSortOrder'}
 504         );
 505     }
 506
 507     # }}}
 508
 509     # {{{ Set the query limit
 510     if ( defined $args{ARGS}->{'RowsPerPage'} ) {
 511         $RT::Logger->debug(
 512             "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
 513
 514         $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
 515         $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
 516     }
 517
 518     # }}}
 519     # {{{ Limit priority
 520     if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
 521         $session{'tickets'}->LimitPriority(
 522             VALUE    => $args{ARGS}->{'ValueOfPriority'},
 523             OPERATOR => $args{ARGS}->{'PriorityOp'}
 524         );
 525     }
 526
 527     # }}}
 528     # {{{ Limit owner
 529     if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
 530         $session{'tickets'}->LimitOwner(
 531             VALUE    => $args{ARGS}->{'ValueOfOwner'},
 532             OPERATOR => $args{ARGS}->{'OwnerOp'}
 533         );
 534     }
 535
 536     # }}}
 537     # {{{ Limit requestor email
 538
 539     if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) {
 540         my $alias = $session{'tickets'}->LimitRequestor(
 541             VALUE    => $args{ARGS}->{'ValueOfRequestor'},
 542             OPERATOR => $args{ARGS}->{'RequestorOp'},
 543         );
 544
 545     }
 546
 547     # }}}
 548     # {{{ Limit Queue
 549     if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
 550         $session{'tickets'}->LimitQueue(
 551             VALUE    => $args{ARGS}->{'ValueOfQueue'},
 552             OPERATOR => $args{ARGS}->{'QueueOp'}
 553         );
 554     }
 555
 556     # }}}
 557     # {{{ Limit Status
 558     if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
 559         if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
 560             foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
 561                 $session{'tickets'}->LimitStatus(
 562                     VALUE    => $value,
 563                     OPERATOR => $args{ARGS}->{'StatusOp'},
 564                 );
 565             }
 566         }
 567         else {
 568             $session{'tickets'}->LimitStatus(
 569                 VALUE    => $args{ARGS}->{'ValueOfStatus'},
 570                 OPERATOR => $args{ARGS}->{'StatusOp'},
 571             );
 572         }
 573
 574     }
 575
 576     # }}}
 577     # {{{ Limit Subject
 578     if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
 579         $session{'tickets'}->LimitSubject(
 580             VALUE    => $args{ARGS}->{'ValueOfSubject'},
 581             OPERATOR => $args{ARGS}->{'SubjectOp'},
 582         );
 583     }
 584
 585     # }}}
 586     # {{{ Limit Dates
 587     if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
 588
 589         my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
 590         $args{ARGS}->{'DateType'} =~ s/_Date$//;
 591
 592         $session{'tickets'}->LimitDate(
 593             FIELD    => $args{ARGS}->{'DateType'},
 594             VALUE    => $date,
 595             OPERATOR => $args{ARGS}->{'DateOp'},
 596         );
 597     }
 598
 599     # }}}
 600     # {{{ Limit Content
 601     if ( $args{ARGS}->{'ValueOfContent'} ne '' ) {
 602         $session{'tickets'}->LimitContent(
 603             VALUE    => $args{ARGS}->{'ValueOfContent'},
 604             OPERATOR => $args{ARGS}->{'ContentOp'},
 605         );
 606     }
 607
 608     # }}}
 609     # {{{ Limit KeywordSelects
 610
 611     foreach my $KeywordSelectId (
 612         map { /^KeywordSelect(\d+)$/; $1 }
 613         grep { /^KeywordSelect(\d+)$/; } keys %{ $args{ARGS} }
 614       )
 615     {
 616         my $form = $args{ARGS}->{"KeywordSelect$KeywordSelectId"};
 617         my $oper = $args{ARGS}->{"KeywordSelectOp$KeywordSelectId"};
 618         foreach my $KeywordId ( ref($form) ? @{$form} : ($form) ) {
 619             next unless ($KeywordId);
 620             my $quote = 1;
 621             if ( $KeywordId =~ /^null$/i ) {
 622
 623                 #Don't quote the string 'null'
 624                 $quote = 0;
 625
 626                 # Convert the operator to something apropriate for nulls
 627                 $oper = 'IS'     if ( $oper eq '=' );
 628                 $oper = 'IS NOT' if ( $oper eq '!=' );
 629             }
 630             $session{'tickets'}->LimitKeyword(
 631                 KEYWORDSELECT => $KeywordSelectId,
 632                 OPERATOR      => $oper,
 633                 QUOTEVALUE    => $quote,
 634                 KEYWORD       => $KeywordId
 635             );
 636         }
 637     }
 638
 639     # }}}
 640
 641 }
 642
 643 # }}}
 644
 645 # {{{ sub ParseDateToISO
 646
 647 =head2 ParseDateToISO
 648
 649 Takes a date in an arbitrary format.
 650 Returns an ISO date and time in GMT
 651
 652 =cut
 653
 654 sub ParseDateToISO {
 655     my $date = shift;
 656
 657     my $date_obj = new RT::Date($CurrentUser);
 658     $date_obj->Set(
 659         Format => 'unknown',
 660         Value  => $date
 661     );
 662     return ( $date_obj->ISO );
 663 }
 664
 665 # }}}
 666
 667 # {{{ sub Config
 668 # TODO: This might eventually read the cookies, user configuration
 669 # information from the DB, queue configuration information from the
 670 # DB, etc.
 671
 672 sub Config {
 673     my $args = shift;
 674     my $key  = shift;
 675     return $args->{$key} || $RT::WebOptions{$key};
 676 }
 677
 678 # }}}
 679
 680 # {{{ sub ProcessACLChanges
 681
 682 sub ProcessACLChanges {
 683     my $ACLref  = shift;
 684     my $ARGSref = shift;
 685
 686     my @CheckACL = @$ACLref;
 687     my %ARGS     = %$ARGSref;
 688
 689     my ( $ACL, @results );
 690
 691     # {{{ Add rights
 692     foreach $ACL (@CheckACL) {
 693         my ($Principal);
 694
 695         next unless ($ACL);
 696
 697         # Parse out what we're really talking about.
 698         if ( $ACL =~ /^(.*?)-(\d+)-(.*?)-(\d+)/ ) {
 699             my $PrincipalType = $1;
 700             my $PrincipalId   = $2;
 701             my $Scope         = $3;
 702             my $AppliesTo     = $4;
 703
 704             # {{{ Create an object called Principal
 705             # so we can do rights operations
 706
 707             if ( $PrincipalType eq 'User' ) {
 708                 $Principal = new RT::User( $session{'CurrentUser'} );
 709             }
 710             elsif ( $PrincipalType eq 'Group' ) {
 711                 $Principal = new RT::Group( $session{'CurrentUser'} );
 712             }
 713             else {
 714                 Abort("$PrincipalType unknown principal type");
 715             }
 716
 717             $Principal->Load($PrincipalId)
 718               || Abort("$PrincipalType $PrincipalId couldn't be loaded");
 719
 720             # }}}
 721
 722             # {{{ load up an RT::ACL object with the same current vals of this ACL
 723
 724             my $CurrentACL = new RT::ACL( $session{'CurrentUser'} );
 725             if ( $Scope eq 'Queue' ) {
 726                 $CurrentACL->LimitToQueue($AppliesTo);
 727             }
 728             elsif ( $Scope eq 'System' ) {
 729                 $CurrentACL->LimitToSystem();
 730             }
 731
 732             $CurrentACL->LimitPrincipalToType($PrincipalType);
 733             $CurrentACL->LimitPrincipalToId($PrincipalId);
 734
 735             # }}}
 736
 737             # {{{ Get the values of the select we're working with
 738             # into an array. it will contain all the new rights that have
 739             # been granted
 740             #Hack to turn the ACL returned into an array
 741             my @rights =
 742               ref( $ARGS{"GrantACE-$ACL"} ) eq 'ARRAY'
 743               ? @{ $ARGS{"GrantACE-$ACL"} }
 744               : ( $ARGS{"GrantACE-$ACL"} );
 745
 746             # }}}
 747
 748             # {{{ Add any rights we need.
 749
 750             foreach my $right (@rights) {
 751                 next unless ($right);
 752
 753                 #if the right that's been selected wasn't there before, add it.
 754                 unless (
 755                     $CurrentACL->HasEntry(
 756                         RightScope     => "$Scope",
 757                         RightName      => "$right",
 758                         RightAppliesTo => "$AppliesTo",
 759                         PrincipalType  => $PrincipalType,
 760                         PrincipalId    => $Principal->Id
 761                     )
 762                   )
 763                 {
 764
 765                     #Add new entry to list of rights.
 766                     if ( $Scope eq 'Queue' ) {
 767                         my $Queue = new RT::Queue( $session{'CurrentUser'} );
 768                         $Queue->Load($AppliesTo);
 769                         unless ( $Queue->id ) {
 770                             Abort("Couldn't find a queue called $AppliesTo");
 771                         }
 772
 773                         my ( $val, $msg ) = $Principal->GrantQueueRight(
 774                             RightAppliesTo => $Queue->id,
 775                             RightName      => "$right"
 776                         );
 777
 778                         if ($val) {
 779                             push ( @results,
 780                                 "Granted right $right to "
 781                                   . $Principal->Name
 782                                   . " for queue "
 783                                   . $Queue->Name );
 784                         }
 785                         else {
 786                             push ( @results, $msg );
 787                         }
 788                     }
 789                     elsif ( $Scope eq 'System' ) {
 790                         my ( $val, $msg ) = $Principal->GrantSystemRight(
 791                             RightAppliesTo => $AppliesTo,
 792                             RightName      => "$right"
 793                         );
 794                         if ($val) {
 795                             push ( @results, "Granted system right '$right' to "
 796                                   . $Principal->Name );
 797                         }
 798                         else {
 799                             push ( @results, $msg );
 800                         }
 801                     }
 802                 }
 803             }
 804
 805             # }}}
 806         }
 807     }
 808
 809     # }}} Add rights
 810
 811     # {{{ remove any rights that have been deleted
 812
 813     my @RevokeACE =
 814       ref( $ARGS{"RevokeACE"} ) eq 'ARRAY'
 815       ? @{ $ARGS{"RevokeACE"} }
 816       : ( $ARGS{"RevokeACE"} );
 817
 818     foreach my $aceid (@RevokeACE) {
 819
 820         my $right = new RT::ACE( $session{'CurrentUser'} );
 821         $right->Load($aceid);
 822         next unless ( $right->id );
 823
 824         my $phrase = "Revoked "
 825           . $right->PrincipalType . " "
 826           . $right->PrincipalObj->Name
 827           . "'s right to "
 828           . $right->RightName;
 829
 830         if ( $right->RightScope eq 'System' ) {
 831             $phrase .= ' across all queues.';
 832         }
 833         else {
 834             $phrase .= ' for the queue ' . $right->AppliesToObj->Name . '.';
 835         }
 836         my ( $val, $msg ) = $right->Delete();
 837         if ($val) {
 838             push ( @results, $phrase );
 839         }
 840         else {
 841             push ( @results, $msg );
 842         }
 843     }
 844
 845     # }}}
 846
 847     return (@results);
 848 }
 849
 850 # }}}
 851
 852 # {{{ sub UpdateRecordObj
 853
 854 =head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
 855
 856 @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.
 857
 858 Returns an array of success/failure messages
 859
 860 =cut
 861
 862 sub UpdateRecordObject {
 863     my %args = (
 864         ARGSRef       => undef,
 865         AttributesRef => undef,
 866         Object        => undef,
 867         @_
 868     );
 869
 870     my (@results);
 871
 872     my $object     = $args{'Object'};
 873     my $attributes = $args{'AttributesRef'};
 874     my $ARGSRef    = $args{'ARGSRef'};
 875
 876     foreach $attribute (@$attributes) {
 877         if ( ( defined $ARGSRef->{"$attribute"} )
 878             and ( $ARGSRef->{"$attribute"} ne $object->$attribute() ) )
 879         {
 880             $ARGSRef->{"$attribute"} =~ s/\r\n/\n/gs;
 881
 882             my $method = "Set$attribute";
 883             my ( $code, $msg ) = $object->$method( $ARGSRef->{"$attribute"} );
 884             push @results, "$attribute: $msg";
 885         }
 886     }
 887     return (@results);
 888 }
 889
 890 # }}}
 891
 892 # {{{ sub ProcessTicketBasics
 893
 894 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 895
 896 Returns an array of results messages.
 897
 898 =cut
 899
 900 sub ProcessTicketBasics {
 901
 902     my %args = (
 903         TicketObj => undef,
 904         ARGSRef   => undef,
 905         @_
 906     );
 907
 908     my $TicketObj = $args{'TicketObj'};
 909     my $ARGSRef   = $args{'ARGSRef'};
 910
 911     # {{{ Set basic fields
 912     my @attribs = qw(
 913       Subject
 914       FinalPriority
 915       Priority
 916       TimeWorked
 917       TimeLeft
 918       Status
 919       Queue
 920     );
 921
 922     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
 923         my $tempqueue = RT::Queue->new($RT::SystemUser);
 924         $tempqueue->Load( $ARGSRef->{'Queue'} );
 925         if ( $tempqueue->id ) {
 926             $ARGSRef->{'Queue'} = $tempqueue->Id();
 927         }
 928     }
 929
 930     my @results = UpdateRecordObject(
 931         AttributesRef => \@attribs,
 932         Object        => $TicketObj,
 933         ARGSRef       => $ARGSRef
 934     );
 935
 936     # We special case owner changing, so we can use ForceOwnerChange
 937     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner ne $ARGSRef->{'Owner'} ) ) {
 938         my ($ChownType);
 939         if ( $ARGSRef->{'ForceOwnerChange'} ) {
 940             $ChownType = "Force";
 941         }
 942         else {
 943             $ChownType = "Give";
 944         }
 945
 946         my ( $val, $msg ) =
 947           $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
 948         push ( @results, "$msg" );
 949     }
 950
 951     # }}}
 952
 953     return (@results);
 954 }
 955
 956 # }}}
 957
 958 # {{{ sub ProcessTicketWatchers
 959
 960 =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 961
 962 Returns an array of results messages.
 963
 964 =cut
 965
 966 sub ProcessTicketWatchers {
 967     my %args = (
 968         TicketObj => undef,
 969         ARGSRef   => undef,
 970         @_
 971     );
 972     my (@results);
 973
 974     my $Ticket  = $args{'TicketObj'};
 975     my $ARGSRef = $args{'ARGSRef'};
 976
 977     # {{{ Munge watchers
 978
 979     foreach my $key ( keys %$ARGSRef ) {
 980
 981         # Delete deletable watchers
 982         if ( ( $key =~ /^DelWatcher(\d*)$/ ) and ( $ARGSRef->{$key} ) ) {
 983             my ( $code, $msg ) = $Ticket->DeleteWatcher($1);
 984             push @results, $msg;
 985         }
 986
 987         # Delete watchers in the simple style demanded by the bulk manipulator
 988         elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
 989             my ( $code, $msg ) = $Ticket->DeleteWatcher( $ARGSRef->{$key}, $1 );
 990             push @results, $msg;
 991         }
 992
 993         # Add new wathchers by email address
 994         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
 995             and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
 996         {
 997
 998             #They're in this order because otherwise $1 gets clobbered :/
 999             my ( $code, $msg ) = $Ticket->AddWatcher(
1000                 Type  => $ARGSRef->{$key},
1001                 Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
1002             );
1003             push @results, $msg;
1004         }
1005
1006         #Add requestors in the simple style demanded by the bulk manipulator
1007         elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
1008             my ( $code, $msg ) = $Ticket->AddWatcher(
1009                 Type  => $1,
1010                 Email => $ARGSRef->{$key}
1011             );
1012             push @results, $msg;
1013         }
1014
1015         # Add new  watchers by owner
1016         elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
1017             and ( $key =~ /^WatcherTypeUser(\d*)$/ ) )
1018         {
1019
1020             #They're in this order because otherwise $1 gets clobbered :/
1021             my ( $code, $msg ) =
1022               $Ticket->AddWatcher( Type => $ARGSRef->{$key}, Owner => $1 );
1023             push @results, $msg;
1024         }
1025     }
1026
1027     # }}}
1028
1029     return (@results);
1030 }
1031
1032 # }}}
1033
1034 # {{{ sub ProcessTicketDates
1035
1036 =head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1037
1038 Returns an array of results messages.
1039
1040 =cut
1041
1042 sub ProcessTicketDates {
1043     my %args = (
1044         TicketObj => undef,
1045         ARGSRef   => undef,
1046         @_
1047     );
1048
1049     my $Ticket  = $args{'TicketObj'};
1050     my $ARGSRef = $args{'ARGSRef'};
1051
1052     my (@results);
1053
1054     # {{{ Set date fields
1055     my @date_fields = qw(
1056       Told
1057       Resolved
1058       Starts
1059       Started
1060       Due
1061     );
1062
1063     #Run through each field in this list. update the value if apropriate
1064     foreach $field (@date_fields) {
1065         my ( $code, $msg );
1066
1067         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
1068
1069         #If it's something other than just whitespace
1070         if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
1071             $DateObj->Set(
1072                 Format => 'unknown',
1073                 Value  => $ARGSRef->{ $field . '_Date' }
1074             );
1075             my $obj = $field . "Obj";
1076             if ( ( defined $DateObj->Unix )
1077                 and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
1078             {
1079                 my $method = "Set$field";
1080                 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
1081                 push @results, "$msg";
1082             }
1083         }
1084     }
1085
1086     # }}}
1087     return (@results);
1088 }
1089
1090 # }}}
1091
1092 # {{{ sub ProcessTicketLinks
1093
1094 =head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1095
1096 Returns an array of results messages.
1097
1098 =cut
1099
1100 sub ProcessTicketLinks {
1101     my %args = (
1102         TicketObj => undef,
1103         ARGSRef   => undef,
1104         @_
1105     );
1106
1107     my $Ticket  = $args{'TicketObj'};
1108     my $ARGSRef = $args{'ARGSRef'};
1109
1110     my (@results);
1111
1112     # Delete links that are gone gone gone.
1113     foreach my $arg ( keys %$ARGSRef ) {
1114         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
1115             my $base   = $1;
1116             my $type   = $2;
1117             my $target = $3;
1118
1119             push @results,
1120               "Trying to delete: Base: $base Target: $target  Type $type";
1121             my ( $val, $msg ) = $Ticket->DeleteLink(
1122                 Base   => $base,
1123                 Type   => $type,
1124                 Target => $target
1125             );
1126
1127             push @results, $msg;
1128
1129         }
1130
1131     }
1132
1133     my @linktypes = qw( DependsOn MemberOf RefersTo );
1134
1135     foreach my $linktype (@linktypes) {
1136
1137         for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) )
1138         {
1139             $luri =~ s/\s*$//;    # Strip trailing whitespace
1140             my ( $val, $msg ) = $Ticket->AddLink(
1141                 Target => $luri,
1142                 Type   => $linktype
1143             );
1144             push @results, $msg;
1145         }
1146
1147         for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) )
1148         {
1149             my ( $val, $msg ) = $Ticket->AddLink(
1150                 Base => $luri,
1151                 Type => $linktype
1152             );
1153
1154             push @results, $msg;
1155         }
1156     }
1157
1158     #Merge if we need to
1159     if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
1160         my ( $val, $msg ) =
1161           $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
1162         push @results, $msg;
1163     }
1164
1165     return (@results);
1166 }
1167
1168 # }}}
1169
1170 # {{{ sub ProcessTicketObjectKeywords
1171
1172 =head2 ProcessTicketObjectKeywords ( TicketObj => $Ticket, ARGSRef => \%ARGS );
1173
1174 Returns an array of results messages.
1175
1176 =cut
1177
1178 sub ProcessTicketObjectKeywords {
1179     my %args = (
1180         TicketObj => undef,
1181         ARGSRef   => undef,
1182         @_
1183     );
1184
1185     my $TicketObj = $args{'TicketObj'};
1186     my $ARGSRef   = $args{'ARGSRef'};
1187
1188     my (@results);
1189
1190     # {{{ set ObjectKeywords.
1191
1192     my $KeywordSelects = $TicketObj->QueueObj->KeywordSelects;
1193
1194     # iterate through all the keyword selects for this queue
1195     while ( my $KeywordSelect = $KeywordSelects->Next ) {
1196
1197         # {{{ do some setup
1198
1199         # if we have KeywordSelectMagic for this keywordselect:
1200         next
1201           unless
1202           defined $ARGSRef->{ 'KeywordSelectMagic' . $KeywordSelect->id };
1203
1204         # Lets get a hash of the possible values to work with
1205         my $value = $ARGSRef->{ 'KeywordSelect' . $KeywordSelect->id } || [];
1206
1207         #lets get all those values in a hash. regardless of # of entries
1208         #we'll use this for adding and deleting keywords from this object.
1209         my %values = map { $_ => 1 } ref($value) ? @{$value} : ($value);
1210
1211         # Load up the ObjectKeywords for this KeywordSelect for this ticket
1212         my $ObjectKeys = $TicketObj->KeywordsObj( $KeywordSelect->id );
1213
1214         # }}}
1215         # {{{ add new keywords
1216
1217         foreach my $key ( keys %values ) {
1218
1219             #unless the ticket has that keyword for that keyword select,
1220             unless ( $ObjectKeys->HasEntry($key) ) {
1221
1222                 #Add the keyword
1223                 my ( $result, $msg ) = $TicketObj->AddKeyword(
1224                     Keyword       => $key,
1225                     KeywordSelect => $KeywordSelect->id
1226                 );
1227                 push ( @results, $msg );
1228             }
1229         }
1230
1231         # }}}
1232         # {{{ Delete unused keywords
1233
1234         #redo this search, so we don't ask it to delete things that are already gone
1235         # such as when a single keyword select gets its value changed.
1236         $ObjectKeys = $TicketObj->KeywordsObj( $KeywordSelect->id );
1237
1238         while ( my $TicketKey = $ObjectKeys->Next ) {
1239
1240             # if the hash defined above doesn\'t contain the keyword mentioned,
1241             unless ( $values{ $TicketKey->Keyword } ) {
1242
1243                 #I'd really love to just call $keyword->Delete, but then
1244                 # we wouldn't get a transaction recorded
1245                 my ( $result, $msg ) = $TicketObj->DeleteKeyword(
1246                     Keyword       => $TicketKey->Keyword,
1247                     KeywordSelect => $KeywordSelect->id
1248                 );
1249                 push ( @results, $msg );
1250             }
1251         }
1252
1253         # }}}
1254     }
1255
1256     #Iterate through the keyword selects for BulkManipulator style access
1257     while ( my $KeywordSelect = $KeywordSelects->Next ) {
1258         if ( $ARGSRef->{ "AddToKeywordSelect" . $KeywordSelect->Id } ) {
1259
1260             #Add the keyword
1261             my ( $result, $msg ) = $TicketObj->AddKeyword(
1262                 Keyword =>
1263                 $ARGSRef->{ "AddToKeywordSelect" . $KeywordSelect->Id },
1264                 KeywordSelect => $KeywordSelect->id
1265             );
1266             push ( @results, $msg );
1267         }
1268         if ( $ARGSRef->{ "DeleteFromKeywordSelect" . $KeywordSelect->Id } ) {
1269
1270             #Delete the keyword
1271             my ( $result, $msg ) = $TicketObj->DeleteKeyword(
1272                 Keyword =>
1273                 $ARGSRef->{ "DeleteFromKeywordSelect" . $KeywordSelect->Id },
1274                 KeywordSelect => $KeywordSelect->id
1275             );
1276             push ( @results, $msg );
1277         }
1278     }
1279
1280     # }}}
1281
1282     return (@results);
1283 }
1284
1285 # }}}
1286
1287 1;