--- /dev/null
+## $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Web.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $
+
+## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
+## Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com>
+
+## This is a library of static subs to be used by the Mason web
+## interface to RT
+
+package RT::Interface::Web;
+
+# {{{ sub NewParser
+
+=head2 NewParser
+
+ Returns a new Mason::Parser object. Takes a param hash of things
+ that get passed to HTML::Mason::Parser. Currently hard coded to only
+ take the parameter 'allow_globals'.
+
+=cut
+
+sub NewParser {
+ my %args = (
+ allow_globals => undef,
+ @_
+ );
+
+ my $parser = new HTML::Mason::Parser(
+ default_escape_flags => 'h',
+ allow_globals => $args{'allow_globals'}
+ );
+ return ($parser);
+}
+
+# }}}
+
+# {{{ sub NewInterp
+
+=head2 NewInterp
+
+ Takes a paremeter hash. Needs a param called 'parser' which is a reference
+ to an HTML::Mason::Parser.
+ returns a new Mason::Interp object
+
+=cut
+
+sub NewInterp {
+ my %params = (
+ comp_root => [
+ [ local => $RT::MasonLocalComponentRoot ],
+ [ standard => $RT::MasonComponentRoot ]
+ ],
+ data_dir => "$RT::MasonDataDir",
+ @_
+ );
+
+ #We allow recursive autohandlers to allow for RT auth.
+
+ use HTML::Mason::Interp;
+ my $interp = new HTML::Mason::Interp(%params);
+
+}
+
+# }}}
+
+# {{{ sub NewApacheHandler
+
+=head2 NewApacheHandler
+
+ Takes a Mason::Interp object
+ Returns a new Mason::ApacheHandler object
+
+=cut
+
+sub NewApacheHandler {
+ my $interp = shift;
+ my $ah = new HTML::Mason::ApacheHandler( interp => $interp );
+ return ($ah);
+}
+
+# }}}
+
+
+# {{{ sub NewMason11ApacheHandler
+
+=head2 NewMason11ApacheHandler
+
+ Returns a new Mason::ApacheHandler object
+
+=cut
+
+sub NewMason11ApacheHandler {
+ my %args = ( default_escape_flags => 'h',
+ allow_globals => [%session],
+ comp_root => [
+ [ local => $RT::MasonLocalComponentRoot ],
+ [ standard => $RT::MasonComponentRoot ]
+ ],
+ data_dir => "$RT::MasonDataDir",
+ args_method => 'CGI'
+ );
+ my $ah = new HTML::Mason::ApacheHandler(%args);
+ return ($ah);
+}
+
+# }}}
+
+
+
+
+
+# }}}
+
+package HTML::Mason::Commands;
+
+# {{{ sub Abort
+# Error - calls Error and aborts
+sub Abort {
+
+ if ( $session{'ErrorDocument'} && $session{'ErrorDocumentType'} ) {
+ SetContentType( $session{'ErrorDocumentType'} );
+ $m->comp( $session{'ErrorDocument'}, Why => shift );
+ $m->abort;
+ }
+ else {
+ SetContentType('text/html');
+ $m->comp( "/Elements/Error", Why => shift );
+ $m->abort;
+ }
+}
+
+# }}}
+
+# {{{ sub CreateTicket
+
+=head2 CreateTicket ARGS
+
+Create a new ticket, using Mason's %ARGS. returns @results.
+=cut
+
+sub CreateTicket {
+ my %ARGS = (@_);
+
+ my (@Actions);
+
+ my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
+
+ my $Queue = new RT::Queue( $session{'CurrentUser'} );
+ unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
+ Abort('Queue not found');
+ }
+
+ unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
+ Abort('You have no permission to create tickets in that queue.');
+ }
+
+ my $due = new RT::Date( $session{'CurrentUser'} );
+ $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
+ my $starts = new RT::Date( $session{'CurrentUser'} );
+ $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
+
+ my @Requestors = split ( /,/, $ARGS{'Requestors'} );
+ my @Cc = split ( /,/, $ARGS{'Cc'} );
+ my @AdminCc = split ( /,/, $ARGS{'AdminCc'} );
+
+ my $MIMEObj = MakeMIMEEntity(
+ Subject => $ARGS{'Subject'},
+ From => $ARGS{'From'},
+ Cc => $ARGS{'Cc'},
+ Body => $ARGS{'Content'},
+ AttachmentFieldName => 'Attach'
+ );
+
+ my %create_args = (
+ Queue => $ARGS{Queue},
+ Owner => $ARGS{Owner},
+ InitialPriority => $ARGS{InitialPriority},
+ FinalPriority => $ARGS{FinalPriority},
+ TimeLeft => $ARGS{TimeLeft},
+ TimeWorked => $ARGS{TimeWorked},
+ Requestor => \@Requestors,
+ Cc => \@Cc,
+ AdminCc => \@AdminCc,
+ Subject => $ARGS{Subject},
+ Status => $ARGS{Status},
+ Due => $due->ISO,
+ Starts => $starts->ISO,
+ MIMEObj => $MIMEObj
+ );
+
+ # we need to get any KeywordSelect-<integer> fields into %create_args..
+ grep { $_ =~ /^KeywordSelect-/ &&{ $create_args{$_} = $ARGS{$_} } } %ARGS;
+
+ my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
+ unless ( $id && $Trans ) {
+ Abort($ErrMsg);
+ }
+ my @linktypes = qw( DependsOn MemberOf RefersTo );
+
+ foreach my $linktype (@linktypes) {
+ foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) {
+ $luri =~ s/\s*$//; # Strip trailing whitespace
+ my ( $val, $msg ) = $Ticket->AddLink(
+ Target => $luri,
+ Type => $linktype
+ );
+ push ( @Actions, $msg ) unless ($val);
+ }
+
+ foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) {
+ my ( $val, $msg ) = $Ticket->AddLink(
+ Base => $luri,
+ Type => $linktype
+ );
+
+ push ( @Actions, $msg ) unless ($val);
+ }
+ }
+
+ push ( @Actions, $ErrMsg );
+ unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
+ Abort( "No permission to view newly created ticket #"
+ . $Ticket->id . "." );
+ }
+ return ( $Ticket, @Actions );
+
+}
+
+# }}}
+
+# {{{ sub LoadTicket - loads a ticket
+
+=head2 LoadTicket id
+
+Takes a ticket id as its only variable. if it's handed an array, it takes
+the first value.
+
+Returns an RT::Ticket object as the current user.
+
+=cut
+
+sub LoadTicket {
+ my $id = shift;
+
+ if ( ref($id) eq "ARRAY" ) {
+ $id = $id->[0];
+ }
+
+ unless ($id) {
+ Abort("No ticket specified");
+ }
+
+ my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
+ $Ticket->Load($id);
+ unless ( $Ticket->id ) {
+ Abort("Could not load ticket $id");
+ }
+ return $Ticket;
+}
+
+# }}}
+
+# {{{ sub ProcessUpdateMessage
+
+sub ProcessUpdateMessage {
+
+ #TODO document what else this takes.
+ my %args = (
+ ARGSRef => undef,
+ Actions => undef,
+ TicketObj => undef,
+ @_
+ );
+
+ #Make the update content have no 'weird' newlines in it
+ if ( $args{ARGSRef}->{'UpdateContent'} ) {
+
+ if (
+ $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
+ {
+ $args{ARGSRef}->{'UpdateSubject'} = undef;
+ }
+
+ my $Message = MakeMIMEEntity(
+ Subject => $args{ARGSRef}->{'UpdateSubject'},
+ Body => $args{ARGSRef}->{'UpdateContent'},
+ AttachmentFieldName => 'UpdateAttachment'
+ );
+
+ ## Check whether this was a refresh or not.
+
+ # Match Correspondence or Comments.
+ my $trans_flag = -2;
+ my $trans_type = undef;
+ my $orig_trans = $args{ARGSRef}->{'UpdateType'};
+ if ( $orig_trans =~ /^(private|public)$/ ) {
+ $trans_type = "Comment";
+ }elsif ( $orig_trans eq 'response' ) {
+ $trans_type = "Correspond";
+ }
+
+ # Do we have a transaction that we need to update on? session
+ if( defined( $trans_type ) ){
+ $trans_flag = 0;
+
+ # Prepare a checksum.
+ # See perldoc -f unpack for example of this.
+ my $this_checksum = unpack("%32C*", $Message->body_as_string ) % 65535;
+
+ # The above *could* generate duplicate checksums. Crosscheck with
+ # the length.
+ my $this_length = length( $Message->body_as_string );
+
+ # Don't forget the ticket id.
+ my $this_id = $args{TicketObj}->id;
+
+ # Check whether the previous transaction in the
+ # ticket is the same as the current transaction.
+ if( defined( $session{'prev_trans_type'} ) && defined( $session{'prev_trans_chksum'} ) && defined( $session{'prev_trans_length'} ) && defined( $session{'prev_trans_tickid'} ) ){
+ 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 ){
+ # Its the same as the previous transaction for this user.
+ $trans_flag = -1;
+ }
+ }
+
+ # Store them for next time.
+ $session{'prev_trans_type'} = $orig_trans;
+ $session{'prev_trans_chksum'} = $this_checksum;
+ $session{'prev_trans_length'} = $this_length;
+ $session{'prev_trans_tickid'} = $this_id;
+
+ if( $trans_flag == -1 ){
+ push ( @{ $args{'Actions'} },
+"This appears to be a duplicate of your previous update (please do not refresh this page)" );
+ }
+
+
+ if ( $trans_type eq 'Comment' && $trans_flag >= 0 ) {
+ my ( $Transaction, $Description ) = $args{TicketObj}->Comment(
+ CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
+ BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
+ MIMEObj => $Message,
+ TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
+ );
+ push ( @{ $args{Actions} }, $Description );
+ }
+ elsif ( $trans_type eq 'Correspond' && $trans_flag >= 0 ) {
+ my ( $Transaction, $Description ) = $args{TicketObj}->Correspond(
+ CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
+ BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
+ MIMEObj => $Message,
+ TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
+ );
+ push ( @{ $args{Actions} }, $Description );
+ }
+ }
+ else {
+ push ( @{ $args{'Actions'} },
+ "Update type was neither correspondence nor comment. Update not recorded"
+ );
+ }
+ }
+}
+
+# }}}
+
+# {{{ sub MakeMIMEEntity
+
+=head2 MakeMIMEEntity PARAMHASH
+
+Takes a paramhash Subject, Body and AttachmentFieldName.
+
+ Returns a MIME::Entity.
+
+=cut
+
+sub MakeMIMEEntity {
+
+ #TODO document what else this takes.
+ my %args = (
+ Subject => undef,
+ From => undef,
+ Cc => undef,
+ Body => undef,
+ AttachmentFieldName => undef,
+ @_
+ );
+
+ #Make the update content have no 'weird' newlines in it
+
+ $args{'Body'} =~ s/\r\n/\n/gs;
+ my $Message = MIME::Entity->build(
+ Subject => $args{'Subject'} || "",
+ From => $args{'From'},
+ Cc => $args{'Cc'},
+ Data => [ $args{'Body'} ]
+ );
+
+ my $cgi_object = CGIObject();
+ if ( $cgi_object->param( $args{'AttachmentFieldName'} ) ) {
+
+ my $cgi_filehandle =
+ $cgi_object->upload( $args{'AttachmentFieldName'} );
+
+ use File::Temp qw(tempfile tempdir);
+
+ #foreach my $filehandle (@filenames) {
+
+ # my ( $fh, $temp_file ) = tempfile();
+
+ #$binmode $fh; #thank you, windows
+
+ # We're having trouble with tempfiles not getting created. Let's try it with
+ # a scalar instead
+
+ my ( $buffer, @file );
+
+ while ( my $bytesread = read( $cgi_filehandle, $buffer, 4096 ) ) {
+ push ( @file, $buffer );
+ }
+
+ $RT::Logger->debug($file);
+ my $filename = "$cgi_filehandle";
+ $filename =~ s#^(.*)/##;
+ $filename =~ s#^(.*)\\##;
+ my $uploadinfo = $cgi_object->uploadInfo($cgi_filehandle);
+ $Message->attach(
+ Data => \@file,
+
+ #Path => $temp_file,
+ Filename => $filename,
+ Type => $uploadinfo->{'Content-Type'}
+ );
+
+ #close($fh);
+ #unlink($temp_file);
+
+ # }
+ }
+ $Message->make_singlepart();
+ return ($Message);
+
+}
+
+# }}}
+
+# {{{ sub ProcessSearchQuery
+
+=head2 ProcessSearchQuery
+
+ Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
+
+TODO Doc exactly what comes in the paramhash
+
+
+=cut
+
+sub ProcessSearchQuery {
+ my %args = @_;
+
+ ## TODO: The only parameter here is %ARGS. Maybe it would be
+ ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
+ ## instead of $args{ARGS}->{...} ? :)
+
+ #Searches are sticky.
+ if ( defined $session{'tickets'} ) {
+
+ # Reset the old search
+ $session{'tickets'}->GotoFirstItem;
+ }
+ else {
+
+ # Init a new search
+ $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
+ }
+
+ #Import a bookmarked search if we have one
+ if ( defined $args{ARGS}->{'Bookmark'} ) {
+ $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
+ }
+
+ # {{{ Goto next/prev page
+ if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
+ $session{'tickets'}->NextPage;
+ }
+ elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
+ $session{'tickets'}->PrevPage;
+ }
+
+ # }}}
+
+ # {{{ Deal with limiting the search
+
+ if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
+ $session{'tickets_refresh_interval'} =
+ $args{ARGS}->{'RefreshSearchInterval'};
+ }
+
+ if ( $args{ARGS}->{'TicketsSortBy'} ) {
+ $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
+ $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
+ $session{'tickets'}->OrderBy(
+ FIELD => $args{ARGS}->{'TicketsSortBy'},
+ ORDER => $args{ARGS}->{'TicketsSortOrder'}
+ );
+ }
+
+ # }}}
+
+ # {{{ Set the query limit
+ if ( defined $args{ARGS}->{'RowsPerPage'} ) {
+ $RT::Logger->debug(
+ "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
+
+ $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
+ $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
+ }
+
+ # }}}
+ # {{{ Limit priority
+ if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
+ $session{'tickets'}->LimitPriority(
+ VALUE => $args{ARGS}->{'ValueOfPriority'},
+ OPERATOR => $args{ARGS}->{'PriorityOp'}
+ );
+ }
+
+ # }}}
+ # {{{ Limit owner
+ if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
+ $session{'tickets'}->LimitOwner(
+ VALUE => $args{ARGS}->{'ValueOfOwner'},
+ OPERATOR => $args{ARGS}->{'OwnerOp'}
+ );
+ }
+
+ # }}}
+ # {{{ Limit requestor email
+
+ if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) {
+ my $alias = $session{'tickets'}->LimitRequestor(
+ VALUE => $args{ARGS}->{'ValueOfRequestor'},
+ OPERATOR => $args{ARGS}->{'RequestorOp'},
+ );
+
+ }
+
+ # }}}
+ # {{{ Limit Queue
+ if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
+ $session{'tickets'}->LimitQueue(
+ VALUE => $args{ARGS}->{'ValueOfQueue'},
+ OPERATOR => $args{ARGS}->{'QueueOp'}
+ );
+ }
+
+ # }}}
+ # {{{ Limit Status
+ if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
+ if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
+ foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
+ $session{'tickets'}->LimitStatus(
+ VALUE => $value,
+ OPERATOR => $args{ARGS}->{'StatusOp'},
+ );
+ }
+ }
+ else {
+ $session{'tickets'}->LimitStatus(
+ VALUE => $args{ARGS}->{'ValueOfStatus'},
+ OPERATOR => $args{ARGS}->{'StatusOp'},
+ );
+ }
+
+ }
+
+ # }}}
+ # {{{ Limit Subject
+ if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
+ $session{'tickets'}->LimitSubject(
+ VALUE => $args{ARGS}->{'ValueOfSubject'},
+ OPERATOR => $args{ARGS}->{'SubjectOp'},
+ );
+ }
+
+ # }}}
+ # {{{ Limit Dates
+ if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
+
+ my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
+ $args{ARGS}->{'DateType'} =~ s/_Date$//;
+
+ $session{'tickets'}->LimitDate(
+ FIELD => $args{ARGS}->{'DateType'},
+ VALUE => $date,
+ OPERATOR => $args{ARGS}->{'DateOp'},
+ );
+ }
+
+ # }}}
+ # {{{ Limit Content
+ if ( $args{ARGS}->{'ValueOfContent'} ne '' ) {
+ $session{'tickets'}->LimitContent(
+ VALUE => $args{ARGS}->{'ValueOfContent'},
+ OPERATOR => $args{ARGS}->{'ContentOp'},
+ );
+ }
+
+ # }}}
+ # {{{ Limit KeywordSelects
+
+ foreach my $KeywordSelectId (
+ map { /^KeywordSelect(\d+)$/; $1 }
+ grep { /^KeywordSelect(\d+)$/; } keys %{ $args{ARGS} }
+ )
+ {
+ my $form = $args{ARGS}->{"KeywordSelect$KeywordSelectId"};
+ my $oper = $args{ARGS}->{"KeywordSelectOp$KeywordSelectId"};
+ foreach my $KeywordId ( ref($form) ? @{$form} : ($form) ) {
+ next unless ($KeywordId);
+ my $quote = 1;
+ if ( $KeywordId =~ /^null$/i ) {
+
+ #Don't quote the string 'null'
+ $quote = 0;
+
+ # Convert the operator to something apropriate for nulls
+ $oper = 'IS' if ( $oper eq '=' );
+ $oper = 'IS NOT' if ( $oper eq '!=' );
+ }
+ $session{'tickets'}->LimitKeyword(
+ KEYWORDSELECT => $KeywordSelectId,
+ OPERATOR => $oper,
+ QUOTEVALUE => $quote,
+ KEYWORD => $KeywordId
+ );
+ }
+ }
+
+ # }}}
+
+}
+
+# }}}
+
+# {{{ sub ParseDateToISO
+
+=head2 ParseDateToISO
+
+Takes a date in an arbitrary format.
+Returns an ISO date and time in GMT
+
+=cut
+
+sub ParseDateToISO {
+ my $date = shift;
+
+ my $date_obj = new RT::Date($CurrentUser);
+ $date_obj->Set(
+ Format => 'unknown',
+ Value => $date
+ );
+ return ( $date_obj->ISO );
+}
+
+# }}}
+
+# {{{ sub Config
+# TODO: This might eventually read the cookies, user configuration
+# information from the DB, queue configuration information from the
+# DB, etc.
+
+sub Config {
+ my $args = shift;
+ my $key = shift;
+ return $args->{$key} || $RT::WebOptions{$key};
+}
+
+# }}}
+
+# {{{ sub ProcessACLChanges
+
+sub ProcessACLChanges {
+ my $ACLref = shift;
+ my $ARGSref = shift;
+
+ my @CheckACL = @$ACLref;
+ my %ARGS = %$ARGSref;
+
+ my ( $ACL, @results );
+
+ # {{{ Add rights
+ foreach $ACL (@CheckACL) {
+ my ($Principal);
+
+ next unless ($ACL);
+
+ # Parse out what we're really talking about.
+ if ( $ACL =~ /^(.*?)-(\d+)-(.*?)-(\d+)/ ) {
+ my $PrincipalType = $1;
+ my $PrincipalId = $2;
+ my $Scope = $3;
+ my $AppliesTo = $4;
+
+ # {{{ Create an object called Principal
+ # so we can do rights operations
+
+ if ( $PrincipalType eq 'User' ) {
+ $Principal = new RT::User( $session{'CurrentUser'} );
+ }
+ elsif ( $PrincipalType eq 'Group' ) {
+ $Principal = new RT::Group( $session{'CurrentUser'} );
+ }
+ else {
+ Abort("$PrincipalType unknown principal type");
+ }
+
+ $Principal->Load($PrincipalId)
+ || Abort("$PrincipalType $PrincipalId couldn't be loaded");
+
+ # }}}
+
+ # {{{ load up an RT::ACL object with the same current vals of this ACL
+
+ my $CurrentACL = new RT::ACL( $session{'CurrentUser'} );
+ if ( $Scope eq 'Queue' ) {
+ $CurrentACL->LimitToQueue($AppliesTo);
+ }
+ elsif ( $Scope eq 'System' ) {
+ $CurrentACL->LimitToSystem();
+ }
+
+ $CurrentACL->LimitPrincipalToType($PrincipalType);
+ $CurrentACL->LimitPrincipalToId($PrincipalId);
+
+ # }}}
+
+ # {{{ Get the values of the select we're working with
+ # into an array. it will contain all the new rights that have
+ # been granted
+ #Hack to turn the ACL returned into an array
+ my @rights =
+ ref( $ARGS{"GrantACE-$ACL"} ) eq 'ARRAY'
+ ? @{ $ARGS{"GrantACE-$ACL"} }
+ : ( $ARGS{"GrantACE-$ACL"} );
+
+ # }}}
+
+ # {{{ Add any rights we need.
+
+ foreach my $right (@rights) {
+ next unless ($right);
+
+ #if the right that's been selected wasn't there before, add it.
+ unless (
+ $CurrentACL->HasEntry(
+ RightScope => "$Scope",
+ RightName => "$right",
+ RightAppliesTo => "$AppliesTo",
+ PrincipalType => $PrincipalType,
+ PrincipalId => $Principal->Id
+ )
+ )
+ {
+
+ #Add new entry to list of rights.
+ if ( $Scope eq 'Queue' ) {
+ my $Queue = new RT::Queue( $session{'CurrentUser'} );
+ $Queue->Load($AppliesTo);
+ unless ( $Queue->id ) {
+ Abort("Couldn't find a queue called $AppliesTo");
+ }
+
+ my ( $val, $msg ) = $Principal->GrantQueueRight(
+ RightAppliesTo => $Queue->id,
+ RightName => "$right"
+ );
+
+ if ($val) {
+ push ( @results,
+ "Granted right $right to "
+ . $Principal->Name
+ . " for queue "
+ . $Queue->Name );
+ }
+ else {
+ push ( @results, $msg );
+ }
+ }
+ elsif ( $Scope eq 'System' ) {
+ my ( $val, $msg ) = $Principal->GrantSystemRight(
+ RightAppliesTo => $AppliesTo,
+ RightName => "$right"
+ );
+ if ($val) {
+ push ( @results, "Granted system right '$right' to "
+ . $Principal->Name );
+ }
+ else {
+ push ( @results, $msg );
+ }
+ }
+ }
+ }
+
+ # }}}
+ }
+ }
+
+ # }}} Add rights
+
+ # {{{ remove any rights that have been deleted
+
+ my @RevokeACE =
+ ref( $ARGS{"RevokeACE"} ) eq 'ARRAY'
+ ? @{ $ARGS{"RevokeACE"} }
+ : ( $ARGS{"RevokeACE"} );
+
+ foreach my $aceid (@RevokeACE) {
+
+ my $right = new RT::ACE( $session{'CurrentUser'} );
+ $right->Load($aceid);
+ next unless ( $right->id );
+
+ my $phrase = "Revoked "
+ . $right->PrincipalType . " "
+ . $right->PrincipalObj->Name
+ . "'s right to "
+ . $right->RightName;
+
+ if ( $right->RightScope eq 'System' ) {
+ $phrase .= ' across all queues.';
+ }
+ else {
+ $phrase .= ' for the queue ' . $right->AppliesToObj->Name . '.';
+ }
+ my ( $val, $msg ) = $right->Delete();
+ if ($val) {
+ push ( @results, $phrase );
+ }
+ else {
+ push ( @results, $msg );
+ }
+ }
+
+ # }}}
+
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub UpdateRecordObj
+
+=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
+
+@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.
+
+Returns an array of success/failure messages
+
+=cut
+
+sub UpdateRecordObject {
+ my %args = (
+ ARGSRef => undef,
+ AttributesRef => undef,
+ Object => undef,
+ @_
+ );
+
+ my (@results);
+
+ my $object = $args{'Object'};
+ my $attributes = $args{'AttributesRef'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ foreach $attribute (@$attributes) {
+ if ( ( defined $ARGSRef->{"$attribute"} )
+ and ( $ARGSRef->{"$attribute"} ne $object->$attribute() ) )
+ {
+ $ARGSRef->{"$attribute"} =~ s/\r\n/\n/gs;
+
+ my $method = "Set$attribute";
+ my ( $code, $msg ) = $object->$method( $ARGSRef->{"$attribute"} );
+ push @results, "$attribute: $msg";
+ }
+ }
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketBasics
+
+=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketBasics {
+
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $TicketObj = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ # {{{ Set basic fields
+ my @attribs = qw(
+ Subject
+ FinalPriority
+ Priority
+ TimeWorked
+ TimeLeft
+ Status
+ Queue
+ );
+
+ if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
+ my $tempqueue = RT::Queue->new($RT::SystemUser);
+ $tempqueue->Load( $ARGSRef->{'Queue'} );
+ if ( $tempqueue->id ) {
+ $ARGSRef->{'Queue'} = $tempqueue->Id();
+ }
+ }
+
+ my @results = UpdateRecordObject(
+ AttributesRef => \@attribs,
+ Object => $TicketObj,
+ ARGSRef => $ARGSRef
+ );
+
+ # We special case owner changing, so we can use ForceOwnerChange
+ if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner ne $ARGSRef->{'Owner'} ) ) {
+ my ($ChownType);
+ if ( $ARGSRef->{'ForceOwnerChange'} ) {
+ $ChownType = "Force";
+ }
+ else {
+ $ChownType = "Give";
+ }
+
+ my ( $val, $msg ) =
+ $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
+ push ( @results, "$msg" );
+ }
+
+ # }}}
+
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketWatchers
+
+=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketWatchers {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+ my (@results);
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ # {{{ Munge watchers
+
+ foreach my $key ( keys %$ARGSRef ) {
+
+ # Delete deletable watchers
+ if ( ( $key =~ /^DelWatcher(\d*)$/ ) and ( $ARGSRef->{$key} ) ) {
+ my ( $code, $msg ) = $Ticket->DeleteWatcher($1);
+ push @results, $msg;
+ }
+
+ # Delete watchers in the simple style demanded by the bulk manipulator
+ elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
+ my ( $code, $msg ) = $Ticket->DeleteWatcher( $ARGSRef->{$key}, $1 );
+ push @results, $msg;
+ }
+
+ # Add new wathchers by email address
+ elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
+ and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
+ {
+
+ #They're in this order because otherwise $1 gets clobbered :/
+ my ( $code, $msg ) = $Ticket->AddWatcher(
+ Type => $ARGSRef->{$key},
+ Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
+ );
+ push @results, $msg;
+ }
+
+ #Add requestors in the simple style demanded by the bulk manipulator
+ elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
+ my ( $code, $msg ) = $Ticket->AddWatcher(
+ Type => $1,
+ Email => $ARGSRef->{$key}
+ );
+ push @results, $msg;
+ }
+
+ # Add new watchers by owner
+ elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
+ and ( $key =~ /^WatcherTypeUser(\d*)$/ ) )
+ {
+
+ #They're in this order because otherwise $1 gets clobbered :/
+ my ( $code, $msg ) =
+ $Ticket->AddWatcher( Type => $ARGSRef->{$key}, Owner => $1 );
+ push @results, $msg;
+ }
+ }
+
+ # }}}
+
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketDates
+
+=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketDates {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my (@results);
+
+ # {{{ Set date fields
+ my @date_fields = qw(
+ Told
+ Resolved
+ Starts
+ Started
+ Due
+ );
+
+ #Run through each field in this list. update the value if apropriate
+ foreach $field (@date_fields) {
+ my ( $code, $msg );
+
+ my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+
+ #If it's something other than just whitespace
+ if ( $ARGSRef->{ $field . '_Date' } ne '' ) {
+ $DateObj->Set(
+ Format => 'unknown',
+ Value => $ARGSRef->{ $field . '_Date' }
+ );
+ my $obj = $field . "Obj";
+ if ( ( defined $DateObj->Unix )
+ and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
+ {
+ my $method = "Set$field";
+ my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
+ push @results, "$msg";
+ }
+ }
+ }
+
+ # }}}
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketLinks
+
+=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketLinks {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my (@results);
+
+ # Delete links that are gone gone gone.
+ foreach my $arg ( keys %$ARGSRef ) {
+ if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
+ my $base = $1;
+ my $type = $2;
+ my $target = $3;
+
+ push @results,
+ "Trying to delete: Base: $base Target: $target Type $type";
+ my ( $val, $msg ) = $Ticket->DeleteLink(
+ Base => $base,
+ Type => $type,
+ Target => $target
+ );
+
+ push @results, $msg;
+
+ }
+
+ }
+
+ my @linktypes = qw( DependsOn MemberOf RefersTo );
+
+ foreach my $linktype (@linktypes) {
+
+ for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) )
+ {
+ $luri =~ s/\s*$//; # Strip trailing whitespace
+ my ( $val, $msg ) = $Ticket->AddLink(
+ Target => $luri,
+ Type => $linktype
+ );
+ push @results, $msg;
+ }
+
+ for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) )
+ {
+ my ( $val, $msg ) = $Ticket->AddLink(
+ Base => $luri,
+ Type => $linktype
+ );
+
+ push @results, $msg;
+ }
+ }
+
+ #Merge if we need to
+ if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
+ my ( $val, $msg ) =
+ $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
+ push @results, $msg;
+ }
+
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketObjectKeywords
+
+=head2 ProcessTicketObjectKeywords ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketObjectKeywords {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $TicketObj = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my (@results);
+
+ # {{{ set ObjectKeywords.
+
+ my $KeywordSelects = $TicketObj->QueueObj->KeywordSelects;
+
+ # iterate through all the keyword selects for this queue
+ while ( my $KeywordSelect = $KeywordSelects->Next ) {
+
+ # {{{ do some setup
+
+ # if we have KeywordSelectMagic for this keywordselect:
+ next
+ unless
+ defined $ARGSRef->{ 'KeywordSelectMagic' . $KeywordSelect->id };
+
+ # Lets get a hash of the possible values to work with
+ my $value = $ARGSRef->{ 'KeywordSelect' . $KeywordSelect->id } || [];
+
+ #lets get all those values in a hash. regardless of # of entries
+ #we'll use this for adding and deleting keywords from this object.
+ my %values = map { $_ => 1 } ref($value) ? @{$value} : ($value);
+
+ # Load up the ObjectKeywords for this KeywordSelect for this ticket
+ my $ObjectKeys = $TicketObj->KeywordsObj( $KeywordSelect->id );
+
+ # }}}
+ # {{{ add new keywords
+
+ foreach my $key ( keys %values ) {
+
+ #unless the ticket has that keyword for that keyword select,
+ unless ( $ObjectKeys->HasEntry($key) ) {
+
+ #Add the keyword
+ my ( $result, $msg ) = $TicketObj->AddKeyword(
+ Keyword => $key,
+ KeywordSelect => $KeywordSelect->id
+ );
+ push ( @results, $msg );
+ }
+ }
+
+ # }}}
+ # {{{ Delete unused keywords
+
+ #redo this search, so we don't ask it to delete things that are already gone
+ # such as when a single keyword select gets its value changed.
+ $ObjectKeys = $TicketObj->KeywordsObj( $KeywordSelect->id );
+
+ while ( my $TicketKey = $ObjectKeys->Next ) {
+
+ # if the hash defined above doesn\'t contain the keyword mentioned,
+ unless ( $values{ $TicketKey->Keyword } ) {
+
+ #I'd really love to just call $keyword->Delete, but then
+ # we wouldn't get a transaction recorded
+ my ( $result, $msg ) = $TicketObj->DeleteKeyword(
+ Keyword => $TicketKey->Keyword,
+ KeywordSelect => $KeywordSelect->id
+ );
+ push ( @results, $msg );
+ }
+ }
+
+ # }}}
+ }
+
+ #Iterate through the keyword selects for BulkManipulator style access
+ while ( my $KeywordSelect = $KeywordSelects->Next ) {
+ if ( $ARGSRef->{ "AddToKeywordSelect" . $KeywordSelect->Id } ) {
+
+ #Add the keyword
+ my ( $result, $msg ) = $TicketObj->AddKeyword(
+ Keyword =>
+ $ARGSRef->{ "AddToKeywordSelect" . $KeywordSelect->Id },
+ KeywordSelect => $KeywordSelect->id
+ );
+ push ( @results, $msg );
+ }
+ if ( $ARGSRef->{ "DeleteFromKeywordSelect" . $KeywordSelect->Id } ) {
+
+ #Delete the keyword
+ my ( $result, $msg ) = $TicketObj->DeleteKeyword(
+ Keyword =>
+ $ARGSRef->{ "DeleteFromKeywordSelect" . $KeywordSelect->Id },
+ KeywordSelect => $KeywordSelect->id
+ );
+ push ( @results, $msg );
+ }
+ }
+
+ # }}}
+
+ return (@results);
+}
+
+# }}}
+
+1;
projects / freeside.git / blobdiff