diff options
Diffstat (limited to 'rt/lib/RT')
56 files changed, 14390 insertions, 7003 deletions
diff --git a/rt/lib/RT/ACE.pm b/rt/lib/RT/ACE.pm index 1501a125e..d4681cf44 100755 --- a/rt/lib/RT/ACE.pm +++ b/rt/lib/RT/ACE.pm @@ -1,304 +1,774 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ACE.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME -RT::ACE - + RT::ACE - RT\'s ACE object =head1 SYNOPSIS + use RT::ACE; + my $ace = new RT::ACE($CurrentUser); + + =head1 DESCRIPTION + =head1 METHODS +=begin testing + +ok(require RT::TestHarness); +ok(require RT::ACE); + +=end testing + =cut package RT::ACE; -use RT::Record; +use RT::Record; +@ISA= qw(RT::Record); +use vars qw (%SCOPES + %QUEUERIGHTS + %SYSTEMRIGHTS + %LOWERCASERIGHTNAMES + ); -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +%SCOPES = ( + System => 'System-level right', + Queue => 'Queue-level right' + ); -sub _Init { - my $self = shift; +# {{{ Descriptions of rights + +# Queue rights are the sort of queue rights that can only be granted +# to real people or groups +%QUEUERIGHTS = ( + SeeQueue => 'Can this principal see this queue', + AdminQueue => 'Create, delete and modify queues', + ShowACL => 'Display Access Control List', + ModifyACL => 'Modify Access Control List', + ModifyQueueWatchers => 'Modify the queue watchers', + AdminKeywordSelects => 'Create, delete and modify keyword selections', + + + ModifyTemplate => 'Modify email templates for this queue', + ShowTemplate => 'Display email templates for this queue', + ModifyScrips => 'Modify Scrips for this queue', + ShowScrips => 'Display Scrips for this queue', + + ShowTicket => 'Show ticket summaries', + ShowTicketComments => 'Show ticket private commentary', + + Watch => 'Sign up as a ticket Requestor or ticket or queue Cc', + WatchAsAdminCc => 'Sign up as a ticket or queue AdminCc', + CreateTicket => 'Create tickets in this queue', + ReplyToTicket => 'Reply to tickets', + CommentOnTicket => 'Comment on tickets', + OwnTicket => 'Own tickets', + ModifyTicket => 'Modify tickets', + DeleteTicket => 'Delete tickets' + + ); - $self->Table('ACL'); - $self->SUPER::_Init(@_); -} +# System rights are rights granted to the whole system +%SYSTEMRIGHTS = ( + SuperUser => 'Do anything and everything', + AdminKeywords => 'Creatte, delete and modify keywords', + AdminGroups => 'Create, delete and modify groups', + AdminUsers => 'Create, Delete and Modify users', + ModifySelf => 'Modify one\'s own RT account', + ); +# }}} +# {{{ Descriptions of principals -=item Create PARAMHASH +%TICKET_METAPRINCIPALS = ( Owner => 'The owner of a ticket', + Requestor => 'The requestor of a ticket', + Cc => 'The CC of a ticket', + AdminCc => 'The administrative CC of a ticket', + ); -Create takes a hash of values and creates a row in the database: +# }}} - varchar(25) 'PrincipalType'. - int(11) 'PrincipalId'. - varchar(25) 'RightName'. - varchar(25) 'ObjectType'. - int(11) 'ObjectId'. - int(11) 'DelegatedBy'. - int(11) 'DelegatedFrom'. +# {{{ We need to build a hash of all rights, keyed by lower case names + +#since you can't do case insensitive hash lookups + +foreach $right (keys %QUEUERIGHTS) { + $LOWERCASERIGHTNAMES{lc $right}=$right; +} +foreach $right (keys %SYSTEMRIGHTS) { + $LOWERCASERIGHTNAMES{lc $right}=$right; +} + +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ACL"; + return($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub LoadByValues + +=head2 LoadByValues PARAMHASH + +Load an ACE by specifying a paramhash with the following fields: + + PrincipalId => undef, + PrincipalType => undef, + RightName => undef, + RightScope => undef, + RightAppliesTo => undef, =cut +sub LoadByValues { + my $self = shift; + my %args = (PrincipalId => undef, + PrincipalType => undef, + RightName => undef, + RightScope => undef, + RightAppliesTo => undef, + @_); + + $self->LoadByCols (PrincipalId => $args{'PrincipalId'}, + PrincipalType => $args{'PrincipalType'}, + RightName => $args{'RightName'}, + RightScope => $args{'RightScope'}, + RightAppliesTo => $args{'RightAppliesTo'} + ); + + #If we couldn't load it. + unless ($self->Id) { + return (0, "ACE not found"); + } + # if we could + return ($self->Id, "ACE Loaded"); + +} + +# }}} +# {{{ sub Create +=head2 Create <PARAMS> + +PARAMS is a parameter hash with the following elements: + + PrincipalType => "Queue"|"User" + PrincipalId => an intentifier you can use to ->Load a user or group + RightName => the name of a right. in any case + RightScope => "System" | "Queue" + RightAppliesTo => a queue id or undef + +=cut sub Create { my $self = shift; - my %args = ( - PrincipalType => '', - PrincipalId => '0', - RightName => '', - ObjectType => '', - ObjectId => '0', - DelegatedBy => '0', - DelegatedFrom => '0', - - @_); - $self->SUPER::Create( - PrincipalType => $args{'PrincipalType'}, - PrincipalId => $args{'PrincipalId'}, - RightName => $args{'RightName'}, - ObjectType => $args{'ObjectType'}, - ObjectId => $args{'ObjectId'}, - DelegatedBy => $args{'DelegatedBy'}, - DelegatedFrom => $args{'DelegatedFrom'}, -); - + my %args = ( PrincipalId => undef, + PrincipalType => undef, + RightName => undef, + RightScope => undef, + RightAppliesTo => undef, + @_ + ); + + # {{{ Validate the principal + my ($princ_obj); + if ($args{'PrincipalType'} eq 'User') { + $princ_obj = new RT::User($RT::SystemUser); + + } + elsif ($args{'PrincipalType'} eq 'Group') { + require RT::Group; + $princ_obj = new RT::Group($RT::SystemUser); + } + else { + return (0, 'Principal type '.$args{'PrincipalType'} . ' is invalid.'); + } + + $princ_obj->Load($args{'PrincipalId'}); + my $princ_id = $princ_obj->Id(); + + unless ($princ_id) { + return (0, 'Principal '.$args{'PrincipalId'}.' not found.'); + } + + # }}} + + #TODO allow loading of queues by name. + + # {{{ Check the ACL + if ($args{'RightScope'} eq 'System') { + + unless ($self->CurrentUserHasSystemRight('ModifyACL')) { + $RT::Logger->error("Permission Denied."); + return(undef); + } + } + + elsif ($args{'RightScope'} eq 'Queue') { + unless ($self->CurrentUserHasQueueRight( Queue => $args{'RightAppliesTo'}, + Right => 'ModifyACL')) { + return (0, 'Permission Denied.'); + } + + + + + } + #If it's not a scope we recognise, something scary is happening. + else { + $RT::Logger->err("RT::ACE->Create got a scope it didn't recognize: ". + $args{'RightScope'}." Bailing. \n"); + return(0,"System error. Unable to grant rights."); + } + + # }}} + + # {{{ Canonicalize and check the right name + $args{'RightName'} = $self->CanonicalizeRightName($args{'RightName'}); + + #check if it's a valid RightName + if ($args{'RightScope'} eq 'Queue') { + unless (exists $QUEUERIGHTS{$args{'RightName'}}) { + return(0, 'Invalid right'); + } + } + elsif ($args{'RightScope' eq 'System'}) { + unless (exists $SYSTEMRIGHTS{$args{'RightName'}}) { + return(0, 'Invalid right'); + } + } + # }}} + + # Make sure the right doesn't already exist. + $self->LoadByCols (PrincipalId => $princ_id, + PrincipalType => $args{'PrincipalType'}, + RightName => $args{'RightName'}, + RightScope => $args {'RightScope'}, + RightAppliesTo => $args{'RightAppliesTo'} + ); + if ($self->Id) { + return (0, 'That user already has that right'); + } + + my $id = $self->SUPER::Create( PrincipalId => $princ_id, + PrincipalType => $args{'PrincipalType'}, + RightName => $args{'RightName'}, + RightScope => $args {'RightScope'}, + RightAppliesTo => $args{'RightAppliesTo'} + ); + + + if ($id > 0 ) { + return ($id, 'Right Granted'); + } + else { + $RT::Logger->err('System error. right not granted.'); + return(0, 'System Error. right not granted'); + } } +# }}} -=item id +# {{{ sub Delete -Returns the current value of id. -(In the database, id is stored as int(11).) +=head2 Delete +Delete this object. =cut +sub Delete { + my $self = shift; + + unless ($self->CurrentUserHasRight('ModifyACL')) { + return (0, 'Permission Denied'); + } + + + my ($val,$msg) = $self->SUPER::Delete(@_); + if ($val) { + return ($val, 'ACE Deleted'); + } + else { + return (0, 'ACE could not be deleted'); + } +} -=item PrincipalType +# }}} -Returns the current value of PrincipalType. -(In the database, PrincipalType is stored as varchar(25).) +# {{{ sub _BootstrapRight +=head2 _BootstrapRight +Grant a right with no error checking and no ACL. this is _only_ for +installation. If you use this routine without jesse@fsck.com's explicit +written approval, he will hunt you down and make you spend eternity +translating mozilla's code into FORTRAN or intercal. -=item SetPrincipalType VALUE +=cut + +sub _BootstrapRight { + my $self = shift; + my %args = @_; + + my $id = $self->SUPER::Create( PrincipalId => $args{'PrincipalId'}, + PrincipalType => $args{'PrincipalType'}, + RightName => $args{'RightName'}, + RightScope => $args {'RightScope'}, + RightAppliesTo => $args{'RightAppliesTo'} + ); + + if ($id > 0 ) { + return ($id); + } + else { + $RT::Logger->err('System error. right not granted.'); + return(undef); + } + +} + +# }}} +# {{{ sub CanonicalizeRightName -Set PrincipalType to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, PrincipalType will be stored as a varchar(25).) +=head2 CanonicalizeRightName <RIGHT> +Takes a queue or system right name in any case and returns it in +the correct case. If it's not found, will return undef. =cut +sub CanonicalizeRightName { + my $self = shift; + my $right = shift; + $right = lc $right; + if (exists $LOWERCASERIGHTNAMES{"$right"}) { + return ($LOWERCASERIGHTNAMES{"$right"}); + } + else { + return (undef); + } +} + +# }}} -=item PrincipalId +# {{{ sub QueueRights -Returns the current value of PrincipalId. -(In the database, PrincipalId is stored as int(11).) +=head2 QueueRights +Returns a hash of all the possible rights at the queue scope +=cut -=item SetPrincipalId VALUE +sub QueueRights { + return (%QUEUERIGHTS); +} +# }}} -Set PrincipalId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, PrincipalId will be stored as a int(11).) +# {{{ sub SystemRights +=head2 SystemRights + +Returns a hash of all the possible rights at the system scope =cut +sub SystemRights { + return (%SYSTEMRIGHTS); +} -=item RightName -Returns the current value of RightName. -(In the database, RightName is stored as varchar(25).) +# }}} +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + PrincipalId => 'read/write', + PrincipalType => 'read/write', + RightName => 'read/write', + RightScope => 'read/write', + RightAppliesTo => 'read/write' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} -=item SetRightName VALUE +# {{{ sub AppliesToObj +=head2 AppliesToObj -Set RightName to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, RightName will be stored as a varchar(25).) +If the AppliesTo is a queue, returns the queue object. If it's +the system object, returns undef. If the user has no rights, returns undef. +=cut + +sub AppliesToObj { + my $self = shift; + if ($self->RightScope eq 'Queue') { + my $appliesto_obj = new RT::Queue($self->CurrentUser); + $appliesto_obj->Load($self->RightAppliesTo); + return($appliesto_obj); + } + elsif ($self->RightScope eq 'System') { + return (undef); + } + else { + $RT::Logger->warning("$self -> AppliesToObj called for an object ". + "of an unknown scope:" . $self->RightScope); + return(undef); + } +} + +# }}} + +# {{{ sub PrincipalObj + +=head2 PrincipalObj + +If the AppliesTo is a group, returns the group object. +If the AppliesTo is a user, returns the user object. +Otherwise, it logs a warning and returns undef. =cut +sub PrincipalObj { + my $self = shift; + my ($princ_obj); + + if ($self->PrincipalType eq 'Group') { + use RT::Group; + $princ_obj = new RT::Group($self->CurrentUser); + } + elsif ($self->PrincipalType eq 'User') { + $princ_obj = new RT::User($self->CurrentUser); + } + else { + $RT::Logger->warning("$self -> PrincipalObj called for an object ". + "of an unknown principal type:" . + $self->PrincipalType ."\n"); + return(undef); + } + + $princ_obj->Load($self->PrincipalId); + return($princ_obj); + +} + +# }}} + +# {{{ ACL related methods + +# {{{ sub _Set + +sub _Set { + my $self = shift; + return (0, "ACEs can only be created and deleted."); +} -=item ObjectType +# }}} -Returns the current value of ObjectType. -(In the database, ObjectType is stored as varchar(25).) +# {{{ sub _Value +sub _Value { + my $self = shift; + unless ($self->CurrentUserHasRight('ShowACL')) { + return (undef); + } -=item SetObjectType VALUE + return ($self->__Value(@_)); +} + +# }}} -Set ObjectType to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ObjectType will be stored as a varchar(25).) +# {{{ sub CurrentUserHasQueueRight +=head2 CurrentUserHasQueueRight ( Queue => QUEUEID, Right => RIGHTNANAME ) + +Check to see whether the current user has the specified right for the specified queue. =cut +sub CurrentUserHasQueueRight { + my $self = shift; + my %args = (Queue => undef, + Right => undef, + @_ + ); + return ($self->HasRight( Right => $args{'Right'}, + Principal => $self->CurrentUser->UserObj, + Queue => $args{'Queue'})); +} + +# }}} + +# {{{ sub CurrentUserHasSystemRight +=head2 CurrentUserHasSystemRight RIGHTNAME + +Check to see whether the current user has the specified right for the 'system' scope. + +=cut + +sub CurrentUserHasSystemRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Right => $right, + Principal => $self->CurrentUser->UserObj, + System => 1 + )); +} + -=item ObjectId +# }}} -Returns the current value of ObjectId. -(In the database, ObjectId is stored as int(11).) +# {{{ sub CurrentUserHasRight +=item CurrentUserHasRight RIGHT +Takes a rightname as a string. +Helper menthod for HasRight. Presets Principal to CurrentUser then +calls HasRight. -=item SetObjectId VALUE +=cut +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Principal => $self->CurrentUser->UserObj, + Right => $right, + )); +} -Set ObjectId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ObjectId will be stored as a int(11).) +# }}} +# {{{ sub HasRight + +=item HasRight + +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to KeywordSelects =cut +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + Queue => undef, + System => undef, + @_ ); + + #If we're explicitly specifying a queue, as we need to do on create + if (defined $args{'Queue'}) { + return ($args{'Principal'}->HasQueueRight(Right => $args{'Right'}, + Queue => $args{'Queue'})); + } + #else if we're specifying to check a system right + elsif ((defined $args{'System'}) and (defined $args{'Right'})) { + return( $args{'Principal'}->HasSystemRight( $args{'Right'} )); + } + + elsif ($self->__Value('RightScope') eq 'System') { + return $args{'Principal'}->HasSystemRight($args{'Right'}); + } + elsif ($self->__Value('RightScope') eq 'Queue') { + return $args{'Principal'}->HasQueueRight( Queue => $self->__Value('RightAppliesTo'), + Right => $args{'Right'} ); + } + else { + $RT::Logger->warning("$self: Trying to check an acl for a scope we ". + "don't understand:" . $self->__Value('RightScope') ."\n"); + return undef; + } -=item DelegatedBy -Returns the current value of DelegatedBy. -(In the database, DelegatedBy is stored as int(11).) +} +# }}} +# }}} -=item SetDelegatedBy VALUE +1; +__DATA__ -Set DelegatedBy to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, DelegatedBy will be stored as a int(11).) +# {{{ POD +=head1 Out of date docs -=cut +=head2 Table Structure +PrincipalType, PrincipalId, Right,Scope,AppliesTo -=item DelegatedFrom +=head1 The docs are out of date. so you know. -Returns the current value of DelegatedFrom. -(In the database, DelegatedFrom is stored as int(11).) +=head1 Scopes +Scope is the scope of the right granted, not the granularity of the grant. +For example, Queue and Ticket rights are both granted for a "queue." +Rights with a scope of 'System' don't have an AppliesTo. (They're global). +Rights with a scope of "Queue" are rights that act on a queue. +Rights with a scope of "System" are rights that act on some other aspect +of the system. -=item SetDelegatedFrom VALUE +=item Queue +=item System -Set DelegatedFrom to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, DelegatedFrom will be stored as a int(11).) +=head1 Rights +=head2 Scope: Queue -=cut +=head2 Queue rights that apply to a ticket within a queue +Create Ticket in <queue> + Name: Create + Principals: <user> <group> +Display Ticket Summary in <queue> -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - PrincipalType => - {read => 1, write => 1, type => 'varchar(25)', default => ''}, - PrincipalId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - RightName => - {read => 1, write => 1, type => 'varchar(25)', default => ''}, - ObjectType => - {read => 1, write => 1, type => 'varchar(25)', default => ''}, - ObjectId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - DelegatedBy => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - DelegatedFrom => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + Name: Show + Principals: <user> <group> Owner Requestor Cc AdminCc - } -}; +Display Ticket History <queue> + Name: ShowHistory + Principals: <user> <group> Owner Requestor Cc AdminCc - eval "require RT::ACE_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/ACE_Overlay.pm}) { - die $@; - }; +Display Ticket Private Comments <queue> - eval "require RT::ACE_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/ACE_Vendor.pm}) { - die $@; - }; + Name: ShowComments + Principals: <user> <group> Owner Requestor Cc AdminCc - eval "require RT::ACE_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/ACE_Local.pm}) { - die $@; - }; +Reply to Ticket in <queue> + Name: Reply + Principals: <user> <group> Owner Requestor Cc AdminCc +Comment on Ticket in <queue> + Name: Comment + Principals: <user> <group> Owner Requestor Cc AdminCc -=head1 SEE ALSO +Modify Ticket in <queue> -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. + Name: Modify + Principals: <user> <group> Owner Requestor Cc AdminCc -These overlay files can contain new subs or subs to replace existing subs in this module. +Delete Tickets in <queue> -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line + Name: Delete + Principals: <user> <group> Owner Requestor Cc AdminCc - no warnings qw(redefine); -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 Queue Rights that apply to a whole queue -RT::ACE_Overlay, RT::ACE_Vendor, RT::ACE_Local +These rights can only be granted to "real people" -=cut +List Tickets in <queue> + Name: ListQueue + Principals: <user> <group> -1; +Know that <queue> exists + + Name: See + Principals: <user> <group> + +Display queue settings + + Name: Explore + Principals: <user> <group> + +Modify Queue Watchers for <queue> + + Name: ModifyQueueWatchers + Principals: <user> <group> + +Modify Queue Attributes for <queue> + + Name: ModifyQueue + Principals: <user> <group> + +Modify Queue ACL for queue <queue> + + Name: ModifyACL + Principals: <user> <group> + + +=head2 Rights that apply to the System scope + +=head2 SystemRights + +Create Queue + + Name: CreateQueue + Principals: <user> <group> +Delete Queue + + Name: DeleteQueue + Principals: <user> <group> + +Create Users + + Name: CreateUser + Principals: <user> <group> + +Delete Users + + Name: DeleteUser + Principals: <user> <group> + +Modify Users + + Name: ModifyUser + Principals: <user> <group> + +Modify Self + Name: ModifySelf + Principals: <user> <group> + +Browse Users + + Name: BrowseUsers (NOT IMPLEMENTED in 2.0) + Principals: <user> <group> + +Modify Self + + Name: ModifySelf + Principals: <user> <group> + +Modify System ACL + + Name: ModifyACL + Principals: <user> <group> + +=head1 The Principal Side of the ACE + +=head2 PrincipalTypes,PrincipalIds in our Neighborhood + + User,<userid> + Group,<groupip> + Everyone,NULL + +=cut + +# }}} diff --git a/rt/lib/RT/ACL.pm b/rt/lib/RT/ACL.pm index 81f59c6d0..444a4c2af 100755 --- a/rt/lib/RT/ACL.pm +++ b/rt/lib/RT/ACL.pm @@ -1,115 +1,308 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ACL.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Distributed under the terms of the GNU GPL +# Copyright (c) 2000 Jesse Vincent <jesse@fsck.com> =head1 NAME - RT::ACL -- Class Description - + RT::ACL - collection of RT ACE objects + =head1 SYNOPSIS - use RT::ACL + use RT::ACL; +my $ACL = new RT::ACL($CurrentUser); =head1 DESCRIPTION =head1 METHODS +=begin testing + +ok(require RT::TestHarness); +ok(require RT::ACL); + +=end testing + =cut package RT::ACL; - -use RT::SearchBuilder; +use RT::EasySearch; use RT::ACE; +@ISA= qw(RT::EasySearch); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ACL"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::ACE->new($self->CurrentUser)); +} +# }}} + +=head2 Next -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +Hand out the next ACE that was found +=cut -sub _Init { +# {{{ sub Next +sub Next { my $self = shift; - $self->{'table'} = 'ACL'; - $self->{'primary_key'} = 'id'; + + my $ACE = $self->SUPER::Next(); + if ((defined($ACE)) and (ref($ACE))) { + + if ( $ACE->CurrentUserHasRight('ShowACL') or + $ACE->CurrentUserHasRight('ModifyACL') + ) { + return($ACE); + } + + #If the user doesn't have the right to show this ACE + else { + return($self->Next()); + } + } + #if there never was any ACE + else { + return(undef); + } + +} +# }}} - return ( $self->SUPER::_Init(@_) ); -} +=head1 Limit the ACL to a specific scope + +There are two real scopes right now: + +=item Queue is for rights that apply to a single queue + +=item System is for rights that apply to the System (rights that aren't queue related) -=item NewItem -Returns an empty new RT::ACE item +=head2 LimitToQueue + +Takes a single queueid as its argument. + +Limit the ACL to just a given queue when supplied with an integer queue id. =cut -sub NewItem { +sub LimitToQueue { my $self = shift; - return(RT::ACE->new($self->CurrentUser)); + my $queue = shift; + + + + $self->Limit( FIELD =>'RightScope', + ENTRYAGGREGATOR => 'OR', + VALUE => 'Queue'); + $self->Limit( FIELD =>'RightScope', + ENTRYAGGREGATOR => 'OR', + VALUE => 'Ticket'); + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'RightAppliesTo', + VALUE => $queue ); + +} + + +=head2 LimitToSystem() + +Limit the ACL to system rights + +=cut + +sub LimitToSystem { + my $self = shift; + + $self->Limit( FIELD =>'RightScope', + VALUE => 'System'); +} + + +=head2 LimitRightTo + +Takes a single RightName as its only argument. +Limits the search to the right $right. +$right is a right listed in perldoc RT::ACE + +=cut + +sub LimitRightTo { + my $self = shift; + my $right = shift; + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'RightName', + VALUE => $right ); + +} + +=head1 Limit to a specifc set of principals + +=head2 LimitPrincipalToUser + +Takes a single userid as its only argument. +Limit the ACL to a just a specific user. + +=cut + +sub LimitPrincipalToUser { + my $self = shift; + my $user = shift; + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalType', + VALUE => 'User' ); + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalId', + VALUE => $user ); + +} + + +=head2 LimitPrincipalToGroup + +Takes a single group as its only argument. +Limit the ACL to just a specific group. + +=cut + +sub LimitPrincipalToGroup { + my $self = shift; + my $group = shift; + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalType', + VALUE => 'Group' ); + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalId', + VALUE => $group ); + +} + +=head2 LimitPrincipalToType($type) + +Takes a single argument, $type. +Limit the ACL to just a specific principal type + +$type is one of: + TicketOwner + TicketRequestor + TicketCc + TicketAdminCc + Everyone + User + Group + +=cut + +sub LimitPrincipalToType { + my $self=shift; + my $type=shift; + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalType', + VALUE => $type ); } - eval "require RT::ACL_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/ACL_Overlay.pm}) { - die $@; - }; - eval "require RT::ACL_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/ACL_Vendor.pm}) { - die $@; - }; +=head2 LimitPrincipalToId - eval "require RT::ACL_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/ACL_Local.pm}) { - die $@; - }; +Takes a single argument, the numeric Id of the principal to limit this ACL to. Repeated calls to this +function will broaden the scope of the search to include all principals listed. + +=cut + +sub LimitPrincipalToId { + my $self = shift; + my $id = shift; + + if ($id =~ /^\d+$/) { + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalId', + VALUE => $id ); + } + else { + $RT::Logger->warn($self."->LimitPrincipalToId called with '$id' as an id"); + return undef; + } +} +#wrap around _DoSearch so that we can build the hash of returned +#values +sub _DoSearch { + my $self = shift; + # $RT::Logger->debug("Now in ".$self."->_DoSearch"); + my $return = $self->SUPER::_DoSearch(@_); + # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return\n"); + $self->_BuildHash(); + return ($return); +} -=head1 SEE ALSO +#Build a hash of this ACL's entries. +sub _BuildHash { + my $self = shift; -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. + while (my $entry = $self->Next) { + my $hashkey = $entry->RightScope . "-" . + $entry->RightAppliesTo . "-" . + $entry->RightName . "-" . + $entry->PrincipalId . "-" . + $entry->PrincipalType; -These overlay files can contain new subs or subs to replace existing subs in this module. + $self->{'as_hash'}->{"$hashkey"} =1; -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line + } +} - no warnings qw(redefine); -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +# {{{ HasEntry -RT::ACL_Overlay, RT::ACL_Vendor, RT::ACL_Local +=head2 HasEntry =cut +sub HasEntry { + + my $self = shift; + my %args = ( RightScope => undef, + RightAppliesTo => undef, + RightName => undef, + PrincipalId => undef, + PrincipalType => undef, + @_ ); + + #if we haven't done the search yet, do it now. + $self->_DoSearch(); + + if ($self->{'as_hash'}->{ $args{'RightScope'} . "-" . + $args{'RightAppliesTo'} . "-" . + $args{'RightName'} . "-" . + $args{'PrincipalId'} . "-" . + $args{'PrincipalType'} + } == 1) { + return(1); + } + else { + return(undef); + } +} +# }}} 1; diff --git a/rt/lib/RT/Action/Autoreply.pm b/rt/lib/RT/Action/Autoreply.pm index 81f7bddfa..624888e94 100755 --- a/rt/lib/RT/Action/Autoreply.pm +++ b/rt/lib/RT/Action/Autoreply.pm @@ -1,31 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Autoreply.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + package RT::Action::Autoreply; require RT::Action::SendEmail; - -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::SendEmail); @@ -41,7 +17,7 @@ Sets the recipients of this message to this ticket's Requestor. sub SetRecipients { my $self=shift; - push(@{$self->{'To'}}, $self->TicketObj->Requestors->MemberEmailAddresses); + push(@{$self->{'To'}}, @{$self->TicketObj->Requestors->Emails}); return(1); } @@ -63,7 +39,6 @@ sub SetReturnAddress { @_ ); - my $replyto; if ($args{'is_comment'}) { $replyto = $self->TicketObj->QueueObj->CommentAddress || $RT::CommentAddress; @@ -74,9 +49,7 @@ sub SetReturnAddress { } unless ($self->TemplateObj->MIMEObj->head->get('From')) { - my $friendly_name = $self->TicketObj->QueueObj->Description || - $self->TicketObj->QueueObj->Name; - $friendly_name =~ s/"/\\"/g; + my $friendly_name=$self->TicketObj->QueueObj->Name; $self->SetHeader('From', "\"$friendly_name\" <$replyto>"); } @@ -88,9 +61,4 @@ sub SetReturnAddress { # }}} -eval "require RT::Action::Autoreply_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Autoreply_Vendor.pm}); -eval "require RT::Action::Autoreply_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Autoreply_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/Generic.pm b/rt/lib/RT/Action/Generic.pm index 007d299c7..ecfd4ab1a 100755 --- a/rt/lib/RT/Action/Generic.pm +++ b/rt/lib/RT/Action/Generic.pm @@ -1,26 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Generic.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + =head1 NAME RT::Action::Generic - a generic baseclass for RT Actions @@ -35,6 +16,7 @@ =begin testing +ok (require RT::TestHarness); ok (require RT::Action::Generic); =end testing @@ -43,8 +25,6 @@ ok (require RT::Action::Generic); package RT::Action::Generic; -use strict; - # {{{ sub new sub new { my $proto = shift; @@ -56,13 +36,6 @@ sub new { } # }}} -# {{{ sub new -sub loc { - my $self = shift; - return $self->{'ScripObj'}->loc(@_); -} -# }}} - # {{{ sub _Init sub _Init { my $self = shift; @@ -114,13 +87,6 @@ sub TemplateObj { } # }}} -# {{{ sub ScripObj -sub ScripObj { - my $self = shift; - return($self->{'ScripObj'}); -} -# }}} - # {{{ sub Type sub Type { my $self = shift; @@ -136,7 +102,7 @@ sub Type { # {{{ sub Commit sub Commit { my $self = shift; - return(0, $self->loc("Commit Stubbed")); + return(0,"Commit Stubbed"); } # }}} @@ -146,7 +112,7 @@ sub Commit { # {{{ sub Describe sub Describe { my $self = shift; - return $self->loc("No description for [_1]", ref $self); + return ("No description for " . ref $self); } # }}} @@ -156,7 +122,7 @@ sub Describe { # {{{ sub Prepare sub Prepare { my $self = shift; - return (0, $self->loc("Prepare Stubbed")); + return (0,"Prepare Stubbed"); } # }}} @@ -186,10 +152,4 @@ sub DESTROY { } # }}} - -eval "require RT::Action::Generic_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Generic_Vendor.pm}); -eval "require RT::Action::Generic_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Generic_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/Notify.pm b/rt/lib/RT/Action/Notify.pm index 1e4e4c073..6dca4fd41 100755 --- a/rt/lib/RT/Action/Notify.pm +++ b/rt/lib/RT/Action/Notify.pm @@ -1,31 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Notify.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + package RT::Action::Notify; require RT::Action::SendEmail; - -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::SendEmail); # {{{ sub SetRecipients @@ -33,14 +9,14 @@ use vars qw/@ISA/; =head2 SetRecipients Sets the recipients of this meesage to Owner, Requestor, AdminCc, Cc or All. -Explicitly B<does not> notify the creator of the transaction by default +Explicitly B<does not> notify the creator of the transaction. =cut sub SetRecipients { my $self = shift; - my $arg = $self->Argument; + $arg = $self->Argument; $arg =~ s/\bAll\b/Owner,Requestor,AdminCc,Cc/; @@ -48,14 +24,14 @@ sub SetRecipients { if ($arg =~ /\bOtherRecipients\b/) { - if ($self->TransactionObj->Attachments->First) { - push (@Cc, $self->TransactionObj->Attachments->First->GetHeader('RT-Send-Cc')); - push (@Bcc, $self->TransactionObj->Attachments->First->GetHeader('RT-Send-Bcc')); + if ($self->TransactionObj->Message->First) { + push (@Cc, $self->TransactionObj->Message->First->GetHeader('RT-Send-Cc')); + push (@Bcc, $self->TransactionObj->Message->First->GetHeader('RT-Send-Bcc')); } } if ( $arg =~ /\bRequestor\b/ ) { - push ( @To, $self->TicketObj->Requestors->MemberEmailAddresses ); + push ( @To, @{ $self->TicketObj->Requestors->Emails } ); } @@ -64,12 +40,12 @@ sub SetRecipients { #If we have a To, make the Ccs, Ccs, otherwise, promote them to To if (@To) { - push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); - push ( @Cc, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); + push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); + push ( @Cc, @{ $self->TicketObj->QueueObj->Cc->Emails } ); } else { - push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); - push ( @To, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); + push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); + push ( @To, @{ $self->TicketObj->QueueObj->Cc->Emails } ); } } @@ -89,16 +65,15 @@ sub SetRecipients { } if ( $arg =~ /\bAdminCc\b/ ) { - push ( @Bcc, $self->TicketObj->AdminCc->MemberEmailAddresses ); - push ( @Bcc, $self->TicketObj->QueueObj->AdminCc->MemberEmailAddresses ); + push ( @Bcc, @{ $self->TicketObj->AdminCc->Emails } ); + push ( @Bcc, @{ $self->TicketObj->QueueObj->AdminCc->Emails } ); } if ($RT::UseFriendlyToLine) { unless (@To) { - push ( - @PseudoTo, - sprintf($RT::FriendlyToLineFormat, $arg, $self->TicketObj->id), - ); + push ( @PseudoTo, + "\"$arg of $RT::rtname Ticket #" + . $self->TicketObj->id . "\":;" ); } } @@ -106,17 +81,14 @@ sub SetRecipients { #Strip the sender out of the To, Cc and AdminCc and set the # recipients fields used to build the message by the superclass. - # unless a flag is set - if ($RT::NotifyActor) { - @{ $self->{'To'} } = @To; - @{ $self->{'Cc'} } = @Cc; - @{ $self->{'Bcc'} } = @Bcc; - } - else { - @{ $self->{'To'} } = grep ( !/^$creator$/, @To ); - @{ $self->{'Cc'} } = grep ( !/^$creator$/, @Cc ); - @{ $self->{'Bcc'} } = grep ( !/^$creator$/, @Bcc ); - } + + $RT::Logger->debug("$self: To is ".join(",",@To)); + $RT::Logger->debug("$self: Cc is ".join(",",@Cc)); + $RT::Logger->debug("$self: Bcc is ".join(",",@Bcc)); + + @{ $self->{'To'} } = grep ( !/^$creator$/, @To ); + @{ $self->{'Cc'} } = grep ( !/^$creator$/, @Cc ); + @{ $self->{'Bcc'} } = grep ( !/^$creator$/, @Bcc ); @{ $self->{'PseudoTo'} } = @PseudoTo; return (1); @@ -124,9 +96,4 @@ sub SetRecipients { # }}} -eval "require RT::Action::Notify_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Notify_Vendor.pm}); -eval "require RT::Action::Notify_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Notify_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/NotifyAsComment.pm b/rt/lib/RT/Action/NotifyAsComment.pm index 210e4ab15..c72bfff13 100755 --- a/rt/lib/RT/Action/NotifyAsComment.pm +++ b/rt/lib/RT/Action/NotifyAsComment.pm @@ -1,31 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/NotifyAsComment.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + package RT::Action::NotifyAsComment; require RT::Action::Notify; - -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::Notify); @@ -45,11 +21,5 @@ sub SetReturnAddress { return($self->SUPER::SetReturnAddress(is_comment => 1)); } - -eval "require RT::Action::NotifyAsComment_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyAsComment_Vendor.pm}); -eval "require RT::Action::NotifyAsComment_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyAsComment_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/OpenDependent.pm b/rt/lib/RT/Action/OpenDependent.pm new file mode 100644 index 000000000..b271e4709 --- /dev/null +++ b/rt/lib/RT/Action/OpenDependent.pm @@ -0,0 +1,55 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Attic/OpenDependent.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# This Action will open the BASE if a dependent is resolved. + +package RT::Action::OpenDependent; +require RT::Action::Generic; +require RT::Links; +@ISA=qw(RT::Action::Generic); + +#Do what we need to do and send it out. + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return (ref $self . " will stall a [local] BASE if it's open and a dependency link is created."); +} +# }}} + + +# {{{ sub Prepare +sub Prepare { + # nothing to prepare + return 1; +} +# }}} + +sub Commit { + my $self = shift; + + my $Links=RT::Links->new($RT::SystemUser); + $Links->Limit(FIELD => 'Type', VALUE => 'DependsOn'); + $Links->Limit(FIELD => 'Target', VALUE => $self->TicketObj->id); + + while (my $Link=$Links->Next()) { + next unless $Link->BaseIsLocal; + my $base=RT::Ticket->new($self->TicketObj->CurrentUser); + # Todo: Only work if Base is a plain ticket num: + $base->Load($Link->Base); + $base->Open if $base->Status eq 'stalled'; + } +} + + +# Applicability checked in Commit. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + 1; + return 1; +} +# }}} + +1; diff --git a/rt/lib/RT/Action/ResolveMembers.pm b/rt/lib/RT/Action/ResolveMembers.pm index 02ff3a58c..00547ebe8 100644 --- a/rt/lib/RT/Action/ResolveMembers.pm +++ b/rt/lib/RT/Action/ResolveMembers.pm @@ -1,34 +1,8 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK # This Action will resolve all members of a resolved group ticket package RT::Action::ResolveMembers; require RT::Action::Generic; require RT::Links; - -use strict; -use vars qw/@ISA/; @ISA=qw(RT::Action::Generic); #Do what we need to do and send it out. @@ -38,7 +12,7 @@ use vars qw/@ISA/; # {{{ sub Describe sub Describe { my $self = shift; - return $self->loc("[_1] will resolve all members of a resolved group ticket.", ref $self); + return (ref $self . " will resolve all members of a resolved group ticket."); } # }}} @@ -59,7 +33,7 @@ sub Commit { while (my $Link=$Links->Next()) { # Todo: Try to deal with remote URIs as well - next unless $Link->BaseURI->IsLocal; + next unless $Link->BaseIsLocal; my $base=RT::Ticket->new($self->TicketObj->CurrentUser); # Todo: Only work if Base is a plain ticket num: $base->Load($Link->Base); @@ -79,10 +53,5 @@ sub IsApplicable { } # }}} -eval "require RT::Action::ResolveMembers_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/ResolveMembers_Vendor.pm}); -eval "require RT::Action::ResolveMembers_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/ResolveMembers_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index dac8fc8e7..e3abb1154 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -1,44 +1,20 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/SendEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com> # Portions Copyright 2000 Tobias Brox <tobix@cpan.org> +# Released under the terms of version 2 of the GNU Public License package RT::Action::SendEmail; require RT::Action::Generic; -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Action::Generic); -use MIME::Words qw(encode_mimeword); - -use RT::EmailParser; =head1 NAME -RT::Action::SendEmail - An Action which users can use to send mail -or can subclassed for more specialized mail sending behavior. -RT::Action::AutoReply is a good example subclass. + RT::Action::SendEmail - An Action which users can use to send mail + or can subclassed for more specialized mail sending behavior. + RT::Action::AutoReply is a good example subclass. + =head1 SYNOPSIS @@ -60,6 +36,7 @@ the comments for the SetRecipients sub). =begin testing +ok (require RT::TestHarness); ok (require RT::Action::SendEmail); =end testing @@ -77,266 +54,158 @@ perl(1). # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) -# {{{ sub _Init +# {{{ sub _Init # We use _Init from RT::Action # }}} -# {{{ sub Commit +# {{{ sub Commit #Do what we need to do and send it out. -sub Commit { +sub Commit { my $self = shift; - - my $MIMEObj = $self->TemplateObj->MIMEObj; - my $msgid = $MIMEObj->head->get('Message-Id'); - chomp $msgid; - $RT::Logger->info($msgid." #".$self->TicketObj->id."/".$self->TransactionObj->id." - Scrip ". $self->ScripObj->id ." ".$self->ScripObj->Description); #send the email - - # Weed out any RT addresses. We really don't want to talk to ourselves! - @{$self->{'To'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'To'}}); - @{$self->{'Cc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Cc'}}); - @{$self->{'Bcc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Bcc'}}); + # If there are no recipients, don't try to send the message. # If the transaction has content and has the header RT-Squelch-Replies-To - - if ( defined $self->TransactionObj->Attachments->First() ) { - - my $squelch = $self->TransactionObj->Attachments->First->GetHeader( 'RT-Squelch-Replies-To'); - - if ($squelch) { - my @blacklist = split ( /,/, $squelch ); - - # Cycle through the people we're sending to and pull out anyone on the - # system blacklist - - foreach my $person_to_yank (@blacklist) { - $person_to_yank =~ s/\s//g; - @{ $self->{'To'} } = - grep ( !/^$person_to_yank$/, @{ $self->{'To'} } ); - @{ $self->{'Cc'} } = - grep ( !/^$person_to_yank$/, @{ $self->{'Cc'} } ); - @{ $self->{'Bcc'} } = - grep ( !/^$person_to_yank$/, @{ $self->{'Bcc'} } ); - } - } + + if (defined $self->TransactionObj->Message->First()) { + my $headers = $self->TransactionObj->Message->First->Headers(); + + if ($headers =~ /^RT-Squelch-Replies-To: (.*?)$/si) { + my @blacklist = split(/,/,$1); + + # Cycle through the people we're sending to and pull out anyone on the + # system blacklist + + foreach my $person_to_yank (@blacklist) { + $person_to_yank =~ s/\s//g; + @{$self->{'To'}} = grep (!/^$person_to_yank$/, @{$self->{'To'}}); + @{$self->{'Cc'}} = grep (!/^$person_to_yank$/, @{$self->{'Cc'}}); + @{$self->{'Bcc'}} = grep (!/^$person_to_yank$/, @{$self->{'Bcc'}}); + } + } } - - # Go add all the Tos, Ccs and Bccs that we need to to the message to + + # Go add all the Tos, Ccs and Bccs that we need to to the message to # make it happy, but only if we actually have values in those arrays. + + $self->SetHeader('To', join(',', @{$self->{'To'}})) + if (@{$self->{'To'}}); + $self->SetHeader('Cc', join(',' , @{$self->{'Cc'}})) + if (@{$self->{'Cc'}}); + $self->SetHeader('Bcc', join(',', @{$self->{'Bcc'}})) + if (@{$self->{'Bcc'}});; + + my $MIMEObj = $self->TemplateObj->MIMEObj; + - $self->SetHeader( 'To', join ( ',', @{ $self->{'To'} } ) ) - if ( $self->{'To'} && @{ $self->{'To'} } ); - $self->SetHeader( 'Cc', join ( ',', @{ $self->{'Cc'} } ) ) - if ( $self->{'Cc'} && @{ $self->{'Cc'} } ); - $self->SetHeader( 'Bcc', join ( ',', @{ $self->{'Bcc'} } ) ) - if ( $self->{'Cc'} && @{ $self->{'Bcc'} } ); - - - $self->SetHeader('MIME-Version', '1.0'); - - # try to convert message body from utf-8 to $RT::EmailOutputEncoding - $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' ); - - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' ); - $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' ); - - - # Build up a MIME::Entity that looks like the original message. - - my $do_attach = $self->TemplateObj->MIMEObj->head->get('RT-Attach-Message'); - - if ($do_attach) { - $self->TemplateObj->MIMEObj->head->delete('RT-Attach-Message'); - - my $attachments = RT::Attachments->new($RT::SystemUser); - $attachments->Limit( FIELD => 'TransactionId', - VALUE => $self->TransactionObj->Id ); - $attachments->OrderBy('id'); - - my $transaction_content_obj = $self->TransactionObj->ContentObj; - - # attach any of this transaction's attachments - while ( my $attach = $attachments->Next ) { - - # Don't attach anything blank - next unless ( $attach->ContentLength ); - - # We want to make sure that we don't include the attachment that's being sued as the "Content" of this message" - next - if ( $transaction_content_obj - && $transaction_content_obj->Id == $attach->Id - && $transaction_content_obj->ContentType =~ qr{text/plain}i - ); - $MIMEObj->make_multipart('mixed'); - $MIMEObj->attach( Type => $attach->ContentType, - Charset => $attach->OriginalEncoding, - Data => $attach->OriginalContent, - Filename => $self->MIMEEncodeString( $attach->Filename, $RT::EmailOutputEncoding ), - Encoding => '-SUGGEST'); - } - - } - - - my $retval = $self->SendMessage($MIMEObj); - - - return ($retval); -} - -# }}} - -# {{{ sub Prepare - -sub Prepare { - my $self = shift; - - # This actually populates the MIME::Entity fields in the Template Object - - unless ( $self->TemplateObj ) { - $RT::Logger->warning("No template object handed to $self\n"); - } - - unless ( $self->TransactionObj ) { - $RT::Logger->warning("No transaction object handed to $self\n"); - - } - - unless ( $self->TicketObj ) { - $RT::Logger->warning("No ticket object handed to $self\n"); - - } - - my ( $result, $message ) = $self->TemplateObj->Parse( - Argument => $self->Argument, - TicketObj => $self->TicketObj, - TransactionObj => $self->TransactionObj - ); - if ($result) { - - # Header - $self->SetSubject(); - $self->SetSubjectToken(); - $self->SetRecipients(); - $self->SetReturnAddress(); - $self->SetRTSpecialHeaders(); - if ($RT::EmailOutputEncoding) { - - # l10n related header - $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding ); - } - } - - return $result; - -} - -# }}} - -# }}} - -# {{{ SendMessage -=head2 SendMessage MIMEObj - -sends the message using RT's preferred API. -TODO: Break this out to a seperate module - -=cut - -sub SendMessage { - my $self = shift; - my $MIMEObj = shift; - - my $msgid = $MIMEObj->head->get('Message-Id'); - - + $MIMEObj->make_singlepart; + + #If we don't have any recipients to send to, don't send a message; - unless ( $MIMEObj->head->get('To') - || $MIMEObj->head->get('Cc') - || $MIMEObj->head->get('Bcc') ) { - $RT::Logger->info($msgid. " No recipients found. Not sending.\n"); - return (1); + unless ($MIMEObj->head->get('To') || + $MIMEObj->head->get('Cc') || + $MIMEObj->head->get('Bcc') ) { + $RT::Logger->debug("$self: No recipients found. Not sending.\n"); + return(1); } # PseudoTo (fake to headers) shouldn't get matched for message recipients. # If we don't have any 'To' header, drop in the pseudo-to header. - $self->SetHeader( 'To', join ( ',', @{ $self->{'PseudoTo'} } ) ) - if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } ) - and ( !$MIMEObj->head->get('To') ) ); - if ( $RT::MailCommand eq 'sendmailpipe' ) { - eval { - open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" ); - print MAIL $MIMEObj->as_string; - close(MAIL); - }; - if ($@) { - $RT::Logger->crit($msgid. "Could not send mail. -".$@ ); - } + $self->SetHeader('To', join(',', @{$self->{'PseudoTo'}})) + if ( (@{$self->{'PseudoTo'}}) and (! $MIMEObj->head->get('To'))); + + if ($RT::MailCommand eq 'sendmailpipe') { + open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0); + print MAIL $MIMEObj->as_string; + close(MAIL); } else { - my @mailer_args = ($RT::MailCommand); - local $ENV{MAILADDRESS}; - - if ( $RT::MailCommand eq 'sendmail' ) { - push @mailer_args, $RT::SendmailArguments; - } - elsif ( $RT::MailCommand eq 'smtp' ) { - $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From'); - push @mailer_args, (Server => $RT::SMTPServer); - push @mailer_args, (Debug => $RT::SMTPDebug); - } - else { - push @mailer_args, $RT::MailParams; + unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) { + $RT::Logger->crit("$self: Could not send mail for ". + $self->TransactionObj . "\n"); + return(0); } - - unless ( $MIMEObj->send( @mailer_args ) ) { - $RT::Logger->crit($msgid. "Could not send mail." ); - return (0); - } } + + return (1); + +} +# }}} +# {{{ sub Prepare - my $success = ($msgid. " sent To: ".$MIMEObj->head->get('To') . " Cc: ".$MIMEObj->head->get('Cc') . " Bcc: ".$MIMEObj->head->get('Bcc')); - $success =~ s/\n//gi; - $RT::Logger->info($success); +sub Prepare { + my $self = shift; + + # This actually populates the MIME::Entity fields in the Template Object + + unless ($self->TemplateObj) { + $RT::Logger->warning("No template object handed to $self\n"); + } + + unless ($self->TransactionObj) { + $RT::Logger->warning("No transaction object handed to $self\n"); + + } + + unless ($self->TicketObj) { + $RT::Logger->warning("No ticket object handed to $self\n"); + + } + + + $self->TemplateObj->Parse(Argument => $self->Argument, + TicketObj => $self->TicketObj, + TransactionObj => $self->TransactionObj); + + # Header + + $self->SetSubject(); + + $self->SetSubjectToken(); + + $self->SetRecipients(); + + $self->SetReturnAddress(); - return (1); + $self->SetRTSpecialHeaders(); + + return 1; + } # }}} +# }}} + # {{{ Deal with message headers (Set* subs, designed for easy overriding) # {{{ sub SetRTSpecialHeaders -=head2 SetRTSpecialHeaders - -This routine adds all the random headers that RT wants in a mail message -that don't matter much to anybody else. - -=cut +# This routine adds all the random headers that RT wants in a mail message +# that don't matter much to anybody else. sub SetRTSpecialHeaders { my $self = shift; - + $self->SetReferences(); $self->SetMessageID(); - + $self->SetPrecedence(); - $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname ); - $self->SetHeader( 'RT-Ticket', - $RT::rtname . " #" . $self->TicketObj->id() ); - $self->SetHeader( 'Managed-by', - "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); + $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname); + $self->SetHeader('RT-Ticket', $RT::rtname. " #".$self->TicketObj->id()); + $self->SetHeader + ('Managed-by',"RT $RT::VERSION (http://bestpractical.com/rt/)"); + + $self->SetHeader('RT-Originator', $self->TransactionObj->CreatorObj->EmailAddress); + return(); + +} - $self->SetHeader( 'RT-Originator', - $self->TransactionObj->CreatorObj->EmailAddress ); - return (); -} # {{{ sub SetReferences @@ -349,126 +218,105 @@ sub SetRTSpecialHeaders { =cut sub SetReferences { - my $self = shift; + my $self = shift; + + # TODO: this one is broken. What is this email really a reply to? + # If it's a reply to an incoming message, we'll need to use the + # actual message-id from the appropriate Attachment object. For + # incoming mails, we would like to preserve the In-Reply-To and/or + # References. - # TODO: this one is broken. What is this email really a reply to? - # If it's a reply to an incoming message, we'll need to use the - # actual message-id from the appropriate Attachment object. For - # incoming mails, we would like to preserve the In-Reply-To and/or - # References. + $self->SetHeader + ('In-Reply-To', "<rt-".$self->TicketObj->id(). + "\@".$RT::rtname.">"); - $self->SetHeader( 'In-Reply-To', - "<rt-" . $self->TicketObj->id() . "\@" . $RT::rtname . ">" ); - # TODO We should always add References headers for all message-ids - # of previous messages related to this ticket. + # TODO We should always add References headers for all message-ids + # of previous messages related to this ticket. } # }}} # {{{ sub SetMessageID -=head2 SetMessageID - -Without this one, threading won't work very nice in email agents. -Anyway, I'm not really sure it's that healthy if we need to send -several separate/different emails about the same transaction. - -=cut +# Without this one, threading won't work very nice in email agents. +# Anyway, I'm not really sure it's that healthy if we need to send +# several separate/different emails about the same transaction. sub SetMessageID { - my $self = shift; + my $self = shift; - # TODO this one might be sort of broken. If we have several scrips +++ - # sending several emails to several different persons, we need to - # pull out different message-ids. I'd suggest message ids like - # "rt-ticket#-transaction#-scrip#-receipient#" - - $self->SetHeader( 'Message-ID', - "<rt-" - . $RT::VERSION ."-" - . $self->TicketObj->id() . "-" - . $self->TransactionObj->id() . "." - . rand(20) . "\@" - . $RT::Organization . ">" ) + # TODO this one might be sort of broken. If we have several scrips +++ + # sending several emails to several different persons, we need to + # pull out different message-ids. I'd suggest message ids like + # "rt-ticket#-transaction#-scrip#-receipient#" + + $self->SetHeader + ('Message-ID', "<rt-".$self->TicketObj->id(). + "-". + $self->TransactionObj->id()."." .rand(20) . "\@".$RT::Organization.">") unless $self->TemplateObj->MIMEObj->head->get('Message-ID'); } -# }}} # }}} -# {{{ sub SetReturnAddress - -=head2 SetReturnAddress is_comment => BOOLEAN - -Calculate and set From and Reply-To headers based on the is_comment flag. +# }}} -=cut +# {{{ sub SetReturnAddress sub SetReturnAddress { - my $self = shift; - my %args = ( is_comment => 0, - @_ ); - - # From and Reply-To - # $args{is_comment} should be set if the comment address is to be used. - my $replyto; - - if ( $args{'is_comment'} ) { - $replyto = $self->TicketObj->QueueObj->CommentAddress - || $RT::CommentAddress; - } - else { - $replyto = $self->TicketObj->QueueObj->CorrespondAddress - || $RT::CorrespondAddress; - } - - unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { - if ($RT::UseFriendlyFromLine) { - my $friendly_name = $self->TransactionObj->CreatorObj->RealName; - if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string - $friendly_name = $1; - } - - $friendly_name =~ s/"/\\"/g; - $self->SetHeader( 'From', - sprintf($RT::FriendlyFromLineFormat, - $self->MIMEEncodeString( $friendly_name, $RT::EmailOutputEncoding ), $replyto), - ); - } - else { - $self->SetHeader( 'From', $replyto ); - } - } - - unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { - $self->SetHeader( 'Reply-To', "$replyto" ); - } - + my $self = shift; + my %args = ( is_comment => 0, + @_ ); + + # From and Reply-To + # $args{is_comment} should be set if the comment address is to be used. + my $replyto; + + if ($args{'is_comment'}) { + $replyto = $self->TicketObj->QueueObj->CommentAddress || + $RT::CommentAddress; + } + else { + $replyto = $self->TicketObj->QueueObj->CorrespondAddress || + $RT::CorrespondAddress; + } + + unless ($self->TemplateObj->MIMEObj->head->get('From')) { + my $friendly_name=$self->TransactionObj->CreatorObj->RealName; + + if ($friendly_name =~ /^\S+\@\S+$/) { # A "bare" mail address + $friendly_name =~ s/"/\\"/g; + $friendly_name = qq|"$friendly_name"|; + } + + + # TODO: this "via RT" should really be site-configurable. + $self->SetHeader('From', "\"$friendly_name via RT\" <$replyto>"); + } + + unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) { + $self->SetHeader('Reply-To', "$replyto"); + } + } # }}} # {{{ sub SetHeader -=head2 SetHeader FIELD, VALUE - -Set the FIELD of the current MIME object into VALUE. - -=cut - sub SetHeader { - my $self = shift; - my $field = shift; - my $val = shift; - - chomp $val; - chomp $field; - $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 ); - $self->TemplateObj->MIMEObj->head->replace( $field, $val ); - return $self->TemplateObj->MIMEObj->head->get($field); + my $self = shift; + my $field = shift; + my $val = shift; + + chomp $val; + chomp $field; + $self->TemplateObj->MIMEObj->head->fold_length($field,10000); + $self->TemplateObj->MIMEObj->head->add($field, $val); + return $self->TemplateObj->MIMEObj->head->get($field); } # }}} @@ -483,29 +331,21 @@ Dummy method to be overriden by subclasses which want to set the recipients. sub SetRecipients { my $self = shift; - return (); + return(); } # }}} # {{{ sub SetTo -=head2 SetTo - -Takes a string that is the addresses you want to send mail to - -=cut - sub SetTo { - my $self = shift; + my $self=shift; my $addresses = shift; - return $self->SetHeader( 'To', $addresses ); + return $self->SetHeader('To',$addresses); } - # }}} # {{{ sub SetCc - =head2 SetCc Takes a string that is the addresses you want to Cc @@ -513,12 +353,11 @@ Takes a string that is the addresses you want to Cc =cut sub SetCc { - my $self = shift; + my $self=shift; my $addresses = shift; - return $self->SetHeader( 'Cc', $addresses ); + return $self->SetHeader('Cc', $addresses); } - # }}} # {{{ sub SetBcc @@ -528,24 +367,23 @@ sub SetCc { Takes a string that is the addresses you want to Bcc =cut - sub SetBcc { - my $self = shift; + my $self=shift; my $addresses = shift; - return $self->SetHeader( 'Bcc', $addresses ); + return $self->SetHeader('Bcc', $addresses); } # }}} -# {{{ sub SetPrecedence +# {{{ sub SetPrecedence sub SetPrecedence { - my $self = shift; + my $self = shift; - unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ) { - $self->SetHeader( 'Precedence', "bulk" ); - } + unless ($self->TemplateObj->MIMEObj->head->get("Precedence")) { + $self->SetHeader('Precedence', "bulk"); + } } # }}} @@ -561,125 +399,70 @@ the transaction's subject. =cut sub SetSubject { - my $self = shift; + my $self = shift; + unless ($self->TemplateObj->MIMEObj->head->get('Subject')) { + my $message=$self->TransactionObj->Message; + my $ticket=$self->TicketObj->Id; + my $subject; + + if ($self->{'Subject'}) { + $subject = $self->{'Subject'}; + } + elsif (($message->First()) && + ($message->First->Headers)) { + $header = $message->First->Headers(); + $header =~ s/\n\s+/ /g; + if ( $header =~ /^Subject: (.*?)$/m ) { + $subject = $1; + } + else { + $subject = $self->TicketObj->Subject(); + } + + } + else { + $subject = $self->TicketObj->Subject(); + } + + $subject =~ s/(\r\n|\n|\s)/ /gi; - unless ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { - my $message = $self->TransactionObj->Attachments; - my $ticket = $self->TicketObj->Id; - - if ( $self->{'Subject'} ) { - $subject = $self->{'Subject'}; - } - elsif ( ( $message->First() ) - && ( $message->First->Headers ) ) { - my $header = $message->First->Headers(); - $header =~ s/\n\s+/ /g; - if ( $header =~ /^Subject: (.*?)$/m ) { - $subject = $1; - } - else { - $subject = $self->TicketObj->Subject(); - } - - } - else { - $subject = $self->TicketObj->Subject(); - } - - $subject =~ s/(\r\n|\n|\s)/ /gi; - - chomp $subject; - $self->SetHeader( 'Subject', $subject ); - + chomp $subject; + $self->SetHeader('Subject',$subject); + } - return ($subject); + return($subject); } - # }}} # {{{ sub SetSubjectToken =head2 SetSubjectToken -This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. + This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. =cut sub SetSubjectToken { - my $self = shift; - my $tag = "[$RT::rtname #" . $self->TicketObj->id . "]"; - my $sub = $self->TemplateObj->MIMEObj->head->get('Subject'); - unless ( $sub =~ /\Q$tag\E/ ) { - $sub =~ s/(\r\n|\n|\s)/ /gi; - chomp $sub; - $self->TemplateObj->MIMEObj->head->replace( 'Subject', "$tag $sub" ); - } + my $self=shift; + my $tag = "[$RT::rtname #".$self->TicketObj->id."]"; + my $sub = $self->TemplateObj->MIMEObj->head->get('Subject'); + unless ($sub =~ /\Q$tag\E/) { + $sub =~ s/(\r\n|\n|\s)/ /gi; + chomp $sub; + $self->TemplateObj->MIMEObj->head->replace('Subject', "$tag $sub"); + } } # }}} # }}} -# {{{ - -=head2 SetHeaderAsEncoding($field_name, $charset_encoding) - -This routine converts the field into specified charset encoding. - -=cut - -sub SetHeaderAsEncoding { - my $self = shift; - my ( $field, $enc ) = ( shift, shift ); - - if ($field eq 'From' and $RT::SMTPFrom) { - $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom ); - return; - } - - my $value = $self->TemplateObj->MIMEObj->head->get($field); - - # don't bother if it's us-ascii - - # See RT::I18N, 'NOTES: Why Encode::_utf8_off before Encode::from_to' - - $value = $self->MIMEEncodeString($value, $enc); - - $self->TemplateObj->MIMEObj->head->replace( $field, $value ); - - -} -# }}} - -# {{{ MIMENcodeString - -=head2 MIMEEncodeString STRING ENCODING - -Takes a string and a possible encoding and returns the string wrapped in MIME goo. - -=cut - -sub MIMEEncodeString { - my $self = shift; - my $value = shift; - my $enc = shift; +__END__ - chomp $value; - return ($value) unless $value =~ /[^\x20-\x7e]/; - - $value =~ s/\s*$//; - Encode::_utf8_off($value); - my $res = Encode::from_to( $value, "utf-8", $enc ); - $value = encode_mimeword( $value, 'B', $enc ); -} +# {{{ POD # }}} -eval "require RT::Action::SendEmail_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm}); -eval "require RT::Action::SendEmail_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm}); - 1; diff --git a/rt/lib/RT/Action/SendPasswordEmail.pm b/rt/lib/RT/Action/SendPasswordEmail.pm new file mode 100755 index 000000000..91bb3c1cb --- /dev/null +++ b/rt/lib/RT/Action/SendPasswordEmail.pm @@ -0,0 +1,170 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Attic/SendPasswordEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License + +package RT::Action::SendPasswordEmail; +require RT::Action::Generic; + +@ISA = qw(RT::Action::Generic); + + +=head1 NAME + + RT::Action::SendGenericEmail - An Action which users can use to send mail + or can subclassed for more specialized mail sending behavior. + + + +=head1 SYNOPSIS + + require RT::Action::SendPasswordEmail; + + +=head1 DESCRIPTION + +Basically, you create another module RT::Action::YourAction which ISA +RT::Action::SendEmail. + +If you want to set the recipients of the mail to something other than +the addresses mentioned in the To, Cc, Bcc and headers in +the template, you should subclass RT::Action::SendEmail and override +either the SetRecipients method or the SetTo, SetCc, etc methods (see +the comments for the SetRecipients sub). + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Action::SendPasswordEmail); + +=end testing + + +=head1 AUTHOR + +Jesse Vincent <jesse@bestpractical.com> + +=head1 SEE ALSO + +perl(1). + +=cut + +# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) + +# {{{ sub Commit + +#Do what we need to do and send it out. + +sub Commit { + my $self = shift; + #send the email + + + + + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + + $MIMEObj->make_singlepart; + + #If we don\'t have any recipients to send to, don\'t send a message; + unless ($MIMEObj->head->get('To')) { + $RT::Logger->debug("$self: No recipients found. Not sending.\n"); + return(1); + } + + if ($RT::MailCommand eq 'sendmailpipe') { + open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0); + print MAIL $MIMEObj->as_string; + close(MAIL); + } + else { + unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) { + $RT::Logger->crit("$self: Could not send mail for ". + $self->TransactionObj . "\n"); + return(0); + } + } + + return (1); + +} +# }}} + +# {{{ sub Prepare + +sub Prepare { + my $self = shift; + + # This actually populates the MIME::Entity fields in the Template Object + + unless ($self->TemplateObj) { + $RT::Logger->warning("No template object handed to $self\n"); + } + + + unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) { + $self->SetHeader('Reply-To',$RT::CorrespondAddress ); + } + + + $self->SetHeader('Precedence', "bulk"); + $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname); + $self->SetHeader + ('Managed-by',"Request Tracker $RT::VERSION (http://www.fsck.com/projects/rt/)"); + + $self->TemplateObj->Parse(Argument => $self->Argument); + + + return 1; +} + +# }}} + +# }}} + + +# {{{ sub SetTo + +=head2 SetTo EMAIL + +Sets this message's "To" field to EMAIL + +=cut + +sub SetTo { + my $self = shift; + my $to = shift; + $self->SetHeader('To',$to); +} + +# }}} + +# {{{ sub SetHeader + +sub SetHeader { + my $self = shift; + my $field = shift; + my $val = shift; + + chomp $val; + chomp $field; + $self->TemplateObj->MIMEObj->head->fold_length($field,10000); + $self->TemplateObj->MIMEObj->head->add($field, $val); + return $self->TemplateObj->MIMEObj->head->get($field); +} + +# }}} + + + +__END__ + +# {{{ POD + +# }}} + +1; + diff --git a/rt/lib/RT/Action/StallDependent.pm b/rt/lib/RT/Action/StallDependent.pm new file mode 100644 index 000000000..09d3448a8 --- /dev/null +++ b/rt/lib/RT/Action/StallDependent.pm @@ -0,0 +1,68 @@ +# This Action will stall the BASE if a dependency or membership link +# (according to argument) is created and if BASE is open. + +# TODO: Rename this .pm + +package RT::Action::StallDependent; +require RT::Action::Generic; +@ISA=qw|RT::Action::Generic|; + +# {{{ sub Describe +sub Describe { + my $self = shift; + return (ref $self . " will stall a [local] BASE if it's dependent [or member] of a linked up request."); +} +# }}} + + +# {{{ sub Prepare +sub Prepare { + # nothing to prepare + return 1; +} +# }}} + +sub Commit { + my $self = shift; + # Find all Dependent + my $arg=$self->Argument || "DependsOn"; + unless ($self->TransactionObj->Data =~ /^([^ ]+) $arg /) { + warn; return 0; + } + my $base_id=$1; + my $base; + if ($1 eq "THIS") { + $base=$self->TicketObj; + } else { + $base_id=&RT::Link::_IsLocal(undef, $base_id) || return 0; + $base=RT::Ticket->new($self->TicketObj->CurrentUser); + $base->Load($base_id); + } + $base->Stall if $base->Status eq 'open'; + return 0; +} + + +# {{{ sub IsApplicable + +# Only applicable if: +# 1. the link action is a dependency +# 2. BASE is a local ticket + +sub IsApplicable { + my $self = shift; + + my $arg=$self->Argument || "DependsOn"; + + # 1: + $self->TransactionObj->Data =~ /^([^ ]*) $arg / || return 0; + + # 2: + # (dirty!) + &RT::Link::_IsLocal(undef,$1) || return 0; + + return 1; +} +# }}} + +1; diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm index 2ed520162..916ac355e 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -1,372 +1,423 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attachment.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License =head1 NAME -RT::Attachment - + RT::Attachment -- an RT attachment object =head1 SYNOPSIS -=head1 DESCRIPTION + use RT::Attachment; -=head1 METHODS -=cut - -package RT::Attachment; -use RT::Record; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); - -sub _Init { - my $self = shift; - - $self->Table('Attachments'); - $self->SUPER::_Init(@_); -} +=head1 DESCRIPTION +This module should never be instantiated directly by client code. it's an internal +module which should only be instantiated through exported APIs in Ticket, Queue and other +similar objects. +=head1 METHODS -=item Create PARAMHASH +=begin testing -Create takes a hash of values and creates a row in the database: +ok (require RT::TestHarness); +ok (require RT::Attachment); - int(11) 'TransactionId'. - int(11) 'Parent'. - varchar(160) 'MessageId'. - varchar(255) 'Subject'. - varchar(255) 'Filename'. - varchar(80) 'ContentType'. - varchar(80) 'ContentEncoding'. - longtext 'Content'. - longtext 'Headers'. +=end testing =cut - - - -sub Create { - my $self = shift; - my %args = ( - TransactionId => '0', - Parent => '0', - MessageId => '', - Subject => '', - Filename => '', - ContentType => '', - ContentEncoding => '', - Content => '', - Headers => '', - - @_); - $self->SUPER::Create( - TransactionId => $args{'TransactionId'}, - Parent => $args{'Parent'}, - MessageId => $args{'MessageId'}, - Subject => $args{'Subject'}, - Filename => $args{'Filename'}, - ContentType => $args{'ContentType'}, - ContentEncoding => $args{'ContentEncoding'}, - Content => $args{'Content'}, - Headers => $args{'Headers'}, -); - +package RT::Attachment; +use RT::Record; +use MIME::Base64; +use vars qw|@ISA|; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Attachments"; + return($self->SUPER::_Init(@_)); } +# }}} +# {{{ sub _ClassAccessible +sub _ClassAccessible { + { + TransactionId => { 'read'=>1, 'public'=>1, }, + MessageId => { 'read'=>1, }, + Parent => { 'read'=>1, }, + ContentType => { 'read'=>1, }, + Subject => { 'read'=>1, }, + Content => { 'read'=>1, }, + ContentEncoding => { 'read'=>1, }, + Headers => { 'read'=>1, }, + Filename => { 'read'=>1, }, + Creator => { 'read'=>1, 'auto'=>1, }, + Created => { 'read'=>1, 'auto'=>1, }, + }; +} +# }}} +# {{{ sub TransactionObj -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=item TransactionId - -Returns the current value of TransactionId. -(In the database, TransactionId is stored as int(11).) - - - -=item SetTransactionId VALUE - - -Set TransactionId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TransactionId will be stored as a int(11).) +=head2 TransactionObj +Returns the transaction object asscoiated with this attachment. =cut +sub TransactionObj { + require RT::Transaction; + my $self=shift; + unless (exists $self->{_TransactionObj}) { + $self->{_TransactionObj}=RT::Transaction->new($self->CurrentUser); + $self->{_TransactionObj}->Load($self->TransactionId); + } + return $self->{_TransactionObj}; +} -=item Parent - -Returns the current value of Parent. -(In the database, Parent is stored as int(11).) - - - -=item SetParent VALUE +# }}} +# {{{ sub Create -Set Parent to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Parent will be stored as a int(11).) +=head2 Create +Create a new attachment. Takes a paramhash: + + 'Attachment' Should be a single MIME body with optional subparts + 'Parent' is an optional Parent RT::Attachment object + 'TransactionId' is the mandatory id of the Transaction this attachment is associated with.; =cut +sub Create { + my $self = shift; + my ($id); + my %args = ( id => 0, + TransactionId => 0, + Parent => 0, + Attachment => undef, + @_ + ); + + + #For ease of reference + my $Attachment = $args{'Attachment'}; + + #if we didn't specify a ticket, we need to bail + if ( $args{'TransactionId'} == 0) { + $RT::Logger->crit("RT::Attachment->Create couldn't, as you didn't specify a transaction\n"); + return (0); + + } + + #If we possibly can, collapse it to a singlepart + $Attachment->make_singlepart; + + #Get the subject + my $Subject = $Attachment->head->get('subject',0); + defined($Subject) or $Subject = ''; + chomp($Subject); + + #Get the filename + my $Filename = $Attachment->head->recommended_filename; + + if ($Attachment->parts) { + $id = $self->SUPER::Create(TransactionId => $args{'TransactionId'}, + Parent => 0, + ContentType => $Attachment->mime_type, + Headers => $Attachment->head->as_string, + Subject => $Subject, + + ); + foreach my $part ($Attachment->parts) { + my $SubAttachment = new RT::Attachment($self->CurrentUser); + $SubAttachment->Create(TransactionId => $args{'TransactionId'}, + Parent => $id, + Attachment => $part, + ContentType => $Attachment->mime_type, + Headers => $Attachment->head->as_string(), + + ); + } + return ($id); + } + + + #If it's not multipart + else { + + my $ContentEncoding = 'none'; + + my $Body = $Attachment->bodyhandle->as_string; + + #get the max attachment length from RT + my $MaxSize = $RT::MaxAttachmentSize; + + #if the current attachment contains nulls and the + #database doesn't support embedded nulls + + if ( (! $RT::Handle->BinarySafeBLOBs) && + ( $Body =~ /\x00/ ) ) { + # set a flag telling us to mimencode the attachment + $ContentEncoding = 'base64'; + + #cut the max attchment size by 25% (for mime-encoding overhead. + $RT::Logger->debug("Max size is $MaxSize\n"); + $MaxSize = $MaxSize * 3/4; + } + + #if the attachment is larger than the maximum size + if (($MaxSize) and ($MaxSize < length($Body))) { + # if we're supposed to truncate large attachments + if ($RT::TruncateLongAttachments) { + # truncate the attachment to that length. + $Body = substr ($Body, 0, $MaxSize); + + } + + # elsif we're supposed to drop large attachments on the floor, + elsif ($RT::DropLongAttachments) { + # drop the attachment on the floor + $RT::Logger->info("$self: Dropped an attachment of size ". length($Body). + "\n". "It started: ". substr($Body, 0, 60) . "\n"); + return(undef); + } + } + # if we need to mimencode the attachment + if ($ContentEncoding eq 'base64') { + # base64 encode the attachment + $Body = MIME::Base64::encode_base64($Body); + + } + + my $id = $self->SUPER::Create(TransactionId => $args{'TransactionId'}, + ContentType => $Attachment->mime_type, + ContentEncoding => $ContentEncoding, + Parent => $args{'Parent'}, + Content => $Body, + Headers => $Attachment->head->as_string, + Subject => $Subject, + Filename => $Filename, + ); + return ($id); + } +} -=item MessageId - -Returns the current value of MessageId. -(In the database, MessageId is stored as varchar(160).) - - +# }}} -=item SetMessageId VALUE +# {{{ sub Content -Set MessageId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, MessageId will be stored as a varchar(160).) +=head2 Content +Returns the attachment's content. if it's base64 encoded, decode it +before returning it. =cut - -=item Subject - -Returns the current value of Subject. -(In the database, Subject is stored as varchar(255).) - +sub Content { + my $self = shift; + if ( $self->ContentEncoding eq 'none' || ! $self->ContentEncoding ) { + return $self->_Value('Content'); + } elsif ( $self->ContentEncoding eq 'base64' ) { + return MIME::Base64::decode_base64($self->_Value('Content')); + } else { + return( "Unknown ContentEncoding ". $self->ContentEncoding); + } +} -=item SetSubject VALUE +# }}} +# {{{ sub Children -Set Subject to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Subject will be stored as a varchar(255).) +=head2 Children + Returns an RT::Attachments object which is preloaded with all Attachments objects with this Attachment\'s Id as their 'Parent' =cut +sub Children { + my $self = shift; + + my $kids = new RT::Attachments($self->CurrentUser); + $kids->ChildrenOf($self->Id); + return($kids); +} -=item Filename - -Returns the current value of Filename. -(In the database, Filename is stored as varchar(255).) - - - -=item SetFilename VALUE - - -Set Filename to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Filename will be stored as a varchar(255).) - - -=cut +# }}} +# {{{ UTILITIES -=item ContentType +# {{{ sub Quote -Returns the current value of ContentType. -(In the database, ContentType is stored as varchar(80).) +sub Quote { + my $self=shift; + my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system) + @_); -=item SetContentType VALUE + my ($quoted_content, $body, $headers); + my $max=0; + # TODO: Handle Multipart/Mixed (eventually fix the link in the + # ShowHistory web template?) + if ($self->ContentType =~ m{^(text/plain|message)}i) { + $body=$self->Content; -Set ContentType to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ContentType will be stored as a varchar(80).) + # Do we need any preformatting (wrapping, that is) of the message? + # Remove quoted signature. + $body =~ s/\n-- \n(.*)$//s; -=cut + # What's the longest line like? + foreach (split (/\n/,$body)) { + $max=length if ( length > $max); + } + if ($max>76) { + require Text::Wrapper; + my $wrapper=new Text::Wrapper + ( + columns => 70, + body_start => ($max > 70*3 ? ' ' : ''), + par_start => '' + ); + $body=$wrapper->wrap($body); + } -=item ContentEncoding + $body =~ s/^/> /gm; -Returns the current value of ContentEncoding. -(In the database, ContentEncoding is stored as varchar(80).) + $body = '[' . $self->TransactionObj->CreatorObj->Name() . ' - ' . $self->TransactionObj->CreatedAsString() + . "]:\n\n" + . $body . "\n\n"; + } else { + $body = "[Non-text message not quoted]\n\n"; + } + + $max=60 if $max<60; + $max=70 if $max>78; + $max+=2; + return (\$body, $max); +} +# }}} -=item SetContentEncoding VALUE +# {{{ sub NiceHeaders - pulls out only the most relevant headers +=head2 NiceHeaders -Set ContentEncoding to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ContentEncoding will be stored as a varchar(80).) +Returns the To, From, Cc, Date and Subject headers. +It is a known issue that this breaks if any of these headers are not +properly unfolded. =cut +sub NiceHeaders { + my $self=shift; + my $hdrs=""; + for (split(/\n/,$self->Headers)) { + $hdrs.="$_\n" if /^(To|From|RT-Send-Cc|Cc|Date|Subject): /i + } + return $hdrs; +} +# }}} -=item Content - -Returns the current value of Content. -(In the database, Content is stored as longtext.) - - - -=item SetContent VALUE - +# {{{ sub Headers -Set Content to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Content will be stored as a longtext.) +=head2 Headers +Returns this object's headers as a string. This method specifically +removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc. +We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send +out mail. (The mailing rules are seperated from the ticket update code by +an abstraction barrier that makes it impossible to pass this data directly =cut +sub Headers { + my $self = shift; + my $hdrs=""; + for (split(/\n/,$self->SUPER::Headers)) { + $hdrs.="$_\n" unless /^(RT-Send-Bcc): /i + } + return $hdrs; +} -=item Headers - -Returns the current value of Headers. -(In the database, Headers is stored as longtext.) - - - -=item SetHeaders VALUE - - -Set Headers to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Headers will be stored as a longtext.) - - -=cut +# }}} -=item Creator +# {{{ sub GetHeader -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +=head2 GetHeader ( 'Tag') +Returns the value of the header Tag as a string. This bypasses the weeding out +done in Headers() above. =cut +sub GetHeader { + my $self = shift; + my $tag = shift; + foreach my $line (split(/\n/,$self->SUPER::Headers)) { + $RT::Logger->debug( "Does $line match $tag\n"); + if ($line =~ /^$tag:\s+(.*)$/i) { #if we find the header, return its value + return ($1); + } + } + + # we found no header. return an empty string + return undef; +} +# }}} -=item Created +# {{{ sub _Value -Returns the current value of Created. -(In the database, Created is stored as datetime.) +=head2 _Value +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check =cut +sub _Value { + my $self = shift; + my $field = shift; + + + #if the field is public, return it. + if ($self->_Accessible($field, 'public')) { + #$RT::Logger->debug("Skipping ACL check for $field\n"); + return($self->__Value($field)); + + } + + #If it's a comment, we need to be extra special careful + elsif ( (($self->TransactionObj->CurrentUserHasRight('ShowTicketComments')) and + ($self->TransactionObj->Type eq 'Comment') ) or + ($self->TransactionObj->CurrentUserHasRight('ShowTicket'))) { + + return($self->__Value($field)); + } + #if they ain't got rights to see, don't let em + else { + return(undef); + } + + +} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - TransactionId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Parent => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - MessageId => - {read => 1, write => 1, type => 'varchar(160)', default => ''}, - Subject => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - Filename => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - ContentType => - {read => 1, write => 1, type => 'varchar(80)', default => ''}, - ContentEncoding => - {read => 1, write => 1, type => 'varchar(80)', default => ''}, - Content => - {read => 1, write => 1, type => 'longtext', default => ''}, - Headers => - {read => 1, write => 1, type => 'longtext', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::Attachment_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Attachment_Overlay.pm}) { - die $@; - }; - - eval "require RT::Attachment_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Attachment_Vendor.pm}) { - die $@; - }; - - eval "require RT::Attachment_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Attachment_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::Attachment_Overlay, RT::Attachment_Vendor, RT::Attachment_Local - -=cut +# }}} +# }}} 1; diff --git a/rt/lib/RT/Attachments.pm b/rt/lib/RT/Attachments.pm index 177cdd094..73cd350a4 100755 --- a/rt/lib/RT/Attachments.pm +++ b/rt/lib/RT/Attachments.pm @@ -1,115 +1,99 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attachments.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Attachments -- Class Description - + RT::Attachments - a collection of RT::Attachment objects + =head1 SYNOPSIS - use RT::Attachments + use RT::Attachments; =head1 DESCRIPTION +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + =head1 METHODS -=cut -package RT::Attachments; +=begin testing -use RT::SearchBuilder; -use RT::Attachment; +ok (require RT::TestHarness); +ok (require RT::Attachments); -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +=end testing +=cut -sub _Init { - my $self = shift; - $self->{'table'} = 'Attachments'; - $self->{'primary_key'} = 'id'; +package RT::Attachments; +use RT::EasySearch; - return ( $self->SUPER::_Init(@_) ); -} +@ISA= qw(RT::EasySearch); +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "Attachments"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); +} +# }}} -=item NewItem -Returns an empty new RT::Attachment item +# {{{ sub ContentType -=cut +=head2 ContentType (VALUE => 'text/plain', ENTRYAGGREGATOR => 'OR', OPERATOR => '=' ) -sub NewItem { - my $self = shift; - return(RT::Attachment->new($self->CurrentUser)); -} +Limit result set to attachments of ContentType 'TYPE'... - eval "require RT::Attachments_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Attachments_Overlay.pm}) { - die $@; - }; +=cut - eval "require RT::Attachments_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Attachments_Vendor.pm}) { - die $@; - }; - eval "require RT::Attachments_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Attachments_Local.pm}) { - die $@; - }; +sub ContentType { + my $self = shift; + my %args = ( VALUE => 'text/plain', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + @_); + $self->Limit ( FIELD => 'ContentType', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + ENTRYAGGREGATOR => $args{'ENTRYAGGREGATOR'}); +} +# }}} +# {{{ sub ChildrenOf +=head2 ChildrenOf ID -=head1 SEE ALSO +Limit result set to children of Attachment ID -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +=cut -These overlay files can contain new subs or subs to replace existing subs in this module. -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +sub ChildrenOf { + my $self = shift; + my $attachment = shift; + $self->Limit ( FIELD => 'Parent', + VALUE => $attachment); +} +# }}} - no warnings qw(redefine); +# {{{ sub NewItem +sub NewItem { + my $self = shift; -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. + use RT::Attachment; + my $item = new RT::Attachment($self->CurrentUser); + return($item); +} +# }}} + 1; -RT::Attachments_Overlay, RT::Attachments_Vendor, RT::Attachments_Local -=cut -1; diff --git a/rt/lib/RT/Condition/AnyTransaction.pm b/rt/lib/RT/Condition/AnyTransaction.pm index 4519fcf5a..83e5de6ce 100644 --- a/rt/lib/RT/Condition/AnyTransaction.pm +++ b/rt/lib/RT/Condition/AnyTransaction.pm @@ -1,33 +1,10 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Condition/AnyTransaction.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1996-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU General Public License package RT::Condition::AnyTransaction; require RT::Condition::Generic; -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Condition::Generic); @@ -42,10 +19,5 @@ sub IsApplicable { return(1); } -eval "require RT::Condition::AnyTransaction_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/AnyTransaction_Vendor.pm}); -eval "require RT::Condition::AnyTransaction_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/AnyTransaction_Local.pm}); - 1; diff --git a/rt/lib/RT/Condition/Generic.pm b/rt/lib/RT/Condition/Generic.pm index bd269315e..393f4b786 100755 --- a/rt/lib/RT/Condition/Generic.pm +++ b/rt/lib/RT/Condition/Generic.pm @@ -1,26 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Condition/Generic.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + =head1 NAME RT::Condition::Generic - ; @@ -48,6 +29,7 @@ =begin testing +ok (require RT::TestHarness); ok (require RT::Condition::Generic); =end testing @@ -57,11 +39,6 @@ ok (require RT::Condition::Generic); package RT::Condition::Generic; -use RT::Base; -use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Base); - # {{{ sub new sub new { my $proto = shift; @@ -84,6 +61,7 @@ sub _Init { ApplicableTransTypes => undef, @_ ); + $self->{'Argument'} = $args{'Argument'}; $self->{'ScripObj'} = $args{'ScripObj'}; $self->{'TicketObj'} = $args{'TicketObj'}; @@ -122,19 +100,6 @@ sub TicketObj { } # }}} -# {{{ sub ScripObj - -=head2 ScripObj - -Return the Scrip object we're talking about - -=cut - -sub ScripObj { - my $self = shift; - return($self->{'ScripObj'}); -} -# }}} # {{{ sub TransactionObj =head2 TransactionObj @@ -172,7 +137,7 @@ sub ApplicableTransTypes { # {{{ sub Describe sub Describe { my $self = shift; - return ($self->loc("No description for [_1]", ref $self)); + return ("No description for " . ref $self); } # }}} @@ -202,10 +167,4 @@ sub DESTROY { } # }}} - -eval "require RT::Condition::Generic_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/Generic_Vendor.pm}); -eval "require RT::Condition::Generic_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/Generic_Local.pm}); - 1; diff --git a/rt/lib/RT/Condition/NewDependency.pm b/rt/lib/RT/Condition/NewDependency.pm new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/rt/lib/RT/Condition/NewDependency.pm diff --git a/rt/lib/RT/Condition/StatusChange.pm b/rt/lib/RT/Condition/StatusChange.pm index 8afabcda0..56419b2c7 100644 --- a/rt/lib/RT/Condition/StatusChange.pm +++ b/rt/lib/RT/Condition/StatusChange.pm @@ -1,34 +1,10 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK - - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Condition/StatusChange.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ +# Copyright 1996-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU General Public License package RT::Condition::StatusChange; require RT::Condition::Generic; -use strict; -use vars qw/@ISA/; @ISA = qw(RT::Condition::Generic); @@ -50,10 +26,5 @@ sub IsApplicable { } } -eval "require RT::Condition::StatusChange_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/StatusChange_Vendor.pm}); -eval "require RT::Condition::StatusChange_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/StatusChange_Local.pm}); - 1; diff --git a/rt/lib/RT/CurrentUser.pm b/rt/lib/RT/CurrentUser.pm index 4ca2f9891..6997ddbac 100755 --- a/rt/lib/RT/CurrentUser.pm +++ b/rt/lib/RT/CurrentUser.pm @@ -1,26 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/CurrentUser.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-1999 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + =head1 NAME RT::CurrentUser - an RT object representing the current user @@ -38,6 +19,7 @@ =begin testing +ok (require RT::TestHarness); ok (require RT::CurrentUser); =end testing @@ -46,14 +28,10 @@ ok (require RT::CurrentUser); package RT::CurrentUser; - use RT::Record; -use RT::I18N; - -use strict; -use vars qw/@ISA/; @ISA= qw(RT::Record); + # {{{ sub _Init #The basic idea here is that $self->CurrentUser is always supposed @@ -70,7 +48,7 @@ sub _Init { $self->Load($Name); } - $self->CurrentUser($self); + $self->_MyCurrentUser($self); } # }}} @@ -78,8 +56,7 @@ sub _Init { # {{{ sub Create sub Create { - my $self = shift; - return (0, $self->loc('Permission Denied')); + return (0, 'Permission Denied'); } # }}} @@ -87,8 +64,7 @@ sub Create { # {{{ sub Delete sub Delete { - my $self = shift; - return (0, $self->loc('Permission Denied')); + return (0, 'Permission Denied'); } # }}} @@ -108,7 +84,7 @@ sub UserObj { use RT::User; $self->{'UserObj'} = RT::User->new($self); unless ($self->{'UserObj'}->Load($self->Id)) { - $RT::Logger->err($self->loc("Couldn't load [_1] from the users database.\n", $self->Id)); + $RT::Logger->err("Couldn't load ".$self->Id. "from the users database.\n"); } } @@ -116,42 +92,6 @@ sub UserObj { } # }}} -# {{{ sub PrincipalObj - -=head2 PrincipalObj - - Returns this user's principal object. this is just a helper routine for - $self->UserObj->PrincipalObj - -=cut - -sub PrincipalObj { - my $self = shift; - return($self->UserObj->PrincipalObj); -} - - -# }}} - - -# {{{ sub PrincipalId - -=head2 PrincipalId - - Returns this user's principal Id. this is just a helper routine for - $self->UserObj->PrincipalId - -=cut - -sub PrincipalId { - my $self = shift; - return($self->UserObj->PrincipalId); -} - - -# }}} - - # {{{ sub _Accessible sub _Accessible { my $self = shift; @@ -180,8 +120,6 @@ Takes the email address of the user to load. sub LoadByEmail { my $self = shift; my $identifier = shift; - - $identifier = RT::User::CanonicalizeEmailAddress(undef, $identifier); $self->LoadByCol("EmailAddress",$identifier); @@ -287,88 +225,46 @@ sub Privileged { # }}} +# {{{ Convenient ACL methods -# {{{ sub HasRight +=head2 HasQueueRight -=head2 HasRight - -calls $self->UserObj->HasRight with the arguments passed in +calls $self->UserObj->HasQueueRight with the arguments passed in =cut -sub HasRight { - my $self = shift; - return ($self->UserObj->HasRight(@_)); +sub HasQueueRight { + my $self = shift; + return ($self->UserObj->HasQueueRight(@_)); } -# }}} - -# {{{ Localization - -=head2 LanguageHandle +=head2 HasSystemRight -Returns this current user's langauge handle. Should take a language -specification. but currently doesn't +calls $self->UserObj->HasSystemRight with the arguments passed in -=begin testing - -ok (my $cu = RT::CurrentUser->new('root')); -ok (my $lh = $cu->LanguageHandle); -ok ($lh != undef); -ok ($lh->isa('Locale::Maketext')); -ok ($cu->loc('TEST_STRING') eq "Concrete Mixer", "Localized TEST_STRING into English"); -ok ($lh = $cu->LanguageHandle('fr')); -ok ($cu->loc('Before') eq "Avant", "Localized TEST_STRING into Frenc"); - -=end testing +=cut -=cut -sub LanguageHandle { - my $self = shift; - if ((!defined $self->{'LangHandle'}) || - (!UNIVERSAL::can($self->{'LangHandle'}, 'maketext')) || - (@_)) { - $self->{'LangHandle'} = RT::I18N->get_handle(@_); - } - # Fall back to english. - unless ($self->{'LangHandle'}) { - die "We couldn't get a dictionary. Nye mogu naidti slovar. No puedo encontrar dictionario."; - } - return ($self->{'LangHandle'}); +sub HasSystemRight { + my $self = shift; + return ($self->UserObj->HasSystemRight(@_)); } +# }}} -sub loc { - my $self = shift; - return '' if $_[0] eq ''; - - my $handle = $self->LanguageHandle; - - if (@_ == 1) { - # pre-scan the lexicon hashes to return _AUTO keys verbatim, - # to keep locstrings containing '[' and '~' from tripping over Maketext - return $_[0] unless grep { exists $_->{$_[0]} } @{ $handle->_lex_refs }; - } +# {{{ sub HasRight - return $handle->maketext(@_); -} +=head2 HasSystemRight -sub loc_fuzzy { - my $self = shift; - return '' if $_[0] eq ''; +calls $self->UserObj->HasRight with the arguments passed in - # XXX: work around perl's deficiency when matching utf8 data - return $_[0] if Encode::is_utf8($_[0]); - my $result = $self->LanguageHandle->maketext_fuzzy(@_); +=cut - return($result); +sub HasRight { + my $self = shift; + return ($self->UserObj->HasRight(@_)); } -# }}} -eval "require RT::CurrentUser_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Vendor.pm}); -eval "require RT::CurrentUser_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Local.pm}); +# }}} 1; diff --git a/rt/lib/RT/Date.pm b/rt/lib/RT/Date.pm index 355370ada..d56997174 100644 --- a/rt/lib/RT/Date.pm +++ b/rt/lib/RT/Date.pm @@ -1,26 +1,7 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Date.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + =head1 NAME RT::Date - a simple Object Oriented date. @@ -47,15 +28,7 @@ ok (require RT::Date); package RT::Date; - use Time::Local; - -use RT::Base; - -use strict; -use vars qw/@ISA/; -@ISA = qw/RT::Base/; - use vars qw($MINUTE $HOUR $DAY $WEEK $MONTH $YEAR); $MINUTE = 60; @@ -72,7 +45,6 @@ sub new { my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); - $self->CurrentUser(@_); $self->Unix(0); return $self; } @@ -89,114 +61,91 @@ if $args->{'Format'} is 'unix', takes the number of seconds since the epoch If $args->{'Format'} is ISO, tries to parse an ISO date. -If $args->{'Format'} is 'unknown', require Time::ParseDate and make it figure -things out. This is a heavyweight operation that should never be called from -within RT's core. But it's really useful for something like the textbox date -entry where we let the user do whatever they want. +If $args->{'Format'} is 'unknown', require Date::Parse and make it figure things +out. This is a heavyweight operation that should never be called from within +RT's core. But it's really useful for something like the textbox date entry +where we let the user do whatever they want. If $args->{'Value'} is 0, assumes you mean never. -=begin testing - -use_ok(RT::Date); -my $date = RT::Date->new($RT::SystemUser); -$date->Set(Format => 'unix', Value => '0'); -ok ($date->ISO eq '1970-01-01 00:00:00', "Set a date to midnight 1/1/1970 GMT"); - -=end testing =cut sub Set { my $self = shift; my %args = ( Format => 'unix', - Value => time, - @_ ); - if ( !$args{'Value'} - || ( ( $args{'Value'} =~ /^\d*$/ ) and ( $args{'Value'} == 0 ) ) ) { - $self->Unix(-1); - return ( $self->Unix() ); - } - - if ( $args{'Format'} =~ /^unix$/i ) { - $self->Unix( $args{'Value'} ); + Value => time, + @_); + if (($args{'Value'} =~ /^\d*$/) and ($args{'Value'} == 0)) { + $self->Unix(-1); + return($self->Unix()); } - elsif ( $args{'Format'} =~ /^(sql|datemanip|iso)$/i ) { - $args{'Value'} =~ s!/!-!g; - - if (( $args{'Value'} =~ /^(\d{4}?)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ ) - || ( $args{'Value'} =~ - /^(\d{4}?)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/ ) - || ( $args{'Value'} =~ - /^(\d{4}?)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)\+00$/ ) - || ($args{'Value'} =~ /^(\d{4}?)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/ ) - ) { - - my $year = $1; - my $mon = $2; - my $mday = $3; - my $hours = $4; - my $min = $5; - my $sec = $6; - - #timegm expects month as 0->11 - $mon--; - - #now that we've parsed it, deal with the case where everything - #was 0 - if ( $mon == -1 ) { - $self->Unix(-1); - } - else { - - #Dateamnip strings aren't in GMT. - if ( $args{'Format'} =~ /^datemanip$/i ) { - $self->Unix( - timelocal( $sec, $min, $hours, $mday, $mon, $year ) ); - } - - #ISO and SQL dates are in GMT - else { - $self->Unix( - timegm( $sec, $min, $hours, $mday, $mon, $year ) ); - } - - $self->Unix(-1) unless $self->Unix; - } - } - else { - use Carp; - Carp::cluck; - $RT::Logger->debug( - "Couldn't parse date $args{'Value'} as a $args{'Format'}"); - - } + if ($args{'Format'} =~ /^unix$/i) { + $self->Unix($args{'Value'}); } - elsif ( $args{'Format'} =~ /^unknown$/i ) { - require Time::ParseDate; - - #Convert it to an ISO format string - - my $date = Time::ParseDate::parsedate($args{'Value'}, - UK => $RT::DateDayBeforeMonth, - PREFER_PAST => $RT::AmbiguousDayInPast, - PREFER_FUTURE => !($RT::AmbiguousDayInPast)); - - #This date has now been set to a date in the _local_ timezone. - #since ISO dates are known to be in GMT (for RT's purposes); - - $RT::Logger->debug( "RT::Date used date::parse to make " - . $args{'Value'} - . " $date\n" ); - - return ( $self->Set( Format => 'unix', Value => "$date" ) ); + + elsif ($args{'Format'} =~ /^(sql|datemanip|iso)$/i) { + + if (($args{'Value'} =~ /^(\d{4}?)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) || + ($args{'Value'} =~ /^(\d{4}?)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/) || + ($args{'Value'} =~ /^(\d{4}?)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)\+00$/) || + ($args{'Value'} =~ /^(\d{4}?)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/)) { + + my $year = $1; + my $mon = $2; + my $mday = $3; + my $hours = $4; + my $min = $5; + my $sec = $6; + + #timegm expects month as 0->11 + $mon--; + + #now that we've parsed it, deal with the case where everything + #was 0 + if ($mon == -1) { + $self->Unix(-1); + } else { + + #Dateamnip strings aren't in GMT. + if ($args{'Format'} =~ /^datemanip$/i) { + $self->Unix(timelocal($sec,$min,$hours,$mday,$mon,$year)); + } + #ISO and SQL dates are in GMT + else { + $self->Unix(timegm($sec,$min,$hours,$mday,$mon,$year)); + } + + $self->Unix(-1) unless $self->Unix; + } + } + else { + use Carp; + Carp::cluck; + $RT::Logger->debug( "Couldn't parse date $args{'Value'} as a $args{'Format'}"); + + } } + elsif ($args{'Format'} =~ /^unknown$/i) { + require Date::Parse; + #Convert it to an ISO format string + + my $date = Date::Parse::str2time($args{'Value'}); + + #This date has now been set to a date in the _local_ timezone. + #since ISO dates are known to be in GMT (for RT's purposes); + + $RT::Logger->debug("RT::Date used date::parse to make ".$args{'Value'} . " $date\n"); + + + return ($self->Set( Format => 'unix', Value => "$date")); + } else { - die "Unknown Date format: " . $args{'Format'} . "\n"; + die "Unknown Date format: ".$args{'Format'}."\n"; } - - return ( $self->Unix() ); + + return($self->Unix()); } # }}} @@ -283,59 +232,47 @@ sub DiffAsString { # {{{ sub DurationAsString - =head2 DurationAsString Takes a number of seconds. returns a string describing that duration =cut -sub DurationAsString { +sub DurationAsString{ - my $self = shift; + my $self=shift; my $duration = shift; - - my ( $negative, $s ); - - $negative = 1 if ( $duration < 0 ); + + my ($negative, $s); + + $negative = 'ago' if ($duration < 0); $duration = abs($duration); - my $time_unit; - if ( $duration < $MINUTE ) { - $s = $duration; - $time_unit = $self->loc("sec"); - } - elsif ( $duration < ( 2 * $HOUR ) ) { - $s = int( $duration / $MINUTE ); - $time_unit = $self->loc("min"); - } - elsif ( $duration < ( 2 * $DAY ) ) { - $s = int( $duration / $HOUR ); - $time_unit = $self->loc("hours"); - } - elsif ( $duration < ( 2 * $WEEK ) ) { - $s = int( $duration / $DAY ); - $time_unit = $self->loc("days"); - } - elsif ( $duration < ( 2 * $MONTH ) ) { - $s = int( $duration / $WEEK ); - $time_unit = $self->loc("weeks"); - } - elsif ( $duration < $YEAR ) { - $s = int( $duration / $MONTH ); - $time_unit = $self->loc("months"); - } - else { - $s = int( $duration / $YEAR ); - $time_unit = $self->loc("years"); - } - if (0) { # For now, never display the "AGO" # $negative) { - return $self->loc( "[_1] [_2] ago", $s, $time_unit ); - } - else { - return $self->loc( "[_1] [_2]", $s, $time_unit ); + if($duration < $MINUTE) { + $s=$duration; + $string="sec"; + } elsif($duration < (2 * $HOUR)) { + $s = int($duration/$MINUTE); + $string="min"; + } elsif($duration < (2 * $DAY)) { + $s = int($duration/$HOUR); + $string="hours"; + } elsif($duration < (2 * $WEEK)) { + $s = int($duration/$DAY); + $string="days"; + } elsif($duration < (2 * $MONTH)) { + $s = int($duration/$WEEK); + $string="weeks"; + } elsif($duration < $YEAR) { + $s = int($duration/$MONTH); + $string="months"; + } else { + $s = int($duration/$YEAR); + $string="years"; } + + return ("$s $string $negative"); } # }}} @@ -366,64 +303,12 @@ Returns the object\'s time as a string with the current timezone. sub AsString { my $self = shift; - return ($self->loc("Not set")) if ($self->Unix <= 0); - - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($self->Unix); + return ("Not set") if ($self->Unix <= 0); - return $self->loc("[_1] [_2] [_3] [_4]:[_5]:[_6] [_7]", $self->GetWeekday($wday), $self->GetMonth($mon), map {sprintf "%02d", $_} ($mday, $hour, $min, $sec), ($year+1900)); + return (scalar(localtime($self->Unix))); } # }}} -# {{{ GetWeekday -=head2 GetWeekday DAY - -Takes an integer day of week and returns a localized string for that day of week - -=cut - -sub GetWeekday { - my $self = shift; - my $dow = shift; - - return $self->loc('Mon.') if ($dow == 1); - return $self->loc('Tue.') if ($dow == 2); - return $self->loc('Wed.') if ($dow == 3); - return $self->loc('Thu.') if ($dow == 4); - return $self->loc('Fri.') if ($dow == 5); - return $self->loc('Sat.') if ($dow == 6); - return $self->loc('Sun.') if ($dow == 0); -} - -# }}} - -# {{{ GetMonth -=head2 GetMonth DAY - -Takes an integer month and returns a localized string for that month - -=cut - -sub GetMonth { - my $self = shift; - my $mon = shift; - - # We do this rather than an array so that we don't call localize 12x what we need to - return $self->loc('Jan.') if ($mon == 0); - return $self->loc('Feb.') if ($mon == 1); - return $self->loc('Mar.') if ($mon == 2); - return $self->loc('Apr.') if ($mon == 3); - return $self->loc('May.') if ($mon == 4); - return $self->loc('Jun.') if ($mon == 5); - return $self->loc('Jul.') if ($mon == 6); - return $self->loc('Aug.') if ($mon == 7); - return $self->loc('Sep.') if ($mon == 8); - return $self->loc('Oct.') if ($mon == 9); - return $self->loc('Nov.') if ($mon == 10); - return $self->loc('Dec.') if ($mon == 11); -} - -# }}} - # {{{ sub AddSeconds =head2 sub AddSeconds @@ -540,18 +425,12 @@ pull from a 'Timezone' attribute of the CurrentUser sub LocalTimezone { my $self = shift; - - return $self->CurrentUser->Timezone - if $self->CurrentUser and $self->CurrentUser->can('Timezone'); - + return ($RT::Timezone); } # }}} -eval "require RT::Date_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Date_Vendor.pm}); -eval "require RT::Date_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Date_Local.pm}); + 1; diff --git a/rt/lib/RT/EasySearch.pm b/rt/lib/RT/EasySearch.pm new file mode 100755 index 000000000..bcbfa01b2 --- /dev/null +++ b/rt/lib/RT/EasySearch.pm @@ -0,0 +1,115 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/EasySearch.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::EasySearch - a baseclass for RT collection objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + + +=head1 METHODS + + +=begin testing + +ok (require RT::EasySearch); + +=end testing + + +=cut + +package RT::EasySearch; +use DBIx::SearchBuilder; +@ISA= qw(DBIx::SearchBuilder); + +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'user'} = shift; + unless(defined($self->CurrentUser)) { + use Carp; + Carp::confess("$self was created without a CurrentUser"); + $RT::Logger->err("$self was created without a CurrentUser\n"); + return(0); + } + $self->SUPER::_Init( 'Handle' => $RT::Handle); +} +# }}} + +# {{{ sub LimitToEnabled + +=head2 LimitToEnabled + +Only find items that haven\'t been disabled + +=cut + +sub LimitToEnabled { + my $self = shift; + + $self->Limit( FIELD => 'Disabled', + VALUE => '0', + OPERATOR => '=' ); +} +# }}} + +# {{{ sub LimitToDisabled + +=head2 LimitToDeleted + +Only find items that have been deleted. + +=cut + +sub LimitToDeleted { + my $self = shift; + + $self->{'find_disabled_rows'} = 1; + $self->Limit( FIELD => 'Disabled', + OPERATOR => '=', + VALUE => '1' + ); +} +# }}} + + +# {{{ sub Limit + +=head2 Limit PARAMHASH + +This Limit sub calls SUPER::Limit, but defaults "CASESENSITIVE" to 1, thus +making sure that by default lots of things don't do extra work trying to +match lower(colname) agaist lc($val); + +=cut + +sub Limit { + my $self = shift; + my %args = ( CASESENSITIVE => 1, + @_ ); + + return $self->SUPER::Limit(%args); +} + +# {{{ sub CurrentUser + +=head2 CurrentUser + + Returns the current user as an RT::User object. + +=cut + +sub CurrentUser { + my $self = shift; + return ($self->{'user'}); +} +# }}} + + +1; + + diff --git a/rt/lib/RT/Group.pm b/rt/lib/RT/Group.pm index 4dcef3f07..005601f5e 100755 --- a/rt/lib/RT/Group.pm +++ b/rt/lib/RT/Group.pm @@ -1,258 +1,364 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Group.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# # - -use strict; - =head1 NAME -RT::Group - + RT::Group - RT\'s group object =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::Group; -use RT::Record; + use RT::Group; +my $group = new RT::Group($CurrentUser); +=head1 DESCRIPTION -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +An RT group object. -sub _Init { - my $self = shift; +=head1 AUTHOR - $self->Table('Groups'); - $self->SUPER::_Init(@_); -} +Jesse Vincent, jesse@fsck.com +=head1 SEE ALSO +RT +=head1 METHODS -=item Create PARAMHASH +=begin testing -Create takes a hash of values and creates a row in the database: +ok (require RT::TestHarness); +ok (require RT::Group); - varchar(200) 'Name'. - varchar(255) 'Description'. - varchar(64) 'Domain'. - varchar(64) 'Type'. - varchar(64) 'Instance'. +=end testing =cut +package RT::Group; +use RT::Record; +use RT::GroupMember; +use RT::ACE; +use vars qw|@ISA|; +@ISA= qw(RT::Record); -sub Create { - my $self = shift; - my %args = ( - Name => '', - Description => '', - Domain => '', - Type => '', - Instance => '', - - @_); - $self->SUPER::Create( - Name => $args{'Name'}, - Description => $args{'Description'}, - Domain => $args{'Domain'}, - Type => $args{'Type'}, - Instance => $args{'Instance'}, -); +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Groups"; + return ($self->SUPER::_Init(@_)); } +# }}} +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Name => 'read/write', + Description => 'read/write', + Pseudo => 'read' + ); + return $self->SUPER::_Accessible(@_, %Cols); +} +# }}} +# {{{ sub Load -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) +=head2 Load +Load a group object from the database. Takes a single argument. +If the argument is numerical, load by the column 'id'. Otherwise, load by +the "Name" column which is the group's textual name =cut +sub Load { + my $self = shift; + my $identifier = shift || return undef; + + #if it's an int, load by id. otherwise, load by name. + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol("Name",$identifier); + } +} -=item Name - -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) - - - -=item SetName VALUE +# }}} +# {{{ sub Create -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) +=head2 Create +Takes a paramhash with three named arguments: Name, Description and Pseudo. +Pseudo is used internally by RT for certain special ACL decisions. =cut +sub Create { + my $self = shift; + my %args = ( Name => undef, + Description => undef, + Pseudo => 0, + @_); + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + $RT::Logger->warning($self->CurrentUser->Name ." Tried to create a group without permission."); + return(0, 'Permission Denied'); + } + + my $retval = $self->SUPER::Create(Name => $args{'Name'}, + Description => $args{'Description'}, + Pseudo => $args{'Pseudo'}); + + return ($retval); +} -=item Description - -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) - - - -=item SetDescription VALUE +# }}} +# {{{ sub Delete -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) +=head2 Delete +Delete this object =cut +sub Delete { + my $self = shift; + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + + return($self->SUPER::Delete(@_)); +} -=item Domain - -Returns the current value of Domain. -(In the database, Domain is stored as varchar(64).) - +# }}} +# {{{ MembersObj -=item SetDomain VALUE +=head2 MembersObj +Returns an RT::GroupMembers object of this group's members. -Set Domain to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Domain will be stored as a varchar(64).) +=cut +sub MembersObj { + my $self = shift; + unless (defined $self->{'members_obj'}) { + use RT::GroupMembers; + $self->{'members_obj'} = new RT::GroupMembers($self->CurrentUser); + + #If we don't have rights, don't include any results + $self->{'members_obj'}->LimitToGroup($self->id); + + } + return ($self->{'members_obj'}); + +} -=cut +# }}} +# {{{ AddMember -=item Type +=head2 AddMember -Returns the current value of Type. -(In the database, Type is stored as varchar(64).) +AddMember adds a user to this group. It takes a user id. +Returns a two value array. the first value is true on successful +addition or 0 on failure. The second value is a textual status msg. +=cut +sub AddMember { + my $self = shift; + my $new_member = shift; + + my $new_member_obj = new RT::User($self->CurrentUser); + $new_member_obj->Load($new_member); + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + #User has no permission to be doing this + return(0, "Permission Denied"); + } + + unless ($new_member_obj->Id) { + $RT::Logger->debug("Couldn't find user $new_member"); + return(0, "Couldn't find user"); + } + + if ($self->HasMember($new_member_obj->Id)) { + #User is already a member of this group. no need to add it + return(0, "Group already has member"); + } + + my $member_object = new RT::GroupMember($self->CurrentUser); + $member_object->Create( UserId => $new_member_obj->Id, + GroupId => $self->id ); + return(1, "Member added"); +} -=item SetType VALUE +# }}} +# {{{ HasMember -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(64).) +=head2 HasMember +Takes a user Id and returns a GroupMember Id if that user is a member of +this group. +Returns undef if the user isn't a member of the group or if the current +user doesn't have permission to find out. Arguably, it should differentiate +between ACL failure and non membership. =cut +sub HasMember { + my $self = shift; + my $user_id = shift; -=item Instance + #Try to cons up a member object using "LoadByCols" -Returns the current value of Instance. -(In the database, Instance is stored as varchar(64).) + my $member_obj = new RT::GroupMember($self->CurrentUser); + $member_obj->LoadByCols( UserId => $user_id, GroupId => $self->id); + #If we have a member object + if (defined $member_obj->id) { + return ($member_obj->id); + } + #If Load returns no objects, we have an undef id. + else { + return(undef); + } +} -=item SetInstance VALUE +# }}} +# {{{ DeleteMember -Set Instance to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Instance will be stored as a varchar(64).) +=head2 DeleteMember +Takes the user id of a member. +If the current user has apropriate rights, +removes that GroupMember from this group. +Returns a two value array. the first value is true on successful +addition or 0 on failure. The second value is a textual status msg. =cut +sub DeleteMember { + my $self = shift; + my $member = shift; + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + #User has no permission to be doing this + return(0,"Permission Denied"); + } + + my $member_user_obj = new RT::User($self->CurrentUser); + $member_user_obj->Load($member); + + unless ($member_user_obj->Id) { + $RT::Logger->debug("Couldn't find user $member"); + return(0, "User not found"); + } + + my $member_obj = new RT::GroupMember($self->CurrentUser); + unless ($member_obj->LoadByCols ( UserId => $member_user_obj->Id, + GroupId => $self->Id )) { + return(0, "Couldn\'t load member"); #couldn\'t load member object + } + + #If we couldn't load it, return undef. + unless ($member_obj->Id()) { + return (0, "Group has no such member"); + } + + #Now that we've checked ACLs and sanity, delete the groupmember + my $val = $member_obj->Delete(); + if ($val) { + return ($val, "Member deleted"); + } + else { + return (0, "Member not deleted"); + } +} +# }}} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Name => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - Domain => - {read => 1, write => 1, type => 'varchar(64)', default => ''}, - Type => - {read => 1, write => 1, type => 'varchar(64)', default => ''}, - Instance => - {read => 1, write => 1, type => 'varchar(64)', default => ''}, +# {{{ ACL Related routines - } -}; +# {{{ GrantQueueRight +=head2 GrantQueueRight - eval "require RT::Group_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Group_Overlay.pm}) { - die $@; - }; +Grant a queue right to this group. Takes a paramhash of which the elements +RightAppliesTo and RightName are important. - eval "require RT::Group_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Group_Vendor.pm}) { - die $@; - }; +=cut - eval "require RT::Group_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Group_Local.pm}) { - die $@; - }; +sub GrantQueueRight { + + my $self = shift; + my %args = ( RightScope => 'Queue', + RightName => undef, + RightAppliesTo => undef, + PrincipalType => 'Group', + PrincipalId => $self->Id, + @_); + + #ACLs get checked in ACE.pm + + my $ace = new RT::ACE($self->CurrentUser); + + return ($ace->Create(%args)); +} +# }}} +# {{{ GrantSystemRight +=head2 GrantSystemRight -=head1 SEE ALSO +Grant a system right to this group. +The only element that's important to set is RightName. -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. +=cut +sub GrantSystemRight { + + my $self = shift; + my %args = ( RightScope => 'System', + RightName => undef, + RightAppliesTo => 0, + PrincipalType => 'Group', + PrincipalId => $self->Id, + @_); + + # ACLS get checked in ACE.pm + + my $ace = new RT::ACE($self->CurrentUser); + return ($ace->Create(%args)); +} -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - no warnings qw(redefine); +# }}} -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. -RT::Group_Overlay, RT::Group_Vendor, RT::Group_Local +# {{{ sub _Set +sub _Set { + my $self = shift; -=cut + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + return ($self->SUPER::_Set(@_)); -1; +} +# }}} diff --git a/rt/lib/RT/GroupMember.pm b/rt/lib/RT/GroupMember.pm index 8de1a73fe..69de50b42 100755 --- a/rt/lib/RT/GroupMember.pm +++ b/rt/lib/RT/GroupMember.pm @@ -1,189 +1,136 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/GroupMember.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License =head1 NAME -RT::GroupMember - + RT::GroupMember - a member of an RT Group =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::GroupMember; -use RT::Record; - +RT::GroupMember should never be called directly. It should generally +only be accessed through the helper functions in RT::Group; -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +=head1 DESCRIPTION -sub _Init { - my $self = shift; - $self->Table('GroupMembers'); - $self->SUPER::_Init(@_); -} +=head1 METHODS +=begin testing -=item Create PARAMHASH +ok (require RT::TestHarness); +ok (require RT::GroupMember); -Create takes a hash of values and creates a row in the database: +=end testing - int(11) 'GroupId'. - int(11) 'MemberId'. =cut +package RT::GroupMember; +use RT::Record; +use vars qw|@ISA|; +@ISA= qw(RT::Record); +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "GroupMembers"; + return($self->SUPER::_Init(@_)); +} +# }}} - -sub Create { +# {{{ sub _Accessible +sub _Accessible { my $self = shift; - my %args = ( - GroupId => '0', - MemberId => '0', - - @_); - $self->SUPER::Create( - GroupId => $args{'GroupId'}, - MemberId => $args{'MemberId'}, -); + my %Cols = ( + GroupId => 'read', + UserId => 'read' + ); + return $self->SUPER::_Accessible(@_, %Cols); } +# }}} +# {{{ sub Create +# a helper method for Add -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=item GroupId - -Returns the current value of GroupId. -(In the database, GroupId is stored as int(11).) - - - -=item SetGroupId VALUE +sub Create { + my $self = shift; + my %args = ( GroupId => undef, + UserId => undef, + @_ + ); + + unless( $self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + + return ($self->SUPER::Create(GroupId => $args{'GroupId'}, + UserId => $args{'UserId'})) +} +# }}} +# {{{ sub Add -Set GroupId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, GroupId will be stored as a int(11).) +=head2 Add +Takes a paramhash of UserId and GroupId. makes that user a memeber +of that group =cut +sub Add { + my $self = shift; + return ($self->Create(@_)); +} +# }}} -=item MemberId - -Returns the current value of MemberId. -(In the database, MemberId is stored as int(11).) - - - -=item SetMemberId VALUE - +# {{{ sub Delete -Set MemberId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, MemberId will be stored as a int(11).) +=head2 Delete +Takes no arguments. deletes the currently loaded member from the +group in question. =cut +sub Delete { + my $self = shift; + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + return($self->SUPER::Delete(@_)); +} +# }}} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - GroupId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - MemberId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - - } -}; - - - eval "require RT::GroupMember_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/GroupMember_Overlay.pm}) { - die $@; - }; - - eval "require RT::GroupMember_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/GroupMember_Vendor.pm}) { - die $@; - }; - - eval "require RT::GroupMember_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/GroupMember_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); +# {{{ sub UserObj -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 UserObj -RT::GroupMember_Overlay, RT::GroupMember_Vendor, RT::GroupMember_Local +Returns an RT::User object for the user specified by $self->UserId =cut +sub UserObj { + my $self = shift; + unless (defined ($self->{'user_obj'})) { + $self->{'user_obj'} = new RT::User($self->CurrentUser); + $self->{'user_obj'}->Load($self->UserId); + } + return($self->{'user_obj'}); +} -1; +# {{{ sub _Set +sub _Set { + my $self = shift; + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + return($self->SUPER::_Set(@_)); +} +# }}} diff --git a/rt/lib/RT/GroupMembers.pm b/rt/lib/RT/GroupMembers.pm index 31cb9536f..a90a2a899 100755 --- a/rt/lib/RT/GroupMembers.pm +++ b/rt/lib/RT/GroupMembers.pm @@ -1,115 +1,73 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/GroupMembers.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::GroupMembers -- Class Description - + RT::GroupMembers - a collection of RT::GroupMember objects + =head1 SYNOPSIS - use RT::GroupMembers + use RT::GroupMembers; =head1 DESCRIPTION =head1 METHODS -=cut -package RT::GroupMembers; +=begin testing -use RT::SearchBuilder; -use RT::GroupMember; +ok (require RT::TestHarness); +ok (require RT::GroupMembers); + +=end testing -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +=cut +package RT::GroupMembers; +use RT::EasySearch; +use RT::GroupMember; -sub _Init { - my $self = shift; - $self->{'table'} = 'GroupMembers'; - $self->{'primary_key'} = 'id'; +@ISA= qw(RT::EasySearch); - return ( $self->SUPER::_Init(@_) ); +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "GroupMembers"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_) ); } +# }}} +# {{{ sub LimitToGroup -=item NewItem +=head2 LimitToGroup -Returns an empty new RT::GroupMember item +Takes a group id as its only argument. Limits the current search to that +group object =cut -sub NewItem { +sub LimitToGroup { my $self = shift; - return(RT::GroupMember->new($self->CurrentUser)); -} - - eval "require RT::GroupMembers_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/GroupMembers_Overlay.pm}) { - die $@; - }; + my $group = shift; - eval "require RT::GroupMembers_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/GroupMembers_Vendor.pm}) { - die $@; - }; + return ($self->Limit( + VALUE => "$group", + FIELD => 'GroupId', + ENTRYAGGREGATOR => 'OR', + )); - eval "require RT::GroupMembers_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/GroupMembers_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +} +# }}} -RT::GroupMembers_Overlay, RT::GroupMembers_Vendor, RT::GroupMembers_Local - -=cut +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::GroupMember->new($self->CurrentUser)) +} +# }}} 1; diff --git a/rt/lib/RT/Groups.pm b/rt/lib/RT/Groups.pm index 29f12a5a0..f44f1fdb3 100755 --- a/rt/lib/RT/Groups.pm +++ b/rt/lib/RT/Groups.pm @@ -1,115 +1,100 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Groups.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Groups -- Class Description - + RT::Groups - a collection of RT::Group objects + =head1 SYNOPSIS - use RT::Groups + use RT::Groups; + my $groups = $RT::Groups->new($CurrentUser); + $groups->LimitToReal(); + while (my $group = $groups->Next()) { + print $group->Id ." is a group id\n"; + } =head1 DESCRIPTION =head1 METHODS -=cut - -package RT::Groups; -use RT::SearchBuilder; -use RT::Group; +=begin testing -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +ok (require RT::TestHarness); +ok (require RT::Groups); +=end testing -sub _Init { - my $self = shift; - $self->{'table'} = 'Groups'; - $self->{'primary_key'} = 'id'; +=cut +package RT::Groups; +use RT::EasySearch; +use RT::Groups; - return ( $self->SUPER::_Init(@_) ); -} +@ISA= qw(RT::EasySearch); +# {{{ sub _Init -=item NewItem +sub _Init { + my $self = shift; + $self->{'table'} = "Groups"; + $self->{'primary_key'} = "id"; -Returns an empty new RT::Group item + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); -=cut -sub NewItem { - my $self = shift; - return(RT::Group->new($self->CurrentUser)); + return ( $self->SUPER::_Init(@_)); } +# }}} - eval "require RT::Groups_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Groups_Overlay.pm}) { - die $@; - }; +# {{{ LimitToReal - eval "require RT::Groups_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Groups_Vendor.pm}) { - die $@; - }; +=head2 LimitToReal - eval "require RT::Groups_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Groups_Local.pm}) { - die $@; - }; +Make this groups object return only "real" groups, which can be +granted rights and have members assigned to them +=cut +sub LimitToReal { + my $self = shift; + return ($self->Limit( FIELD => 'Pseudo', + VALUE => '0', + OPERATOR => '=')); -=head1 SEE ALSO +} +# }}} -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +# {{{ sub LimitToPseudo -These overlay files can contain new subs or subs to replace existing subs in this module. +=head2 LimitToPseudo -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +Make this groups object return only "pseudo" groups, which can be +granted rights but whose membership lists are determined dynamically. - no warnings qw(redefine); +=cut + + sub LimitToPseudo { + my $self = shift; -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. + return ($self->Limit( FIELD => 'Pseudo', + VALUE => '1', + OPERATOR => '=')); -RT::Groups_Overlay, RT::Groups_Vendor, RT::Groups_Local +} +# }}} -=cut +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return (RT::Group->new($self->CurrentUser)); +} +# }}} 1; + diff --git a/rt/lib/RT/Handle.pm b/rt/lib/RT/Handle.pm index 5cdb65e5b..6b74f361b 100644 --- a/rt/lib/RT/Handle.pm +++ b/rt/lib/RT/Handle.pm @@ -1,26 +1,5 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Handle.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + =head1 NAME RT::Handle - RT's database handle @@ -43,16 +22,14 @@ ok(require RT::Handle); package RT::Handle; -use strict; -use vars qw/@ISA/; - eval "use DBIx::SearchBuilder::Handle::$RT::DatabaseType; + \@ISA= qw(DBIx::SearchBuilder::Handle::$RT::DatabaseType);"; + #TODO check for errors here. =head2 Connect -Connects to RT's database handle. Takes nothing. Calls SUPER::Connect with the needed args =cut @@ -61,41 +38,16 @@ sub Connect { my $self=shift; # Unless the database port is a positive integer, we really don't want to pass it. - -$self->SUPER::Connect( - User => $RT::DatabaseUser, - Password => $RT::DatabasePassword, - ); - -} - -=item BuildDSN - -Build the DSN for the RT database. doesn't take any parameters, draws all that -from the config file. - -=cut - - -sub BuildDSN { - my $self = shift; $RT::DatabasePort = undef unless (defined $RT::DatabasePort && $RT::DatabasePort =~ /^(\d+)$/); -$RT::DatabaseHost = undef unless (defined $RT::DatabaseHost && $RT::DatabaseHost ne ''); - $self->SUPER::BuildDSN(Host => $RT::DatabaseHost, +$self->SUPER::Connect(Host => $RT::DatabaseHost, Database => $RT::DatabaseName, + User => $RT::DatabaseUser, + Password => $RT::DatabasePassword, Port => $RT::DatabasePort, Driver => $RT::DatabaseType, RequireSSL => $RT::DatabaseRequireSSL, - DisconnectHandleOnDestroy => 1 ); - } - -eval "require RT::Handle_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Handle_Vendor.pm}); -eval "require RT::Handle_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Handle_Local.pm}); - 1; diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm index a3c840af5..a3bf92d5f 100644 --- a/rt/lib/RT/Interface/CLI.pm +++ b/rt/lib/RT/Interface/CLI.pm @@ -1,31 +1,9 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -use strict; +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/CLI.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ +# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com> -use RT; package RT::Interface::CLI; +use strict; BEGIN { @@ -33,14 +11,14 @@ BEGIN { use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking - $VERSION = do { my @r = (q$Revision: 1.1.1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker + $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker @ISA = qw(Exporter); # your exported package globals go here, # as well as any optionally exported functions - @EXPORT_OK = qw(&CleanEnv - &GetCurrentUser &GetMessageContent &debug &loc); + @EXPORT_OK = qw(&CleanEnv &LoadConfig &DBConnect + &GetCurrentUser &GetMessageContent &debug); } =head1 NAME @@ -49,28 +27,25 @@ BEGIN { =head1 SYNOPSIS - use lib "/path/to/rt/libraries/"; + use lib "!!RT_LIB_PATH!!"; + use lib "!!RT_ETC_PATH!!"; - use RT::Interface::CLI qw(CleanEnv - GetCurrentUser GetMessageContent loc); + use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect + GetCurrentUser GetMessageContent); #Clean out all the nasties from the environment CleanEnv(); - #let's talk to RT' - use RT; + #Load etc/config.pm and drop privs + LoadConfig(); - #Load RT's config file - RT::LoadConfig(); + #Connect to the database and get RT::SystemUser and RT::Nobody loaded + DBConnect(); - # Connect to the database. set up loggign - RT::Init(); #Get the current user all loaded my $CurrentUser = GetCurrentUser(); - print loc('Hello!'); # Synonym of $CuurentUser->loc('Hello!'); - =head1 DESCRIPTION @@ -78,6 +53,7 @@ BEGIN { =begin testing +ok(require RT::TestHarness); ok(require RT::Interface::CLI); =end testing @@ -101,10 +77,35 @@ sub CleanEnv { +=head2 LoadConfig + +Loads RT's config file and then drops setgid privileges. + +=cut + +sub LoadConfig { + + #This drags in RT's config.pm + use config; + +} + + + +=head2 DBConnect + + Calls RT::Init, which creates a database connection and then creates $RT::Nobody + and $RT::SystemUser + +=cut + + +sub DBConnect { + use RT; + RT::Init(); +} -{ - my $CurrentUser; # shared betwen GetCurrentUser and loc # {{{ sub GetCurrentUser @@ -114,14 +115,15 @@ sub CleanEnv { loaded with that user. if the current user isn't found, returns a copy of RT::Nobody. =cut - sub GetCurrentUser { + my ($Gecos, $CurrentUser); + require RT::CurrentUser; #Instantiate a user object - my $Gecos= ($^O eq 'MSWin32') ? Win32::LoginName() : (getpwuid($<))[0]; + $Gecos=(getpwuid($<))[0]; #If the current user is 0, then RT will assume that the User object #is that of the currentuser. @@ -132,29 +134,10 @@ sub GetCurrentUser { unless ($CurrentUser->Id) { $RT::Logger->debug("No user with a unix login of '$Gecos' was found. "); } - return($CurrentUser); } # }}} - -# {{{ sub loc - -=head2 loc - - Synonym of $CurrentUser->loc(). - -=cut - -sub loc { - die "No current user yet" unless $CurrentUser ||= RT::CurrentUser->new; - return $CurrentUser->loc(@_); -} -# }}} - -} - - # {{{ sub GetMessageContent =head2 GetMessageContent @@ -238,9 +221,4 @@ sub debug { # }}} -eval "require RT::Interface::CLI_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/CLI_Vendor.pm}); -eval "require RT::Interface::CLI_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/CLI_Local.pm}); - 1; diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index bc1a55da2..e95436091 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -1,58 +1,41 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Email.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ +# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com> + package RT::Interface::Email; use strict; use Mail::Address; use MIME::Entity; -use RT::EmailParser; - BEGIN { use Exporter (); use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking - $VERSION = do { my @r = (q$Revision: 1.1.1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker + $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker @ISA = qw(Exporter); # your exported package globals go here, # as well as any optionally exported functions - @EXPORT_OK = qw( - &CreateUser + @EXPORT_OK = qw(&CleanEnv + &LoadConfig + &DBConnect + &GetCurrentUser &GetMessageContent &CheckForLoops &CheckForSuspiciousSender &CheckForAutoGenerated + &ParseMIMEEntityFromSTDIN + &ParseTicketId &MailError &ParseCcAddressesFromHead &ParseSenderAddressFromHead - &ParseErrorsToAddressFromHead - &ParseAddressFromHeader - &Gateway); + &ParseErrorsToAddressFromHead + &ParseAddressFromHeader + + &debug); } =head1 NAME @@ -64,13 +47,28 @@ BEGIN { use lib "!!RT_LIB_PATH!!"; use lib "!!RT_ETC_PATH!!"; - use RT::Interface::Email qw(Gateway CreateUser); + use RT::Interface::Email qw(CleanEnv LoadConfig DBConnect + ); + + #Clean out all the nasties from the environment + CleanEnv(); + + #Load etc/config.pm and drop privs + LoadConfig(); + + #Connect to the database and get RT::SystemUser and RT::Nobody loaded + DBConnect(); + + + #Get the current user all loaded + my $CurrentUser = GetCurrentUser(); =head1 DESCRIPTION =begin testing +ok(require RT::TestHarness); ok(require RT::Interface::Email); =end testing @@ -81,6 +79,71 @@ ok(require RT::Interface::Email); =cut +=head2 CleanEnv + +Removes some of the nastiest nasties from the user\'s environment. + +=cut + +sub CleanEnv { + $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need + $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; + $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; + $ENV{'ENV'} = '' if defined $ENV{'ENV'}; + $ENV{'IFS'} = '' if defined $ENV{'IFS'}; +} + + + +=head2 LoadConfig + +Loads RT's config file and then drops setgid privileges. + +=cut + +sub LoadConfig { + + #This drags in RT's config.pm + use config; + +} + + + +=head2 DBConnect + + Calls RT::Init, which creates a database connection and then creates $RT::Nobody + and $RT::SystemUser + +=cut + + +sub DBConnect { + use RT; + RT::Init(); +} + + + +# {{{ sub debug + +sub debug { + my $val = shift; + my ($debug); + if ($val) { + $RT::Logger->debug($val."\n"); + if ($debug) { + print STDERR "$val\n"; + } + } + if ($debug) { + return(1); + } +} + +# }}} + + # {{{ sub CheckForLoops sub CheckForLoops { @@ -144,6 +207,82 @@ sub CheckForAutoGenerated { # }}} +# {{{ sub ParseMIMEEntityFromSTDIN + +sub ParseMIMEEntityFromSTDIN { + + # Create a new parser object: + + my $parser = new MIME::Parser; + + # {{{ Config $parser to store large attacments in temp dir + + ## TODO: Does it make sense storing to disk at all? After all, we + ## need to put each msg as an in-core scalar before saving it to + ## the database, don't we? + + ## At the same time, we should make sure that we nuke attachments + ## Over max size and return them + + ## TODO: Remove the temp dir when we don't need it any more. + + my $AttachmentDir = File::Temp::tempdir (TMPDIR => 1, CLEANUP => 1); + + # Set up output directory for files: + $parser->output_dir("$AttachmentDir"); + + #If someone includes a message, don't extract it + $parser->extract_nested_messages(0); + + + # Set up the prefix for files with auto-generated names: + $parser->output_prefix("part"); + + # If content length is <= 20000 bytes, store each msg as in-core scalar; + # Else, write to a disk file (the default action): + + $parser->output_to_core(20000); + + # }}} (temporary directory) + + #Ok. now that we're set up, let's get the stdin. + my $entity; + unless ($entity = $parser->read(\*STDIN)) { + die "couldn't parse MIME stream"; + } + #Now we've got a parsed mime object. + + # Get the head, a MIME::Head: + my $head = $entity->head; + + + # Unfold headers that are have embedded newlines + $head->unfold; + + # TODO - information about the charset is lost here! + $head->decode; + + return ($entity, $head); + +} +# }}} + +# {{{ sub ParseTicketId + +sub ParseTicketId { + my $Subject = shift; + my ($Id); + + if ($Subject =~ s/\[$RT::rtname \#(\d+)\]//i) { + $Id = $1; + $RT::Logger->debug("Found a ticket ID. It's $Id"); + return($Id); + } + else { + return(undef); + } +} +# }}} # {{{ sub MailError sub MailError { @@ -174,8 +313,8 @@ sub MailError { if ($mimeobj) { $mimeobj->sync_headers(); $entity->add_part($mimeobj); - } - + } + if ($RT::MailCommand eq 'sendmailpipe') { open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0); print MAIL $entity->as_string; @@ -188,66 +327,144 @@ sub MailError { # }}} -# {{{ Create User +# {{{ sub GetCurrentUser + +sub GetCurrentUser { + my $head = shift; + my $entity = shift; + my $ErrorsTo = shift; -sub CreateUser { - my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_; - my $NewUser = RT::User->new($RT::SystemUser); + my %UserInfo = (); - # This data is tainted by some Very Broken mailers. - # (Sometimes they send raw ISO 8859-1 data here. fear that. - require Encode; - $Username = Encode::encode(utf8 => $Username, Encode::FB_PERLQQ()) if defined $Username; - $Name = Encode::encode(utf8 => $Name, Encode::FB_PERLQQ()) if defined $Name; - - my ($Val, $Message) = - $NewUser->Create(Name => ($Username || $Address), - EmailAddress => $Address, - RealName => $Name, - Password => undef, - Privileged => 0, - Comments => 'Autocreated on ticket submission' - ); + #Suck the address of the sender out of the header + my ($Address, $Name) = ParseSenderAddressFromHead($head); - unless ($Val) { - - # Deal with the race condition of two account creations at once - # - if ($Username) { - $NewUser->LoadByName($Username); - } - - unless ($NewUser->Id) { - $NewUser->LoadByEmail($Address); - } - - unless ($NewUser->Id) { - MailError( To => $ErrorsTo, - Subject => "User could not be created", - Explanation => "User creation failed in mailgateway: $Message", - MIMEObj => $entity, - LogLevel => 'crit' - ); - } + #This will apply local address canonicalization rules + $Address = RT::CanonicalizeAddress($Address); + + #If desired, synchronize with an external database + + my $UserFoundInExternalDatabase = 0; + + # Username is the 'Name' attribute of the user that RT uses for things + # like authentication + my $Username = undef; + if ($RT::LookupSenderInExternalDatabase) { + ($UserFoundInExternalDatabase, %UserInfo) = + RT::LookupExternalUserInfo($Address, $Name); + + $Address = $UserInfo{'EmailAddress'}; + $Username = $UserInfo{'Name'}; } - - #Load the new user object + my $CurrentUser = RT::CurrentUser->new(); - $CurrentUser->LoadByEmail($Address); - - unless ($CurrentUser->id) { - $RT::Logger->warning("Couldn't load user '$Address'.". "giving up"); - MailError( To => $ErrorsTo, - Subject => "User could not be loaded", - Explanation => "User '$Address' could not be loaded in the mail gateway", - MIMEObj => $entity, - LogLevel => 'crit' - ); - } + + # First try looking up by a username, if we got one from the external + # db lookup. Next, try looking up by email address. Failing that, + # try looking up by users who have this user's email address as their + # username. + + if ($Username) { + $CurrentUser->LoadByName($Username); + } + + unless ($CurrentUser->Id) { + $CurrentUser->LoadByEmail($Address); + } - return $CurrentUser; + #If we can't get it by email address, try by name. + unless ($CurrentUser->Id) { + $CurrentUser->LoadByName($Address); + } + + + unless ($CurrentUser->Id) { + #If we couldn't load a user, determine whether to create a user + + # {{{ If we require an incoming address to be found in the external + # user database, reject the incoming message appropriately + if ( $RT::LookupSenderInExternalDatabase && + $RT::SenderMustExistInExternalDatabase && + !$UserFoundInExternalDatabase) { + + my $Message = "Sender's email address was not found in the user database."; + + # {{{ This code useful only if you've defined an AutoRejectRequest template + + require RT::Template; + my $template = new RT::Template($RT::Nobody); + $template->Load('AutoRejectRequest'); + $Message = $template->Content || $Message; + + # }}} + + MailError( To => $ErrorsTo, + Subject => "Ticket Creation failed: user could not be created", + Explanation => $Message, + MIMEObj => $entity, + LogLevel => 'notice' + ); + + return($CurrentUser); + + } + # }}} + + else { + my $NewUser = RT::User->new($RT::SystemUser); + + my ($Val, $Message) = + $NewUser->Create(Name => ($Username || $Address), + EmailAddress => $Address, + RealName => "$Name", + Password => undef, + Privileged => 0, + Comments => 'Autocreated on ticket submission' + ); + + unless ($Val) { + + # Deal with the race condition of two account creations at once + # + if ($Username) { + $NewUser->LoadByName($Username); + } + + unless ($NewUser->Id) { + $NewUser->LoadByEmail($Address); + } + + unless ($NewUser->Id) { + MailError( To => $ErrorsTo, + Subject => "User could not be created", + Explanation => "User creation failed in mailgateway: $Message", + MIMEObj => $entity, + LogLevel => 'crit' + ); + } + } + } + + #Load the new user object + $CurrentUser->LoadByEmail($Address); + + unless ($CurrentUser->id) { + $RT::Logger->warning("Couldn't load user '$Address'.". "giving up"); + MailError( To => $ErrorsTo, + Subject => "User could not be loaded", + Explanation => "User '$Address' could not be loaded in the mail gateway", + MIMEObj => $entity, + LogLevel => 'crit' + ); + + } + } + + return ($CurrentUser); + } -# }}} +# }}} + # {{{ ParseCcAddressesFromHead =head2 ParseCcAddressesFromHead HASHREF @@ -272,11 +489,11 @@ sub ParseCcAddressesFromHead { foreach my $AddrObj (@ToObjs, @CcObjs) { my $Address = $AddrObj->address; - $Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($Address); + $Address = RT::CanonicalizeAddress($Address); next if ($args{'CurrentUser'}->EmailAddress =~ /^$Address$/i); next if ($args{'QueueObj'}->CorrespondAddress =~ /^$Address$/i); next if ($args{'QueueObj'}->CommentAddress =~ /^$Address$/i); - next if (RT::EmailParser::IsRTAddress(undef, $Address)); + next if (RT::IsRTAddress($Address)); push (@Addresses, $Address); } @@ -351,7 +568,8 @@ sub ParseAddressFromHeader{ } my $Name = ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address); - + + #Lets take the from and load a user object. my $Address = $AddrObj->address; @@ -360,289 +578,4 @@ sub ParseAddressFromHeader{ # }}} - -=head2 Gateway - -This performs all the "guts" of the mail rt-mailgate program, and is -designed to be called from the web interface with a message, user -object, and so on. - -=cut - -sub Gateway { - my %args = ( message => undef, - queue => 1, - action => 'correspond', - ticket => undef, - @_ ); - - # Validate the action - unless ( $args{'action'} =~ /^(comment|correspond|action)$/ ) { - - # Can't safely loc this. What object do we loc around? - return ( 0, "Invalid 'action' parameter", undef ); - } - - my $parser = RT::EmailParser->new(); - $parser->ParseMIMEEntityFromScalar( $args{'message'} ); - - my $Message = $parser->Entity(); - my $head = $Message->head; - - my ( $CurrentUser, $AuthStat, $status, $error ); - - my $ErrorsTo = ParseErrorsToAddressFromHead($head); - - my $MessageId = $head->get('Message-Id') - || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>"; - - #Pull apart the subject line - my $Subject = $head->get('Subject') || ''; - chomp $Subject; - - - $args{'ticket'} ||= $parser->ParseTicketId($Subject); - - my $SystemTicket; - if ($args{'ticket'} ) { - $SystemTicket = RT::Ticket->new($RT::SystemUser); - $SystemTicket->Load($args{'ticket'}); - } - - #Set up a queue object - my $SystemQueueObj = RT::Queue->new($RT::SystemUser); - $SystemQueueObj->Load( $args{'queue'} ); - - - # We can safely have no queue of we have a known-good ticket - unless ( $args{'ticket'} || $SystemQueueObj->id ) { - MailError( - To => $RT::OwnerEmail, - Subject => "RT Bounce: $Subject", - Explanation => "RT couldn't find the queue: " . $args{'queue'}, - MIMEObj => $Message ); - return ( 0, "RT couldn't find the queue: " . $args{'queue'}, undef ); - } - - # Authentication Level - # -1 - Get out. this user has been explicitly declined - # 0 - User may not do anything (Not used at the moment) - # 1 - Normal user - # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate - - push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins; - # Since this needs loading, no matter what - - for (@RT::MailPlugins) { - my $Code; - my $NewAuthStat; - if ( ref($_) eq "CODE" ) { - $Code = $_; - } - else { - $_ = "RT::Interface::Email::$_" unless /^RT::Interface::Email::/; - eval "require $_;"; - if ($@) { - die ("Couldn't load module $_: $@"); - next; - } - no strict 'refs'; - if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) { - die ("No GetCurrentUser code found in $_ module"); - next; - } - } - - ( $CurrentUser, $NewAuthStat ) = $Code->( Message => $Message, - CurrentUser => $CurrentUser, - AuthLevel => $AuthStat, - Action => $args{'action'}, - Ticket => $SystemTicket, - Queue => $SystemQueueObj ); - - # You get the highest level of authentication you were assigned. - last if $AuthStat == -1; - $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat; - } - - # {{{ If authentication fails and no new user was created, get out. - if ( !$CurrentUser or !$CurrentUser->Id or $AuthStat == -1 ) { - - # If the plugins refused to create one, they lose. - MailError( - Subject => "Could not load a valid user", - Explanation => <<EOT, -RT could not load a valid user, and RT's configuration does not allow -for the creation of a new user for your email. - -Your RT administrator needs to grant 'Everyone' the right 'CreateTicket' -for this queue. - -EOT - MIMEObj => $Message, - LogLevel => 'error' ) - unless $AuthStat == -1; - return ( 0, "Could not load a valid user", undef ); - } - - # }}} - - # {{{ Lets check for mail loops of various sorts. - my $IsAutoGenerated = CheckForAutoGenerated($head); - - my $IsSuspiciousSender = CheckForSuspiciousSender($head); - - my $IsALoop = CheckForLoops($head); - - my $SquelchReplies = 0; - - #If the message is autogenerated, we need to know, so we can not - # send mail to the sender - if ( $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) { - $SquelchReplies = 1; - $ErrorsTo = $RT::OwnerEmail; - } - - # }}} - - # {{{ Drop it if it's disallowed - if ( $AuthStat == 0 ) { - MailError( - To => $ErrorsTo, - Subject => "Permission Denied", - Explanation => "You do not have permission to communicate with RT", - MIMEObj => $Message ); - } - - # }}} - # {{{ Warn someone if it's a loop - - # Warn someone if it's a loop, before we drop it on the ground - if ($IsALoop) { - $RT::Logger->crit("RT Recieved mail ($MessageId) from itself."); - - #Should we mail it to RTOwner? - if ($RT::LoopsToRTOwner) { - MailError( To => $RT::OwnerEmail, - Subject => "RT Bounce: $Subject", - Explanation => "RT thinks this message may be a bounce", - MIMEObj => $Message ); - - #Do we actually want to store it? - return ( 0, "Message Bounced", undef ) unless ($RT::StoreLoops); - } - } - - # }}} - - # {{{ Squelch replies if necessary - # Don't let the user stuff the RT-Squelch-Replies-To header. - if ( $head->get('RT-Squelch-Replies-To') ) { - $head->add( 'RT-Relocated-Squelch-Replies-To', - $head->get('RT-Squelch-Replies-To') ); - $head->delete('RT-Squelch-Replies-To'); - } - - if ($SquelchReplies) { - ## TODO: This is a hack. It should be some other way to - ## indicate that the transaction should be "silent". - - my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); - $head->add( 'RT-Squelch-Replies-To', $Sender ); - } - - # }}} - - my $Ticket = RT::Ticket->new($CurrentUser); - - # {{{ If we don't have a ticket Id, we're creating a new ticket - if ( !$args{'ticket'} ) { - - # {{{ Create a new ticket - - my @Cc; - my @Requestors = ( $CurrentUser->id ); - - if ($RT::ParseNewMessageForTicketCcs) { - @Cc = ParseCcAddressesFromHead( Head => $head, - CurrentUser => $CurrentUser, - QueueObj => $SystemQueueObj ); - } - - my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( - Queue => $SystemQueueObj->Id, - Subject => $Subject, - Requestor => \@Requestors, - Cc => \@Cc, - MIMEObj => $Message ); - if ( $id == 0 ) { - MailError( To => $ErrorsTo, - Subject => "Ticket creation failed", - Explanation => $ErrStr, - MIMEObj => $Message ); - $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr "); - return ( 0, "Ticket creation failed", $Ticket ); - } - - # }}} - } - - # }}} - - # If the action is comment, add a comment. - elsif ( $args{'action'} =~ /^(comment|correspond)$/i ) { - $Ticket->Load($args{'ticket'}); - unless ( $Ticket->Id ) { - my $message = "Could not find a ticket with id ".$args{'ticket'}; - MailError( To => $ErrorsTo, - Subject => "Message not recorded", - Explanation => $message, - MIMEObj => $Message ); - - return ( 0, $message); - } - - my ( $status, $msg ); - if ( $args{'action'} =~ /^correspond$/ ) { - ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message ); - } - else { - ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message ); - } - unless ($status) { - - #Warn the sender that we couldn't actually submit the comment. - MailError( To => $ErrorsTo, - Subject => "Message not recorded", - Explanation => $msg, - MIMEObj => $Message ); - return ( 0, "Message not recorded", $Ticket ); - } - } - - else { - - #Return mail to the sender with an error - MailError( To => $ErrorsTo, - Subject => "RT Configuration error", - Explanation => "'" - . $args{'action'} - . "' not a recognized action." - . " Your RT administrator has misconfigured " - . "the mail aliases which invoke RT", - MIMEObj => $Message ); - $RT::Logger->crit( $args{'action'} . " type unknown for $MessageId" ); - return ( 0, "Configuration error: " . $args{'action'} . " not a recognized action", $Ticket ); - - } - - -return ( 1, "Success", $Ticket ); -} - -eval "require RT::Interface::Email_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm}); -eval "require RT::Interface::Email_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm}); - 1; diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 5097f54a4..6b5272848 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -1,214 +1,129 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +## $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 - -=head1 NAME - -RT::Interface::Web - -=begin testing - -use_ok(RT::Interface::Web); - -=end testing - -=cut - - package RT::Interface::Web; -use strict; +# {{{ sub NewParser +=head2 NewParser - - -# {{{ sub NewApacheHandler - -=head2 NewApacheHandler - - Takes extra options to pass to HTML::Mason::ApacheHandler->new - Returns a new Mason::ApacheHandler object + 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 NewApacheHandler { - require HTML::Mason::ApacheHandler; - my $ah = new HTML::Mason::ApacheHandler( - - comp_root => [ - [ local => $RT::MasonLocalComponentRoot ], - [ standard => $RT::MasonComponentRoot ] - ], - args_method => "CGI", - default_escape_flags => 'h', - allow_globals => [qw(%session)], - data_dir => "$RT::MasonDataDir", +sub NewParser { + my %args = ( + allow_globals => undef, @_ ); - $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); - - return ($ah); + my $parser = new HTML::Mason::Parser( + default_escape_flags => 'h', + allow_globals => $args{'allow_globals'} + ); + return ($parser); } # }}} -# {{{ sub NewCGIHandler +# {{{ sub NewInterp -=head2 NewCGIHandler +=head2 NewInterp - Returns a new Mason::CGIHandler object + 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 NewCGIHandler { - my %args = ( - @_ - ); - - my $handler = HTML::Mason::CGIHandler->new( +sub NewInterp { + my %params = ( comp_root => [ [ local => $RT::MasonLocalComponentRoot ], [ standard => $RT::MasonComponentRoot ] ], data_dir => "$RT::MasonDataDir", - default_escape_flags => 'h', - allow_globals => [qw(%session)] + @_ ); - - - $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); + #We allow recursive autohandlers to allow for RT auth. - return ($handler); + use HTML::Mason::Interp; + my $interp = new HTML::Mason::Interp(%params); } -# }}} +# }}} -# {{{ EscapeUTF8 +# {{{ sub NewApacheHandler -=head2 EscapeUTF8 SCALARREF +=head2 NewApacheHandler -does a css-busting but minimalist escaping of whatever html you're passing in. + Takes a Mason::Interp object + Returns a new Mason::ApacheHandler object =cut -sub EscapeUTF8 { - my $ref = shift; - my $val = $$ref; - use bytes; - $val =~ s/&/&/g; - $val =~ s/</</g; - $val =~ s/>/>/g; - $val =~ s/\(/(/g; - $val =~ s/\)/)/g; - $val =~ s/"/"/g; - $val =~ s/'/'/g; - $$ref = $val; - Encode::_utf8_on($$ref); - +sub NewApacheHandler { + my $interp = shift; + my $ah = new HTML::Mason::ApacheHandler( interp => $interp ); + return ($ah); } # }}} -package HTML::Mason::Commands; -use strict; -use vars qw/$r $m %session/; - - -# {{{ loc +# {{{ sub NewMason11ApacheHandler -=head2 loc ARRAY +=head2 NewMason11ApacheHandler -loc is a nice clean global routine which calls $session{'CurrentUser'}->loc() -with whatever it's called with. If there is no $session{'CurrentUser'}, -it creates a temporary user, so we have something to get a localisation handle -through + Returns a new Mason::ApacheHandler object =cut -sub loc { - - if ($session{'CurrentUser'} && - UNIVERSAL::can($session{'CurrentUser'}, 'loc')){ - return($session{'CurrentUser'}->loc(@_)); - } - else { - my $u = RT::CurrentUser->new($RT::SystemUser); - return ($u->loc(@_)); - } +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); } # }}} -# {{{ loc_fuzzy - -=head2 loc_fuzzy STRING -loc_fuzzy is for handling localizations of messages that may already -contain interpolated variables, typically returned from libraries -outside RT's control. It takes the message string and extracts the -variable array automatically by matching against the candidate entries -inside the lexicon file. - -=cut -sub loc_fuzzy { - my $msg = shift; - - if ($session{'CurrentUser'} && - UNIVERSAL::can($session{'CurrentUser'}, 'loc')){ - return($session{'CurrentUser'}->loc_fuzzy($msg)); - } - else { - my $u = RT::CurrentUser->new($RT::SystemUser); - return ($u->loc_fuzzy($msg)); - } -} # }}} +package HTML::Mason::Commands; # {{{ sub Abort # Error - calls Error and aborts sub Abort { - if ($session{'ErrorDocument'} && - $session{'ErrorDocumentType'}) { - $r->content_type($session{'ErrorDocumentType'}); - $m->comp($session{'ErrorDocument'} , Why => shift); + if ( $session{'ErrorDocument'} && $session{'ErrorDocumentType'} ) { + SetContentType( $session{'ErrorDocumentType'} ); + $m->comp( $session{'ErrorDocument'}, Why => shift ); $m->abort; - } - else { - $m->comp("/Elements/Error" , Why => shift); + } + else { + SetContentType('text/html'); + $m->comp( "/Elements/Error", Why => shift ); $m->abort; } } @@ -220,7 +135,6 @@ sub Abort { =head2 CreateTicket ARGS Create a new ticket, using Mason's %ARGS. returns @results. - =cut sub CreateTicket { @@ -244,45 +158,38 @@ sub CreateTicket { my $starts = new RT::Date( $session{'CurrentUser'} ); $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} ); - my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} ); - my @Cc = split ( /\s*,\s*/, $ARGS{'Cc'} ); - my @AdminCc = split ( /\s*,\s*/, $ARGS{'AdminCc'} ); + 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' ); - if ($ARGS{'Attachments'}) { - $MIMEObj->make_multipart; - $MIMEObj->add_part($_) foreach values %{$ARGS{'Attachments'}}; - } - my %create_args = ( - Queue => $ARGS{'Queue'}, - Owner => $ARGS{'Owner'}, - InitialPriority => $ARGS{'InitialPriority'}, - FinalPriority => $ARGS{'FinalPriority'}, - TimeLeft => $ARGS{'TimeLeft'}, - TimeEstimated => $ARGS{'TimeEstimated'}, - TimeWorked => $ARGS{'TimeWorked'}, + 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'}, + Subject => $ARGS{Subject}, + Status => $ARGS{Status}, Due => $due->ISO, Starts => $starts->ISO, MIMEObj => $MIMEObj ); - foreach my $arg (%ARGS) { - if ($arg =~ /^CustomField-(\d+)(.*?)$/) { - next if ($arg =~ /-Magic$/); - $create_args{"CustomField-".$1} = $ARGS{"$arg"}; - } - } + + # 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); @@ -309,7 +216,7 @@ sub CreateTicket { } } - push ( @Actions, split("\n", $ErrMsg) ); + push ( @Actions, $ErrMsg ); unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) { Abort( "No permission to view newly created ticket #" . $Ticket->id . "." ); @@ -376,38 +283,80 @@ sub ProcessUpdateMessage { my $Message = MakeMIMEEntity( Subject => $args{ARGSRef}->{'UpdateSubject'}, Body => $args{ARGSRef}->{'UpdateContent'}, + AttachmentFieldName => 'UpdateAttachment' ); - if ($args{ARGSRef}->{'UpdateAttachments'}) { - $Message->make_multipart; - $Message->add_part($_) foreach values %{$args{ARGSRef}->{'UpdateAttachments'}}; - } - - ## TODO: Implement public comments - if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) { - 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 ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) { - my ( $Transaction, $Description ) = $args{TicketObj}->Correspond( - CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, - BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, - MIMEObj => $Message, - TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'} - ); - push ( @{ $args{Actions} }, $Description ); - } + ## 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'} }, - loc("Update type was neither correspondence nor comment."). - " ". - loc("Update not recorded.") - ); + "Update type was neither correspondence nor comment. Update not recorded" + ); } } } @@ -433,66 +382,61 @@ sub MakeMIMEEntity { Cc => undef, Body => undef, AttachmentFieldName => undef, - map Encode::encode_utf8($_), @_, + @_ ); #Make the update content have no 'weird' newlines in it $args{'Body'} =~ s/\r\n/\n/gs; - my $Message; - { - # MIME::Head is not happy in utf-8 domain. This only happens - # when processing an incoming email (so far observed). - no utf8; - use bytes; - $Message = MIME::Entity->build( - Subject => $args{'Subject'} || "", - From => $args{'From'}, - Cc => $args{'Cc'}, - Data => [ $args{'Body'} ] - ); - } - - my $cgi_object = $m->cgi_object; + my $Message = MIME::Entity->build( + Subject => $args{'Subject'} || "", + From => $args{'From'}, + Cc => $args{'Cc'}, + Data => [ $args{'Body'} ] + ); - if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) { + my $cgi_object = CGIObject(); + if ( $cgi_object->param( $args{'AttachmentFieldName'} ) ) { + my $cgi_filehandle = + $cgi_object->upload( $args{'AttachmentFieldName'} ); + use File::Temp qw(tempfile tempdir); - use File::Temp qw(tempfile tempdir); + #foreach my $filehandle (@filenames) { - #foreach my $filehandle (@filenames) { + # my ( $fh, $temp_file ) = tempfile(); - my ( $fh, $temp_file ) = tempfile(); + #$binmode $fh; #thank you, windows - binmode $fh; #thank you, windows - my ($buffer); - while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) { - print $fh $buffer; - } + # We're having trouble with tempfiles not getting created. Let's try it with + # a scalar instead - my $uploadinfo = $cgi_object->uploadInfo($filehandle); + my ( $buffer, @file ); - # Prefer the cached name first over CGI.pm stringification. - my $filename = $RT::Mason::CGI::Filename; - $filename = "$filehandle" unless defined($filename); - - $filename =~ s#^.*[\\/]##; + while ( my $bytesread = read( $cgi_filehandle, $buffer, 4096 ) ) { + push ( @file, $buffer ); + } - $Message->attach( - Path => $temp_file, - Filename => $filename, - Type => $uploadinfo->{'Content-Type'}, - ); - close($fh); + $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(); - RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8 - return ($Message); } @@ -541,9 +485,6 @@ sub ProcessSearchQuery { elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) { $session{'tickets'}->PrevPage; } - elsif ( $args{ARGS}->{'GotoPage'} > 0 ) { - $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 ); - } # }}} @@ -635,12 +576,8 @@ sub ProcessSearchQuery { # }}} # {{{ Limit Subject if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) { - my $val = $args{ARGS}->{'ValueOfSubject'}; - if ($args{ARGS}->{'SubjectOp'} =~ /like/) { - $val = "%".$val."%"; - } $session{'tickets'}->LimitSubject( - VALUE => $val, + VALUE => $args{ARGS}->{'ValueOfSubject'}, OPERATOR => $args{ARGS}->{'SubjectOp'}, ); } @@ -648,59 +585,40 @@ sub ProcessSearchQuery { # }}} # {{{ Limit Dates if ( $args{ARGS}->{'ValueOfDate'} ne '' ) { + my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} ); $args{ARGS}->{'DateType'} =~ s/_Date$//; - if ( $args{ARGS}->{'DateType'} eq 'Updated' ) { - $session{'tickets'}->LimitTransactionDate( - VALUE => $date, - OPERATOR => $args{ARGS}->{'DateOp'}, - ); - } - else { - $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'}, - VALUE => $date, - OPERATOR => $args{ARGS}->{'DateOp'}, - ); - } + $session{'tickets'}->LimitDate( + FIELD => $args{ARGS}->{'DateType'}, + VALUE => $date, + OPERATOR => $args{ARGS}->{'DateOp'}, + ); } # }}} # {{{ Limit Content - if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) { - my $val = $args{ARGS}->{'ValueOfAttachmentField'}; - if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) { - $val = "%".$val."%"; - } - $session{'tickets'}->Limit( - FIELD => $args{ARGS}->{'AttachmentField'}, - VALUE => $val, - OPERATOR => $args{ARGS}->{'AttachmentFieldOp'}, + if ( $args{ARGS}->{'ValueOfContent'} ne '' ) { + $session{'tickets'}->LimitContent( + VALUE => $args{ARGS}->{'ValueOfContent'}, + OPERATOR => $args{ARGS}->{'ContentOp'}, ); } # }}} + # {{{ Limit KeywordSelects - # {{{ Limit CustomFields - - foreach my $arg ( keys %{ $args{ARGS} } ) { - my $id; - if ( $arg =~ /^CustomField(\d+)$/ ) { - $id = $1; - } - else { - next; - } - next unless ( $args{ARGS}->{$arg} ); - - my $form = $args{ARGS}->{$arg}; - my $oper = $args{ARGS}->{ "CustomFieldOp" . $id }; - foreach my $value ( ref($form) ? @{$form} : ($form) ) { + 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 ($oper =~ /like/i) { - $value = "%".$value."%"; - } - if ( $value =~ /^null$/i ) { + if ( $KeywordId =~ /^null$/i ) { #Don't quote the string 'null' $quote = 0; @@ -709,16 +627,17 @@ sub ProcessSearchQuery { $oper = 'IS' if ( $oper eq '=' ); $oper = 'IS NOT' if ( $oper eq '!=' ); } - $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id, - OPERATOR => $oper, - QUOTEVALUE => $quote, - VALUE => $value ); + $session{'tickets'}->LimitKeyword( + KEYWORDSELECT => $KeywordSelectId, + OPERATOR => $oper, + QUOTEVALUE => $quote, + KEYWORD => $KeywordId + ); } } # }}} - } # }}} @@ -735,7 +654,7 @@ Returns an ISO date and time in GMT sub ParseDateToISO { my $date = shift; - my $date_obj = RT::Date->new($session{'CurrentUser'}); + my $date_obj = new RT::Date($CurrentUser); $date_obj->Set( Format => 'unknown', Value => $date @@ -761,83 +680,173 @@ sub Config { # {{{ 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); - foreach my $arg (keys %ARGS) { - if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) { - my $principal_id = $1; - my $object_type = $2; - my $object_id = $3; - my $rights = $ARGS{$arg}; + next unless ($ACL); - my $principal = RT::Principal->new($session{'CurrentUser'}); - $principal->Load($principal_id); + # Parse out what we're really talking about. + if ( $ACL =~ /^(.*?)-(\d+)-(.*?)-(\d+)/ ) { + my $PrincipalType = $1; + my $PrincipalId = $2; + my $Scope = $3; + my $AppliesTo = $4; - my $obj; + # {{{ Create an object called Principal + # so we can do rights operations - if ($object_type eq 'RT::Queue') { - $obj = RT::Queue->new($session{'CurrentUser'}); - $obj->Load($object_id); - } elsif ($object_type eq 'RT::Group') { - $obj = RT::Group->new($session{'CurrentUser'}); - $obj->Load($object_id); + 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"); + } - } elsif ($object_type eq 'RT::System') { - $obj = $RT::System; - } else { - push (@results, loc("System Error"). - loc("Rights could not be granted for [_1]", $object_type)); - next; + $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. - my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg}); foreach my $right (@rights) { next unless ($right); - my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right); - push (@results, $msg); - } - } - elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) { - my $principal_id = $1; - my $object_type = $2; - my $object_id = $3; - my $right = $4; - - my $principal = RT::Principal->new($session{'CurrentUser'}); - $principal->Load($principal_id); - next unless ($right); - my $obj; - - if ($object_type eq 'RT::Queue') { - $obj = RT::Queue->new($session{'CurrentUser'}); - $obj->Load($object_id); - } elsif ($object_type eq 'RT::Group') { - $obj = RT::Group->new($session{'CurrentUser'}); - $obj->Load($object_id); - - } elsif ($object_type eq 'RT::System') { - $obj = $RT::System; - } else { - push (@results, loc("System Error"). - loc("Rights could not be revoked for [_1]", $object_type)); - next; + + #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 ); + } + } + } } - my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right); - push (@results, $msg); + + # }}} } + } + # }}} Add rights - } + # {{{ remove any rights that have been deleted - return (@results); + 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 @@ -855,7 +864,6 @@ sub UpdateRecordObject { ARGSRef => undef, AttributesRef => undef, Object => undef, - AttributePrefix => undef, @_ ); @@ -864,94 +872,17 @@ sub UpdateRecordObject { my $object = $args{'Object'}; my $attributes = $args{'AttributesRef'}; my $ARGSRef = $args{'ARGSRef'}; - foreach my $attribute (@$attributes) { - my $value; - if ( defined $ARGSRef->{$attribute} ) { - $value = $ARGSRef->{$attribute}; - } - elsif ( - defined( $args{'AttributePrefix'} ) - && defined( - $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute } - ) - ) { - $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }; - - } else { - next; - } - - $value =~ s/\r\n/\n/gs; - - if ($value ne $object->$attribute()){ - - my $method = "Set$attribute"; - my ( $code, $msg ) = $object->$method($value); - - push @results, loc($attribute) . ': ' . loc_fuzzy($msg); -=for loc - "[_1] could not be set to [_2].", # loc - "That is already the current value", # loc - "No value sent to _Set!\n", # loc - "Illegal value for [_1]", # loc - "The new value has been set.", # loc - "No column specified", # loc - "Immutable field", # loc - "Nonexistant field?", # loc - "Invalid data", # loc - "Couldn't find row", # loc - "Missing a primary key?: [_1]", # loc - "Found Object", # loc -=cut - }; - } - return (@results); -} - -# }}} - -# {{{ Sub ProcessCustomFieldUpdates - -sub ProcessCustomFieldUpdates { - my %args = ( - CustomFieldObj => undef, - ARGSRef => undef, - @_ - ); - - my $Object = $args{'CustomFieldObj'}; - my $ARGSRef = $args{'ARGSRef'}; - my @attribs = qw( Name Type Description Queue SortOrder); - my @results = UpdateRecordObject( - AttributesRef => \@attribs, - Object => $Object, - ARGSRef => $ARGSRef - ); + foreach $attribute (@$attributes) { + if ( ( defined $ARGSRef->{"$attribute"} ) + and ( $ARGSRef->{"$attribute"} ne $object->$attribute() ) ) + { + $ARGSRef->{"$attribute"} =~ s/\r\n/\n/gs; - if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) { - - my ( $addval, $addmsg ) = $Object->AddValue( - Name => - $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" }, - Description => $ARGSRef->{ "CustomField-" - . $Object->Id - . "-AddValue-Description" }, - SortOrder => $ARGSRef->{ "CustomField-" - . $Object->Id - . "-AddValue-SortOrder" }, - ); - push ( @results, $addmsg ); - } - my @delete_values = ( - ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq - 'ARRAY' ) - ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } } - : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } ); - foreach my $id (@delete_values) { - next unless defined $id; - my ( $err, $msg ) = $Object->DeleteValue($id); - push ( @results, $msg ); + my $method = "Set$attribute"; + my ( $code, $msg ) = $object->$method( $ARGSRef->{"$attribute"} ); + push @results, "$attribute: $msg"; + } } return (@results); } @@ -982,7 +913,6 @@ sub ProcessTicketBasics { Subject FinalPriority Priority - TimeEstimated TimeWorked TimeLeft Status @@ -1004,7 +934,7 @@ sub ProcessTicketBasics { ); # We special case owner changing, so we can use ForceOwnerChange - if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) { + if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner ne $ARGSRef->{'Owner'} ) ) { my ($ChownType); if ( $ARGSRef->{'ForceOwnerChange'} ) { $ChownType = "Force"; @@ -1015,7 +945,7 @@ sub ProcessTicketBasics { my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType ); - push ( @results, $msg ); + push ( @results, "$msg" ); } # }}} @@ -1025,142 +955,6 @@ sub ProcessTicketBasics { # }}} -# {{{ Sub ProcessTicketCustomFieldUpdates - -sub ProcessTicketCustomFieldUpdates { - my %args = ( - ARGSRef => undef, - @_ - ); - - my @results; - - my $ARGSRef = $args{'ARGSRef'}; - - # Build up a list of tickets that we want to work with - my %tickets_to_mod; - my %custom_fields_to_mod; - foreach my $arg ( keys %{$ARGSRef} ) { - if ( $arg =~ /^Ticket-(\d+)-CustomField-(\d+)-/ ) { - - # For each of those tickets, find out what custom fields we want to work with. - $custom_fields_to_mod{$1}{$2} = 1; - } - } - - # For each of those tickets - foreach my $tick ( keys %custom_fields_to_mod ) { - my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); - $Ticket->Load($tick); - - # For each custom field - foreach my $cf ( keys %{ $custom_fields_to_mod{$tick} } ) { - - my $CustomFieldObj = RT::CustomField->new($session{'CurrentUser'}); - $CustomFieldObj->LoadById($cf); - - foreach my $arg ( keys %{$ARGSRef} ) { - # since http won't pass in a form element with a null value, we need - # to fake it - if ($arg =~ /^(.*?)-Values-Magic$/ ) { - # We don't care about the magic, if there's really a values element; - next if (exists $ARGSRef->{$1.'-Values'}) ; - - $arg = $1."-Values"; - $ARGSRef->{$1."-Values"} = undef; - - } - next unless ( $arg =~ /^Ticket-$tick-CustomField-$cf-/ ); - my @values = - ( ref( $ARGSRef->{$arg} ) eq 'ARRAY' ) - ? @{ $ARGSRef->{$arg} } - : ( $ARGSRef->{$arg} ); - if ( ( $arg =~ /-AddValue$/ ) || ( $arg =~ /-Value$/ ) ) { - foreach my $value (@values) { - next unless ($value); - my ( $val, $msg ) = $Ticket->AddCustomFieldValue( - Field => $cf, - Value => $value - ); - push ( @results, $msg ); - } - } - elsif ( $arg =~ /-DeleteValues$/ ) { - foreach my $value (@values) { - next unless ($value); - my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue( - Field => $cf, - Value => $value - ); - push ( @results, $msg ); - } - } - elsif ( $arg =~ /-Values$/ and $CustomFieldObj->Type !~ /Entry/) { - my $cf_values = $Ticket->CustomFieldValues($cf); - - my %values_hash; - foreach my $value (@values) { - next unless ($value); - - # build up a hash of values that the new set has - $values_hash{$value} = 1; - - unless ( $cf_values->HasEntry($value) ) { - my ( $val, $msg ) = $Ticket->AddCustomFieldValue( - Field => $cf, - Value => $value - ); - push ( @results, $msg ); - } - - } - while ( my $cf_value = $cf_values->Next ) { - unless ( $values_hash{ $cf_value->Content } == 1 ) { - my ( $val, $msg ) = $Ticket->DeleteCustomFieldValue( - Field => $cf, - Value => $cf_value->Content - ); - push ( @results, $msg); - - } - - } - } - elsif ( $arg =~ /-Values$/ ) { - my $cf_values = $Ticket->CustomFieldValues($cf); - - # keep everything up to the point of difference, delete the rest - my $delete_flag; - foreach my $old_cf (@{$cf_values->ItemsArrayRef}) { - if (!$delete_flag and @values and $old_cf->Content eq $values[0]) { - shift @values; - next; - } - - $delete_flag ||= 1; - $old_cf->Delete; - } - - # now add/replace extra things, if any - foreach my $value (@values) { - my ( $val, $msg ) = $Ticket->AddCustomFieldValue( - Field => $cf, - Value => $value - ); - push ( @results, $msg ); - } - } - else { - push ( @results, "User asked for an unknown update type for custom field " . $cf->Name . " for ticket " . $Ticket->id ); - } - } - } - return (@results); - } -} - -# }}} - # {{{ sub ProcessTicketWatchers =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS ); @@ -1184,22 +978,18 @@ sub ProcessTicketWatchers { foreach my $key ( keys %$ARGSRef ) { - # {{{ Delete deletable watchers - if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ ) ) { - my ( $code, $msg ) = - $Ticket->DeleteWatcher(PrincipalId => $2, - Type => $1); + # 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( Type => $ARGSRef->{$key}, PrincipalId => $1 ); + 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*)$/ ) ) @@ -1224,11 +1014,12 @@ sub ProcessTicketWatchers { # Add new watchers by owner elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ ) - and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) { + and ( $key =~ /^WatcherTypeUser(\d*)$/ ) ) + { #They're in this order because otherwise $1 gets clobbered :/ my ( $code, $msg ) = - $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 ); + $Ticket->AddWatcher( Type => $ARGSRef->{$key}, Owner => $1 ); push @results, $msg; } } @@ -1270,7 +1061,7 @@ sub ProcessTicketDates { ); #Run through each field in this list. update the value if apropriate - foreach my $field (@date_fields) { + foreach $field (@date_fields) { my ( $code, $msg ); my $DateObj = RT::Date->new( $session{'CurrentUser'} ); @@ -1307,9 +1098,11 @@ Returns an array of results messages. =cut sub ProcessTicketLinks { - my %args = ( TicketObj => undef, - ARGSRef => undef, - @_ ); + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); my $Ticket = $args{'TicketObj'}; my $ARGSRef = $args{'ARGSRef'}; @@ -1325,9 +1118,11 @@ sub ProcessTicketLinks { push @results, "Trying to delete: Base: $base Target: $target Type $type"; - my ( $val, $msg ) = $Ticket->DeleteLink( Base => $base, - Type => $type, - Target => $target ); + my ( $val, $msg ) = $Ticket->DeleteLink( + Base => $base, + Type => $type, + Target => $target + ); push @results, $msg; @@ -1338,23 +1133,26 @@ sub ProcessTicketLinks { my @linktypes = qw( DependsOn MemberOf RefersTo ); foreach my $linktype (@linktypes) { - if ( $ARGSRef->{ $Ticket->Id . "-$linktype" } ) { - 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->{ $Ticket->Id . "-$linktype" } ) ) + { + $luri =~ s/\s*$//; # Strip trailing whitespace + my ( $val, $msg ) = $Ticket->AddLink( + Target => $luri, + Type => $linktype + ); + push @results, $msg; } - if ( $ARGSRef->{ "$linktype-" . $Ticket->Id } ) { - for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) { - my ( $val, $msg ) = $Ticket->AddLink( Base => $luri, - Type => $linktype ); + for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) + { + my ( $val, $msg ) = $Ticket->AddLink( + Base => $luri, + Type => $linktype + ); - push @results, $msg; - } - } + push @results, $msg; + } } #Merge if we need to @@ -1369,9 +1167,121 @@ sub ProcessTicketLinks { # }}} -eval "require RT::Interface::Web_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm}); -eval "require RT::Interface::Web_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm}); +# {{{ 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; diff --git a/rt/lib/RT/Keyword.pm b/rt/lib/RT/Keyword.pm new file mode 100644 index 000000000..a41e0a585 --- /dev/null +++ b/rt/lib/RT/Keyword.pm @@ -0,0 +1,446 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Keyword.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Keyword - Manipulate an RT::Keyword record + +=head1 SYNOPSIS + + use RT::Keyword; + + my $keyword = RT::Keyword->new($CurrentUser); + $keyword->Create( Name => 'tofu', + Description => 'fermented soy beans', + ); + + + my $keyword2 = RT::Keyword->new($CurrentUser); + $keyword2->Create( Name => 'beast', + Description => 'a wild animal', + Parent => $keyword->id(), + ); + +=head1 DESCRIPTION + +An B<RT::Keyword> object is an arbitrary string. + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Scrip); + +=end testing + + +=cut +package RT::Keyword; + +use strict; +use vars qw(@ISA); +use Tie::IxHash; +use RT::Record; +use RT::Keywords; + +@ISA = qw(RT::Record); + +# {{{ Core methods + +sub _Init { + my $self = shift; + $self->{'table'} = "Keywords"; + $self->SUPER::_Init(@_); +} + +sub _Accessible { + my $self = shift; + my %cols = ( + Name => 'read/write', #the keyword itself + Description => 'read/write', #a description of the keyword + Parent => 'read/write', #optional id of another B<RT::Keyword>, allowing keywords to be arranged hierarchically + Disabled => 'read/write' + ); + return ($self->SUPER::_Accessible( @_, %cols)); + +} + +# }}} + + +=over 4 + +=item new CURRENT_USER + +Takes a single argument, an RT::CurrentUser object. Instantiates a new +(uncreated) RT::Keyword object. + +=cut + +# {{{ sub Create + +=item Create KEY => VALUE, ... + +Takes a list of key/value pairs and creates a the object. Returns the id of +the newly created record, or false if there was an error. + +Keys are: + +Name - the keyword itself +Description - (not yet used) +Parent - optional link to another B<RT::Keyword>, allowing keyword to be arranged in a hierarchical fashion. Can be specified by id or Name. + +=cut + +sub Create { + my $self = shift; + my %args = (Name => undef, + Description => undef, + Parent => 0, + @_); + + unless ($self->CurrentUserHasRight('AdminKeywords')) { + return (0, 'Permission Denied'); + } + + if ( $args{'Parent'} && $args{'Parent'} !~ /^\d+$/ ) { + $RT::Logger->err( "can't yet specify parents by name, sorry: ". $args{'Parent'}); + return(0,'Parent must be specified by id'); + } + + my $val = $self->SUPER::Create(Name => $args{'Name'}, + Description => $args{'Description'}, + Parent => $args{'Parent'} + ); + if ($val) { + return ($val, 'Keyword created'); + } + else { + return(0,'Could not create keyword'); + } +} + +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + + return (0, 'Deleting this object would break referential integrity.'); +} + +# }}} + +# {{{ sub LoadByPath + +=head2 LoadByPath STRING + +LoadByPath takes a string. Whatever character starts the string is assumed to be a delimter. The routine parses the keyword path description and tries to load the keyword +described by that path. It returns a numerical status and a textual message. +A non-zero status means 'Success'. + +=cut + +sub LoadByPath { + my $self = shift; + + my $path = shift; + + my $delimiter = substr($path,0,1); + my @path_elements = split($delimiter, $path); + + #throw awya the first bogus path element + shift @path_elements; + + my $parent = 0; + my ($tempkey); + #iterate through all the path elements loading up a + #keyword object. when we're done, this object becomes + #whatever the last tempkey object was. + while (my $name = shift @path_elements) { + + $tempkey = new RT::Keyword($self->CurrentUser); + + my $loaded = $tempkey->LoadByNameAndParentId($name, $parent); + + #Set the new parent for loading its child. + $parent = $tempkey->Id; + + #If the parent Id is 0, then we're not recursing through the tree + # time to bail + return (0, "Couldn't find keyword") unless ($tempkey->id()); + + } + #Now that we're through with the loop, the last keyword loaded + # is the the one we wanted. + # we shouldn't need to explicitly load it like this. but we do. Thanks SQL + + $self->Load($tempkey->Id); + + return (1, 'Keyword loaded'); +} + + +# }}} + +# {{{ sub LoadByNameAndParentId + +=head2 LoadByNameAndParentId NAME PARENT_ID + +Takes two arguments, a keyword name and a parent id. Loads a keyword into + the current object. + +=cut + +sub LoadByNameAndParentId { + my $self = shift; + my $name = shift; + my $parentid = shift; + + my $val = $self->LoadByCols( Name => $name, Parent => $parentid); + if ($self->Id) { + return ($self->Id, 'Keyword loaded'); + } + else { + return (0, 'Keyword could not be found'); + } + } + +# }}} + + +# {{{ sub Load + +=head2 Load KEYWORD + +Loads KEYWORD, either by id if it's an integer or by Path, otherwise + +=cut + +sub Load { + my $self = shift; + my $id = shift; + + if (!$id) { + return (0, 'No keyword defined'); + } + if ($id =~ /^(\d+)$/) { + return ($self->SUPER::Load($id)); + } + else { + return($self->LoadByPath($id)); + } +} + + +# }}} + +# {{{ sub Path + +=item Path + + Returns this Keyword's full path going back to the root. (eg /OS/Unix/Linux/Redhat if +this keyword is "Redhat" ) + +=cut + +sub Path { + my $self = shift; + + if ($self->Parent == 0) { + return ("/".$self->Name); + } + else { + return ( $self->ParentObj->Path . "/" . $self->Name); + } + +} + +# }}} + +# {{{ sub RelativePath + +=head2 RelativePath KEYWORD_OBJ + +Takes a keyword object. Returns this keyword's path relative to that +keyword. + +=item Bugs + +Currently assumes that the "other" keyword is a predecessor of this keyword + +=cut + +sub RelativePath { + my $self = shift; + my $OtherKey = shift; + + my $OtherPath = $OtherKey->Path(); + my $MyPath = $self->Path; + $MyPath =~ s/^$OtherPath\///g; + return ($MyPath); +} + + +# }}} + +# {{{ sub ParentObj + +=item ParentObj + + Returns an RT::Keyword object of this Keyword's 'parents' + +=cut + +sub ParentObj { + my $self = shift; + + my $ParentObj = new RT::Keyword($self->CurrentUser); + $ParentObj->Load($self->Parent); + return ($ParentObj); +} + +# }}} + +# {{{ sub Children + +=item Children + +Return an RT::Keywords object this Object's children. + +=cut + +sub Children { + my $self = shift; + + my $Children = new RT::Keywords($self->CurrentUser); + $Children->LimitToParent($self->id); + return ($Children); +} + +# }}} + +# {{{ sub Descendents + +=item Descendents [ NUM_GENERATIONS [ EXCLUDE_HASHREF ] ] + +Returns an ordered (see L<Tie::IxHash>) hash reference of the descendents of +this keyword, possibly limited to a given number of generations. The keys +are B<RT::Keyword> I<id>s, and the values are strings containing the I<Name>s +of those B<RT::Keyword>s. + +=cut + +sub Descendents { + my $self = shift; + my $generations = shift || 0; + my $exclude = shift || {}; + my %results; + + + tie %results, 'Tie::IxHash'; + my $Keywords = new RT::Keywords($self->CurrentUser); + $Keywords->LimitToParent($self->id || 0 ); #If we have no id, start at the top + + while ( my $Keyword = $Keywords->Next ) { + + next if defined $exclude->{ $Keyword->id }; + $results{ $Keyword->id } = $Keyword->Name; + + if ( $generations == 0 || $generations > 1 ) { + #if we're limiting to some number of generations, + # decrement the number of generations + + my $nextgen = $generations; + $nextgen-- if ( $nextgen > 1 ); + + my $kids = $Keyword->Descendents($nextgen, \%results); + + foreach my $kid ( keys %{$kids}) { + $results{"$kid"} = $Keyword->Name. "/". $kids->{"$kid"}; + } + } + } + return(\%results); +} + +# }}} + +# {{{ ACL related methods + +# {{{ sub _Set + +# does an acl check and then passes off the call +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('AdminKeywords')) { + return (0,'Permission Denied'); + } + return $self->SUPER::_Set(@_); +} + +# }}} + +# {{{ sub CurrentUserHasRight + +=head2 CurrentUserHasRight + +Helper menthod for HasRight. Presets Principal to CurrentUser then +calls HasRight. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Principal => $self->CurrentUser->UserObj, + Right => $right )); + +} + +# }}} + +# {{{ sub HasRight + +=head2 HasRight + +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to Keywords. + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + @_ ); + + return( $args{'Principal'}->HasSystemRight( $args{'Right'}) ); + +} +# }}} + +# }}} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-rt@420.am> + +=head1 BUGS + +Yes. + +=head1 SEE ALSO + +L<RT::Keywords>, L<RT::ObjectKeyword>, L<RT::ObjectKeywords>, L<RT::Ticket>, +L<RT::Record> + +[A=cut + +1; + diff --git a/rt/lib/RT/KeywordSelect.pm b/rt/lib/RT/KeywordSelect.pm new file mode 100644 index 000000000..6865216fd --- /dev/null +++ b/rt/lib/RT/KeywordSelect.pm @@ -0,0 +1,452 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/KeywordSelect.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::KeywordSelect; + +use strict; +use vars qw(@ISA); +use RT::Record; +use RT::Keyword; + +@ISA = qw(RT::Record); + +# {{{ POD + +=head1 NAME + + RT::KeywordSelect - Manipulate an RT::KeywordSelect record + +=head1 SYNOPSIS + + use RT::KeywordSelect; + + my $keyword_select = RT::KeywordSelect->new($CurrentUser); + $keyword_select->Create( + Keyword => 20, + ObjectType => 'Ticket', + Name => 'Choices' + ); + + my $keyword_select = RT::KeywordSelect->new($CurrentUser); + $keyword_select->Create( + Name => 'Choices', + Keyword => 20, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => 1, + Single => 1, + Depth => 4, + ); + +=head1 DESCRIPTION + +An B<RT::KeywordSelect> object is a link between a Keyword and a object +type (one of: Ticket), titled by the I<Name> field of the B<RT::Keyword> such +that: + +=over 4 + +=item Object display will contain a field, titled with the I<Name> field and + showing any descendent keywords which are related to this object via the + B<RT::ObjectKeywords> table. + +=item Object creation for this object will contain a field titled with the + I<Name> field and containing the descendents of the B<RT::Keyword> as + choices. If the I<Single> field of this B<RT::KeywordSelect> is true, each + object must be associated (via an B<RT::ObjectKeywords> record) to a single + descendent. If the I<Single> field is false, each object may be connect to + zero, one, or many descendents. + +=item Searches for this object type will contain a selection field titled with + the I<Name> field and containing the descendents of the B<RT::Keyword> as + choices. + +=item If I<ObjectField> is defined (one of: Queue), all of the above apply only + when the value of I<ObjectField> (Queue) in B<ObjectType> (Ticket) matches + I<ObjectValue>. + +=back + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::KeywordSelects); + +=end testing + + +=head1 METHODS + + +=cut + + +=over 4 + +=item new CURRENT_USER + +Takes a single argument, an RT::CurrentUser object. Instantiates a new +(uncreated) RT::KeywordSelect object. + +=cut +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "KeywordSelects"; + $self->SUPER::_Init(@_); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Name => 'read/write', + Keyword => 'read/write', # link to Keywords. Can be specified by id + Single => 'read/write', # bool (described below) + + Depth => 'read/write', #- If non-zero, limits the descendents to this number of levels deep. + ObjectType => 'read/write', # currently only C<Ticket> + ObjectField => 'read/write', #optional, currently only C<Queue> + ObjectValue => 'read/write', #constrains KeywordSelect function to when B<ObjectType>.I<ObjectField> equals I<ObjectValue> + Disabled => 'read/write' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} + +# {{{ sub LoadByName + +=head2 LoadByName( Name => [NAME], Queue => [QUEUE_ID]) +. Takes a queue id and a keyword select name. + tries to load the keyword select for that queue. if that fails, it tries to load it + without a queue specified. + +=cut + + +sub LoadByName { + my $self = shift; + my %args = ( Name => undef, + Queue => undef, + @_ + ); + if ($args{'Queue'}) { + #Try to get the keyword select for this queue + $self->LoadByCols( Name => $args{'Name'}, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => $args{'Queue'}); + } + unless ($self->Id) { #if that failed to load an object + #Try to get the keyword select of that name that's global + $self->LoadByCols( Name => $args{'Name'}, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => '0'); + } + + return($self->Id); + +} + +# }}} + +# {{{ sub Create +=item Create KEY => VALUE, ... + +Takes a list of key/value pairs and creates a the object. Returns the id of +the newly created record, or false if there was an error. + +Keys are: + +Keyword - link to Keywords. Can be specified by id. +Name - A name for this KeywordSelect +Single - bool (described above) +Depth - If non-zero, limits the descendents to this number of levels deep. +ObjectType - currently only C<Ticket> +ObjectField - optional, currently only C<Queue> +ObjectValue - constrains KeywordSelect function to when B<ObjectType>.I<ObjectField> equals I<ObjectValue> + +=cut + +sub Create { + my $self = shift; + my %args = ( Keyword => undef, + Single => 1, + Depth => 0, + Name => undef, + ObjectType => undef, + ObjectField => undef, + ObjectValue => undef, + @_); + + #If we're talking about a keyword select based on a ticket's 'Queue' field + if ( ($args{'ObjectField'} eq 'Queue') and + ($args{'ObjectType'} eq 'Ticket')) { + + #If we're talking about a keywordselect for all queues + if ($args{'ObjectValue'} == 0) { + unless( $self->CurrentUserHasSystemRight('AdminKeywordSelects')) { + return (0, 'Permission Denied'); + } + } + #otherwise, we're talking about a keywordselect for a specific queue + else { + unless ($self->CurrentUserHasQueueRight( Right => 'AdminKeywordSelects', + Queue => $args{'ObjectValue'})) { + return (0, 'Permission Denied'); + } + } + } + else { + return (0, "Can't create a KeywordSelect for that object/field combo"); + } + + my $Keyword = new RT::Keyword($self->CurrentUser); + + if ( $args{'Keyword'} && $args{'Keyword'} !~ /^\d+$/ ) { + $Keyword->LoadByPath($args{'Keyword'}); + } + else { + $Keyword->Load($args{'Keyword'}); + } + + unless ($Keyword->Id) { + $RT::Logger->debug("Keyword ".$args{'Keyword'} ." not found\n"); + return(0, 'Keyword not found'); + } + + $args{'Name'} = $Keyword->Name if (!$args{'Name'}); + + my $val = $self->SUPER::Create( Name => $args{'Name'}, + Keyword => $Keyword->Id, + Single => $args{'Single'}, + Depth => $args{'Depth'}, + ObjectType => $args{'ObjectType'}, + ObjectField => $args{'ObjectField'}, + ObjectValue => $args{'ObjectValue'}); + if ($val) { + return ($val, 'KeywordSelect Created'); + } + else { + return (0, 'System error. KeywordSelect not created'); + + } +} +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + + return (0, 'Deleting this object would break referential integrity.'); +} + +# }}} + + +# {{{ sub SetDisabled + +=head2 Sub SetDisabled + +Toggles the KeywordSelect's disabled flag. + + +=cut + +sub SetDisabled { + my $self = shift; + my $value = shift; + + unless ($self->CurrentUserHasRight('AdminKeywordSelects')) { + return (0, "Permission Denied"); + } + return($self->_Set(Field => 'Disabled', Value => $value)); +} + +# }}} + +# {{{ sub KeywordObj + +=item KeywordObj + +Returns the B<RT::Keyword> referenced by the I<Keyword> field. + +=cut + +sub KeywordObj { + my $self = shift; + + my $Keyword = new RT::Keyword($self->CurrentUser); + $Keyword->Load( $self->Keyword ); #or ? + return($Keyword); +} +# }}} + +# {{{ sub Object + +=item Object + +Returns the object (currently only RT::Queue) specified by ObjectField and ObjectValue. + +=cut + +sub Object { + my $self = shift; + if ( $self->ObjectField eq 'Queue' ) { + my $Queue = new RT::Queue($self->CurrentUser); + $Queue->Load( $self->ObjectValue ); + return ($Queue); + } else { + $RT::Logger->error("$self trying to load an object value for a non-queue object"); + return (undef); + } +} + +# }}} + +# {{{ sub _Set + +# does an acl check, then passes off the call +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('AdminKeywordSelects')) { + return (0, "Permission Denied"); + } + + return ($self->SUPER::_Set(@_)); + +} + +# }}} + + +# {{{ sub CurrentUserHasQueueRight + +=head2 CurrentUserHasQueueRight ( Queue => QUEUEID, Right => RIGHTNANAME ) + +Check to see whether the current user has the specified right for the specified queue. + +=cut + +sub CurrentUserHasQueueRight { + my $self = shift; + my %args = (Queue => undef, + Right => undef, + @_ + ); + return ($self->HasRight( Right => $args{'Right'}, + Principal => $self->CurrentUser->UserObj, + Queue => $args{'Queue'})); +} + +# }}} + +# {{{ sub CurrentUserHasSystemRight + +=head2 CurrentUserHasSystemRight RIGHTNAME + +Check to see whether the current user has the specified right for the 'system' scope. + +=cut + +sub CurrentUserHasSystemRight { + my $self = shift; + my $right = shift; + $RT::Logger->debug("$self in hashsysright for right $right\n"); + return ($self->HasRight( Right => $right, + System => 1, + Principal => $self->CurrentUser->UserObj)); +} + +# }}} + +# {{{ sub CurrentUserHasRight + +=item CurrentUserHasRight RIGHT [QUEUEID] + +Takes a rightname as a string. Can take a queue id as a second +optional parameter, which can be useful to a routine like create. +Helper menthod for HasRight. Presets Principal to CurrentUser then +calls HasRight. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Principal => $self->CurrentUser->UserObj, + Right => $right, + )); +} + +# }}} + +# {{{ sub HasRight + +=item HasRight + +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to KeywordSelects + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + Queue => undef, + System => undef, + @_ ); + + #If we're explicitly specifying a queue, as we need to do on create + if ($args{'Queue'}) { + return ($args{'Principal'}->HasQueueRight(Right => $args{'Right'}, + Queue => $args{'Queue'})); + } + #else if we're specifying to check a system right + elsif ($args{'System'}) { + return( $args{'Principal'}->HasSystemRight( $args{'Right'} )); + } + + #else if we 're using the object's queue + elsif (($self->__Value('ObjectField') eq 'Queue') and + ($self->__Value('ObjectValue') > 0 )) { + return ($args{'Principal'}->HasQueueRight(Right => $args{'Right'}, + Queue => $self->__Value('ObjectValue') )); + } + + #If the object is system scoped. + else { + return( $args{'Principal'}->HasSystemRight( $args{'Right'} )); + } +} + +# }}} + +=back + +=head1 AUTHORS + +Ivan Kohler <ivan-rt@420.am>, Jesse Vincent <jesse@fsck.com> + +=head1 BUGS + +The ACL system for this object is more byzantine than it should be. reworking it eventually +would be a good thing. + +=head1 SEE ALSO + +L<RT::KeywordSelects>, L<RT::Keyword>, L<RT::Keywords>, L<RT::ObjectKeyword>, +L<RT::ObjectKeywords>, L<RT::Record> + +=cut + +1; + diff --git a/rt/lib/RT/KeywordSelects.pm b/rt/lib/RT/KeywordSelects.pm new file mode 100644 index 000000000..c220b39f9 --- /dev/null +++ b/rt/lib/RT/KeywordSelects.pm @@ -0,0 +1,143 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/KeywordSelects.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Scrip); + +=end testing + +=cut + + +package RT::KeywordSelects; + +use strict; +use vars qw( @ISA ); +use RT::EasySearch; +use RT::KeywordSelect; + +@ISA = qw( RT::EasySearch ); + +# {{{ _Init +sub _Init { + my $self = shift; + $self->{'table'} = 'KeywordSelects'; + $self->{'primary_key'} = 'id'; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _DoSearch + +=head2 _DoSearch + + A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless +we're explicitly trying to see them. + +=cut + +sub _DoSearch { + my $self = shift; + + #unless we really want to find disabled rows, make sure we\'re only finding enabled ones. + unless($self->{'find_disabled_rows'}) { + $self->LimitToEnabled(); + } + + return($self->SUPER::_DoSearch(@_)); + +} + +# }}} + +# {{{ sub LimitToQueue +=head2 LimitToQueue + +Takes a queue id. Limits the returned set to KeywordSelects for that queue. +Repeated calls will be OR'd together. + +=cut + +sub LimitToQueue { + my $self = shift; + my $queue = shift; + + $self->Limit( FIELD => 'ObjectValue', + VALUE => $queue, + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' + ); + + $self->Limit( FIELD => 'ObjectType', + VALUE => 'Ticket', + OPERATOR => '='); + + $self->Limit( FIELD => 'ObjectField', + VALUE => 'Queue', + OPERATOR => '='); + + +} +# }}} + +# {{{ sub LimitToGlobals + +=head2 LimitToGlobals + +Limits the returned set to KeywordSelects for all queues. +Repeated calls will be OR'd together. + +=cut + +sub LimitToGlobals { + my $self = shift; + + $self->Limit( FIELD => 'ObjectType', + VALUE => 'Ticket', + OPERATOR => '='); + + $self->Limit( FIELD => 'ObjectField', + VALUE => 'Queue', + OPERATOR => '='); + + $self->Limit( FIELD => 'ObjectValue', + VALUE => '0', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' + ); + +} +# }}} + +# {{{ sub IncludeGlobals +=head2 IncludeGlobals + +Include KeywordSelects which apply globally in the set of returned results + +=cut + + +sub IncludeGlobals { + my $self = shift; + $self->Limit( FIELD => 'ObjectValue', + VALUE => '0', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' + ); + + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + #my $Handle = shift; + return (new RT::KeywordSelect($self->CurrentUser)); +} +# }}} +1; + diff --git a/rt/lib/RT/Keywords.pm b/rt/lib/RT/Keywords.pm new file mode 100644 index 000000000..a9ecda2bc --- /dev/null +++ b/rt/lib/RT/Keywords.pm @@ -0,0 +1,106 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Keywords.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Keywords - a collection of RT::Keyword objects + +=head1 SYNOPSIS + + use RT::Keywords; + my $keywords = RT::Keywords->new($user); + $keywords->LimitToParent(0); + while my ($keyword = $keywords->Next()) { + print $keyword->Name ."\n"; + } + + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Keywords); + +=end testing + +=cut + +package RT::Keywords; + +use strict; +use vars qw( @ISA ); +use RT::EasySearch; +use RT::Keyword; + +@ISA = qw( RT::EasySearch ); + + +# {{{ sub _Init + +sub _Init { + my $self = shift; + $self->{'table'} = 'Keywords'; + $self->{'primary_key'} = 'id'; + + # By default, order by name + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); + + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _DoSearch + +=head2 _DoSearch + + A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless +we're explicitly trying to see them. + +=cut + +sub _DoSearch { + my $self = shift; + + #unless we really want to find disabled rows, make sure we\'re only finding enabled ones. + unless($self->{'find_disabled_rows'}) { + $self->LimitToEnabled(); + } + + return($self->SUPER::_DoSearch(@_)); + +} + +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return (RT::Keyword->new($self->CurrentUser)); +} +# }}} + +# {{{ sub LimitToParent + +=head2 LimitToParent + +Takes a parent id and limits the returned keywords to children of that parent. + +=cut + +sub LimitToParent { + my $self = shift; + my $parent = shift; + $self->Limit( FIELD => 'Parent', + VALUE => $parent, + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' ); +} +# }}} + +1; + diff --git a/rt/lib/RT/Link.pm b/rt/lib/RT/Link.pm index 962c378a8..885ffe3ed 100644 --- a/rt/lib/RT/Link.pm +++ b/rt/lib/RT/Link.pm @@ -1,302 +1,373 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Link.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-1999 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL =head1 NAME -RT::Link - + RT::Link - an RT Link object =head1 SYNOPSIS + use RT::Link; + =head1 DESCRIPTION +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket other similar objects. + =head1 METHODS -=cut -package RT::Link; -use RT::Record; +=begin testing +ok (require RT::TestHarness); +ok (require RT::Link); -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +=end testing -sub _Init { - my $self = shift; +=cut - $self->Table('Links'); - $self->SUPER::_Init(@_); +package RT::Link; +use RT::Record; +use Carp; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Links"; + return ($self->SUPER::_Init(@_)); } +# }}} +# {{{ sub Create +=head2 Create PARAMHASH - -=item Create PARAMHASH - -Create takes a hash of values and creates a row in the database: - - varchar(240) 'Base'. - varchar(240) 'Target'. - varchar(20) 'Type'. - int(11) 'LocalTarget'. - int(11) 'LocalBase'. +Create a new link object. Takes 'Base', 'Target' and 'Type'. +Returns undef on failure or a Link Id on success. =cut - - - -sub Create { +sub Create { my $self = shift; - my %args = ( - Base => '', - Target => '', - Type => '', - LocalTarget => '0', - LocalBase => '0', - - @_); - $self->SUPER::Create( - Base => $args{'Base'}, - Target => $args{'Target'}, - Type => $args{'Type'}, - LocalTarget => $args{'LocalTarget'}, - LocalBase => $args{'LocalBase'}, -); - + my %args = ( Base => undef, + Target => undef, + Type => undef, + @_ # get the real argumentlist + ); + + my $BaseURI = $self->CanonicalizeURI($args{'Base'}); + my $TargetURI = $self->CanonicalizeURI($args{'Target'}); + + unless (defined $BaseURI) { + $RT::Logger->warning ("$self couldn't resolve base:'".$args{'Base'}. + "' into a URI\n"); + return (undef); + } + unless (defined $TargetURI) { + $RT::Logger->warning ("$self couldn't resolve target:'".$args{'Target'}. + "' into a URI\n"); + return(undef); + } + + my $LocalBase = $self->_IsLocal($BaseURI); + my $LocalTarget = $self->_IsLocal($TargetURI); + my $id = $self->SUPER::Create(Base => "$BaseURI", + Target => "$TargetURI", + LocalBase => $LocalBase, + LocalTarget => $LocalTarget, + Type => $args{'Type'}); + return ($id); } +# }}} + +# {{{ sub Load +=head2 Load -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) + Load an RT::Link object from the database. Takes one parameter or three. + One parameter is the id of an entry in the links table. Three parameters are a tuple of (base, linktype, target); =cut +sub Load { + my $self = shift; + my $identifier = shift; + my $linktype = shift if (@_); + my $target = shift if (@_); + + if ($target) { + my $BaseURI = $self->CanonicalizeURI($identifier); + my $TargetURI = $self->CanonicalizeURI($target); + $self->LoadByCols( Base => $BaseURI, + Type => $linktype, + Target => $TargetURI + ) || return (0, "Couldn't load link"); + } + + elsif ($identifier =~ /^\d+$/) { + $self->LoadById($identifier) || + return (0, "Couldn't load link"); + } + else { + return (0, "That's not a numerical id"); + } +} -=item Base - -Returns the current value of Base. -(In the database, Base is stored as varchar(240).) +# }}} +# {{{ sub TargetObj +=head2 TargetObj -=item SetBase VALUE +=cut +sub TargetObj { + my $self = shift; + return $self->_TicketObj('base',$self->Target); +} +# }}} -Set Base to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Base will be stored as a varchar(240).) +# {{{ sub BaseObj +=head2 BaseObj =cut - -=item Target - -Returns the current value of Target. -(In the database, Target is stored as varchar(240).) - +sub BaseObj { + my $self = shift; + return $self->_TicketObj('target',$self->Base); +} +# }}} + +# {{{ sub _TicketObj +sub _TicketObj { + my $self = shift; + my $name = shift; + my $ref = shift; + my $tag="$name\_obj"; + + unless (exists $self->{$tag}) { + + $self->{$tag}=RT::Ticket->new($self->CurrentUser); + + #If we can get an actual ticket, load it up. + if ($self->_IsLocal($ref)) { + $self->{$tag}->Load($ref); + } + } + return $self->{$tag}; +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + LocalBase => 'read', + LocalTarget => 'read', + Base => 'read', + Target => 'read', + Type => 'read', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} -=item SetTarget VALUE +# Static methods: +# {{{ sub BaseIsLocal -Set Target to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Target will be stored as a varchar(240).) +=head2 BaseIsLocal +Returns true if the base of this link is a local ticket =cut +sub BaseIsLocal { + my $self = shift; + return $self->_IsLocal($self->Base); +} -=item Type - -Returns the current value of Type. -(In the database, Type is stored as varchar(20).) - - - -=item SetType VALUE +# }}} +# {{{ sub TargetIsLocal -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(20).) +=head2 TargetIsLocal +Returns true if the target of this link is a local ticket =cut +sub TargetIsLocal { + my $self = shift; + return $self->_IsLocal($self->Target); +} -=item LocalTarget - -Returns the current value of LocalTarget. -(In the database, LocalTarget is stored as int(11).) - - - -=item SetLocalTarget VALUE +# }}} +# {{{ sub _IsLocal -Set LocalTarget to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, LocalTarget will be stored as a int(11).) +=head2 _IsLocal URI +When handed a URI returns the local ticket id if it\'s local. otherwise returns undef. =cut +sub _IsLocal { + my $self = shift; + my $URI=shift; + unless ($URI) { + $RT::Logger->warning ("$self _IsLocal called without a URI\n"); + return (undef); + } + # TODO: More thorough check + if ($URI =~ /^$RT::TicketBaseURI(\d+)$/) { + return($1); + } + else { + return (undef); + } +} +# }}} -=item LocalBase - -Returns the current value of LocalBase. -(In the database, LocalBase is stored as int(11).) - - - -=item SetLocalBase VALUE +# {{{ sub BaseAsHREF -Set LocalBase to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, LocalBase will be stored as a int(11).) +=head2 BaseAsHREF +Returns an HTTP url to access the base of this link =cut +sub BaseAsHREF { + my $self = shift; + return $self->AsHREF($self->Base); +} +# }}} -=item LastUpdatedBy +# {{{ sub TargetAsHREF -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) +=head2 TargetAsHREF +return an HTTP url to access the target of this link =cut +sub TargetAsHREF { + my $self = shift; + return $self->AsHREF($self->Target); +} +# }}} -=item LastUpdated - -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +# {{{ sub AsHREF - Converts Link URIs to HTTP URLs +=head2 URI +Takes a URI and returns an http: url to access that object. =cut +sub AsHREF { + my $self=shift; + my $URI=shift; + if ($self->_IsLocal($URI)) { + my $url=$RT::WebURL . "Ticket/Display.html?id=$URI"; + return($url); + } + else { + my ($protocol) = $URI =~ m|(.*?)://|; + unless (exists $RT::URI2HTTP{$protocol}) { + $RT::Logger->warning("Linking for protocol $protocol not defined in the config file!"); + return(""); + } + return $RT::URI2HTTP{$protocol}->($URI); + } +} +# }}} + +# {{{ sub GetContent - gets the content from a link +sub GetContent { + my ($self, $URI)= @_; + if ($self->_IsLocal($URI)) { + die "stub"; + } else { + # Find protocol + if ($URI =~ m|^(.*?)://|) { + if (exists $RT::ContentFromURI{$1}) { + return $RT::ContentFromURI{$1}->($URI); + } else { + warn "No sub exists for fetching the content from a $1 in $URI"; + } + } else { + warn "No protocol specified in $URI"; + } + } +} +# }}} -=item Creator - -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) - - -=cut - +# {{{ sub CanonicalizeURI -=item Created +=head2 CanonicalizeURI -Returns the current value of Created. -(In the database, Created is stored as datetime.) +Takes a single argument: some form of ticket identifier. +Returns its canonicalized URI. +Bug: ticket aliases can't have :// in them. URIs must have :// in them. =cut - - -sub _ClassAccessible { - { +sub CanonicalizeURI { + my $self = shift; + my $id = shift; + + + #If it's a local URI, load the ticket object and return its URI + if ($id =~ /^$RT::TicketBaseURI/) { + my $ticket = new RT::Ticket($self->CurrentUser); + $ticket->Load($id); + #If we couldn't find a ticket, return undef. + return undef unless (defined $ticket->Id); + #$RT::Logger->debug("$self -> CanonicalizeURI was passed $id and returned ".$ticket->URI ." (uri)\n"); + return ($ticket->URI); + } + #If it's a remote URI, we're going to punt for now + elsif ($id =~ '://' ) { + return ($id); + } + + #If the base is an integer, load it as a ticket + elsif ( $id =~ /^\d+$/ ) { + + #$RT::Logger->debug("$self -> CanonicalizeURI was passed $id. It's a ticket id.\n"); + my $ticket = new RT::Ticket($self->CurrentUser); + $ticket->Load($id); + #If we couldn't find a ticket, return undef. + return undef unless (defined $ticket->Id); + #$RT::Logger->debug("$self returned ".$ticket->URI ." (id #)\n"); + return ($ticket->URI); + } + + #It's not a URI. It's not a numerical ticket ID + else { - id => - {read => 1, type => 'int(11)', default => ''}, - Base => - {read => 1, write => 1, type => 'varchar(240)', default => ''}, - Target => - {read => 1, write => 1, type => 'varchar(240)', default => ''}, - Type => - {read => 1, write => 1, type => 'varchar(20)', default => ''}, - LocalTarget => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - LocalBase => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::Link_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Link_Overlay.pm}) { - die $@; - }; - - eval "require RT::Link_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Link_Vendor.pm}) { - die $@; - }; - - eval "require RT::Link_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Link_Local.pm}) { - die $@; - }; - - - + #If we couldn't find a ticket, return undef. + return( undef); + + } -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::Link_Overlay, RT::Link_Vendor, RT::Link_Local - -=cut + +} +# }}} 1; + diff --git a/rt/lib/RT/Links.pm b/rt/lib/RT/Links.pm index 7a1773af9..a8180caf0 100644 --- a/rt/lib/RT/Links.pm +++ b/rt/lib/RT/Links.pm @@ -1,115 +1,90 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Links.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Links -- Class Description - + RT::Links - A collection of Link objects + =head1 SYNOPSIS - use RT::Links + use RT::Links; + my $links = new RT::Links($CurrentUser); =head1 DESCRIPTION =head1 METHODS -=cut -package RT::Links; +=begin testing -use RT::SearchBuilder; -use RT::Link; - -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +ok (require RT::TestHarness); +ok (require RT::Links); +=end testing -sub _Init { - my $self = shift; - $self->{'table'} = 'Links'; - $self->{'primary_key'} = 'id'; +=cut +package RT::Links; +use RT::EasySearch; +use RT::Link; - return ( $self->SUPER::_Init(@_) ); -} +@ISA= qw(RT::EasySearch); +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "Links"; + $self->{'primary_key'} = "id"; -=item NewItem -Returns an empty new RT::Link item + return ( $self->SUPER::_Init(@_)); +} +# }}} -=cut +# {{{ sub Limit +sub Limit { + my $self = shift; + my %args = ( ENTRYAGGREGATOR => 'AND', + OPERATOR => '=', + @_); + + #if someone's trying to search for tickets, try to resolve the uris for searching. + + if ( ( $args{'OPERATOR'} eq '=') and + ( $args{'FIELD'} eq 'Base') or ($args{'FIELD'} eq 'Target') + ) { + my $dummy = $self->NewItem(); + $uri = $dummy->CanonicalizeURI($args{'VALUE'}); + } + + + # If we're limiting by target, order by base + # (Order by the thing that's changing) + + if ( ($args{'FIELD'} eq 'Target') or + ($args{'FIELD'} eq 'LocalTarget') ) { + $self->OrderBy (ALIAS => 'main', + FIELD => 'Base', + ORDER => 'ASC'); + } + elsif ( ($args{'FIELD'} eq 'Base') or + ($args{'FIELD'} eq 'LocalBase') ) { + $self->OrderBy (ALIAS => 'main', + FIELD => 'Target', + ORDER => 'ASC'); + } + + + $self->SUPER::Limit(%args); +} +# }}} -sub NewItem { +# {{{ sub NewItem +sub NewItem { my $self = shift; return(RT::Link->new($self->CurrentUser)); } +# }}} + 1; - eval "require RT::Links_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Links_Overlay.pm}) { - die $@; - }; - - eval "require RT::Links_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Links_Vendor.pm}) { - die $@; - }; - - eval "require RT::Links_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Links_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::Links_Overlay, RT::Links_Vendor, RT::Links_Local - -=cut - - -1; diff --git a/rt/lib/RT/ObjectKeyword.pm b/rt/lib/RT/ObjectKeyword.pm new file mode 100644 index 000000000..287d41fab --- /dev/null +++ b/rt/lib/RT/ObjectKeyword.pm @@ -0,0 +1,192 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/ObjectKeyword.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Released under the terms of the GNU Public License + +=head1 NAME + + RT::ObjectKeyword -- a keyword tied to an object in the database + +=head1 SYNOPSIS + + use RT::ObjectKeyword; + + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ObjectKeyword); + +=end testing + +=head1 METHODS + +=cut + +package RT::ObjectKeyword; + +use strict; +use vars qw(@ISA); +use RT::Record; + +@ISA = qw(RT::Record); + +sub _Init { + my $self = shift; + $self->{'table'} = "ObjectKeywords"; + $self->SUPER::_Init(@_); +} + +sub _Accessible { + my $self = shift; + + my %cols = ( + Keyword => 'read/write', #link to the B<RT::Keyword> + KeywordSelect => 'read/write', #link to the B<RT::KeywordSelect> + ObjectType => 'read/write', #currently only C<Ticket> + ObjectId => 'read/write', #link to the object specified in I<ObjectType> + ); + return ($self->SUPER::_Accessible( @_, %cols)); +} + + + +# TODO - post 2.0. add in _Set and _Value, so we can ACL them. protected at another API level + + +=head1 NAME + + RT::ObjectKeyword - Manipulate an RT::ObjectKeyword record + +=head1 SYNOPSIS + + use RT::ObjectKeyword; + + my $keyword = RT::ObjectKeyword->new($CurrentUser); + $keyword->Create; + +=head1 DESCRIPTION + +An B<RT::ObjectKeyword> object associates an B<RT::Keyword> with another +object (currently only B<RT::Ticket>. + +This module should B<NEVER> be called directly by client code. its API is entirely through RT ticket or other objects which can have keywords assigned. + + +=head1 METHODS + +=over 4 + +=item new CURRENT_USER + +Takes a single argument, an RT::CurrentUser object. Instantiates a new +(uncreated) RT::ObjectKeyword object. + +=cut + +# {{{ sub Create + +=item Create KEY => VALUE, ... + +Takes a list of key/value pairs and creates a the object. Returns the id of +the newly created record, or false if there was an error. + +Keys are: + +Keyword - link to the B<RT::Keyword> +ObjectType - currently only C<Ticket> +ObjectId - link to the object specified in I<ObjectType> + +=cut + + +sub Create { + my $self = shift; + my %args = (Keyword => undef, + KeywordSelect => undef, + ObjectType => undef, + ObjectId => undef, + @_); + + #TODO post 2.0 ACL check + + return ($self->SUPER::Create( Keyword => $args{'Keyword'}, + KeywordSelect => $args{'KeywordSelect'}, + ObjectType => $args{'ObjectType'}, + ObjectId => $args{'ObjectId'})) +} +# }}} + +# {{{ sub KeywordObj + +=item KeywordObj + +Returns an B<RT::Keyword> object of the Keyword associated with this ObjectKeyword. + +=cut + +sub KeywordObj { + my $self = shift; + my $keyword = new RT::Keyword($self->CurrentUser); + $keyword->Load($self->Keyword); + return ($keyword); +} +# }}} + +# {{{ sub KeywordSelectObj + +=item KeywordSelectObj + +Returns an B<RT::KeywordSelect> object of the KeywordSelect associated with this ObjectKeyword. + +=cut + +sub KeywordSelectObj { + my $self = shift; + my $keyword_sel = new RT::KeywordSelect($self->CurrentUser); + $keyword_sel->Load($self->KeywordSelect); + return ($keyword_sel); +} +# }}} + +# {{{ sub KeywordRelativePath + +=item KeywordRelativePath + +Returns a string of the Keyword's path relative to this ObjectKeyword's KeywordSelect + + + +=cut + +sub KeywordRelativePath { + my $self = shift; + return($self->KeywordObj->RelativePath( + $self->KeywordSelectObj->KeywordObj->Path)); + +} +# }}} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-rt@420.am> + +=head1 BUGS + +Yes. + +=head1 SEE ALSO + +L<RT::ObjectKeywords>, L<RT::Keyword>, L<RT::Keywords>, L<RT::Ticket>, +L<RT::Record> + +=cut + +1; + diff --git a/rt/lib/RT/ObjectKeywords.pm b/rt/lib/RT/ObjectKeywords.pm new file mode 100644 index 000000000..5df996e37 --- /dev/null +++ b/rt/lib/RT/ObjectKeywords.pm @@ -0,0 +1,234 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/ObjectKeywords.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::ObjectKeywords; + +use strict; +use vars qw( @ISA ); + +=head1 NAME + + RT::ObjectKeywords - note warning + +=head1 WARNING + +This module should B<NEVER> be called directly by client code. its API is entirely through RT ticket or other objects which can have keywords assigned. + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ObjectKeywords); + +=end testing + +=cut + +use RT::EasySearch; +use RT::ObjectKeyword; + +@ISA = qw( RT::EasySearch ); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = 'ObjectKeywords'; + $self->{'primary_key'} = 'id'; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return (new RT::ObjectKeyword($self->CurrentUser)); +} +# }}} + +# {{{ sub LimitToKeywordSelect + +=head2 LimitToKeywordSelect + + Takes a B<RT::KeywordSelect> id or Nameas its single argument. limits the returned set of ObjectKeywords +to ObjectKeywords which apply to that ticket + +=cut + + +sub LimitToKeywordSelect { + my $self = shift; + my $keywordselect = shift; + + if ($keywordselect =~ /^\d+$/) { + + $self->Limit(FIELD => 'KeywordSelect', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => "$keywordselect"); + } + + #We're limiting by name. time to be klever + else { + my $ks = $self->NewAlias('KeywordSelects'); + $self->Join(ALIAS1 => $ks, FIELD1 => 'id', + ALIAS2 => 'main', FIELD2 => 'KeywordSelect'); + + $self->Limit( ALIAS => "$ks", + FIELD => 'Name', + VALUE => "$keywordselect", + OPERATOR => "=", + ENTRYAGGREGATOR => "OR"); + + $self->Limit ( ALIAS => "$ks", + FIELD => 'ObjectType', + VALUE => 'Ticket', + OPERATOR => '=', + ); + + $self->Limit ( ALIAS => "$ks", + FIELD => 'ObjectField', + VALUE => 'Queue', + OPERATOR => '=', + ); + + + # TODO +++ we need to be able to limit the returned + # keywordselects to ones that apply only to this queue + # $self->Limit( ALIAS => "$ks", + # FIELD => 'ObjectValue', + # VALUE => $self->QueueObj->Id, + # OPERATOR => "=", + # ENTRYAGGREGATOR => "OR"); + + } + + + +} + +# }}} + +# {{{ LimitToTicket + +=head2 LimitToTicket TICKET_ID + + Takes an B<RT::Ticket> id as its single argument. limits the returned set of ObjectKeywords +to ObjectKeywords which apply to that ticket + +=cut + +sub LimitToTicket { + my $self = shift; + my $ticket = shift; + $self->Limit(FIELD => 'ObjectId', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => "$ticket"); + + $self->Limit(FIELD => 'ObjectType', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => "Ticket"); + +} + +# }}} + +# {{{ sub _DoSearch +#wrap around _DoSearch so that we can build the hash of returned +#values + +sub _DoSearch { + my $self = shift; + # $RT::Logger->debug("Now in ".$self."->_DoSearch"); + my $return = $self->SUPER::_DoSearch(@_); + # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return\n"); + $self->_BuildHash(); + return ($return); +} +# }}} + +# {{{ sub _BuildHash +#Build a hash of this ACL's entries. +sub _BuildHash { + my $self = shift; + + while (my $entry = $self->Next) { + + my $hashkey = $entry->Keyword; + $self->{'as_hash'}->{"$hashkey"} =1; + } + +} +# }}} + +# {{{ HasEntry + +=head2 HasEntry KEYWORD_ID + + Takes a keyword id and returns true if this ObjectKeywords object has an entry for that +keyword. Returns undef otherwise. + +=cut + +sub HasEntry { + + my $self = shift; + my $keyword = shift; + + + #if we haven't done the search yet, do it now. + $self->_DoSearch(); + + # $RT::Logger->debug("Now in ".$self."->HasEntry\n"); + + + if ($self->{'as_hash'}->{ $keyword } == 1) { + return(1); + } + else { + return(undef); + } +} + +# }}} + +# {{{ sub RelativePaths + +=head2 RelativePaths + +# Return a (reference to a) list of KeywordRelativePaths + +=cut + +sub RelativePaths { + my $self = shift; + + my @list; + + # Here $key is a RT::ObjectKeyword + while (my $key=$self->Next()) { + push(@list, $key->KeywordRelativePath); + } + return(\@list); +} +# }}} + +# {{{ sub RelativePathsAsString + +=head2 RelativePathsAsString + +# Returns the RT::ObjectKeywords->RelativePaths as a comma seperated string + +=cut + +sub RelativePathsAsString { + my $self = shift; + return(join(", ",@{$self->KeywordRelativePaths})); +} +# }}} + +1; + diff --git a/rt/lib/RT/Queue.pm b/rt/lib/RT/Queue.pm index b362c9f0d..1656903b3 100755 --- a/rt/lib/RT/Queue.pm +++ b/rt/lib/RT/Queue.pm @@ -1,371 +1,944 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Queue.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME -RT::Queue - + RT::Queue - an RT Queue object =head1 SYNOPSIS + use RT::Queue; + =head1 DESCRIPTION + =head1 METHODS +=begin testing +use RT::TestHarness; + +use RT::Queue; + +=end testing + =cut + + package RT::Queue; -use RT::Record; +use RT::Record; + +@ISA= qw(RT::Record); + +use vars (@STATUS); + +@STATUS = qw(new open stalled resolved dead); + +=head2 StatusArray + +Returns an array of all statuses for this queue + +=cut + +sub StatusArray { + my $self = shift; + return (@STATUS); +} + + +=head2 IsValidStatus VALUE + +Returns true if VALUE is a valid status. Otherwise, returns 0 + +=for testing +my $q = new RT::Queue($RT::SystemUser); +ok($q->IsValidStatus('new')== 1, 'New is a valid status'); +ok($q->IsValidStatus('f00')== 0, 'f00 is not a valid status'); + +=cut + +sub IsValidStatus { + my $self = shift; + my $value = shift; + + my $retval = grep (/^$value$/, $self->StatusArray); + return ($retval); + +} + + + + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Queues"; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _Accessible + +sub _Accessible { + my $self = shift; + my %Cols = ( Name => 'read/write', + CorrespondAddress => 'read/write', + Description => 'read/write', + CommentAddress => 'read/write', + InitialPriority => 'read/write', + FinalPriority => 'read/write', + DefaultDueIn => 'read/write', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto', + Disabled => 'read/write', + + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} + +# }}} +# {{{ sub Create -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +=head2 Create -sub _Init { - my $self = shift; +Create takes the name of the new queue +If you pass the ACL check, it creates the queue and returns its queue id. - $self->Table('Queues'); - $self->SUPER::_Init(@_); +=cut + +sub Create { + my $self = shift; + my %args = ( Name => undef, + CorrespondAddress => '', + Description => '', + CommentAddress => '', + InitialPriority => "0", + FinalPriority => "0", + DefaultDueIn => "0", + @_); + + unless ($self->CurrentUser->HasSystemRight('AdminQueue')) { #Check them ACLs + return (0, "No permission to create queues") + } + + unless ($self->ValidateName($args{'Name'})) { + return(0, 'Queue already exists'); + } + #TODO better input validation + + my $id = $self->SUPER::Create(%args); + unless ($id) { + return (0, 'Queue could not be created'); + } + + return ($id, "Queue $id created"); } +# }}} +# {{{ sub Delete +sub Delete { + my $self = shift; + return (0, 'Deleting this object would break referential integrity'); +} +# }}} -=item Create PARAMHASH +# {{{ sub SetDisabled -Create takes a hash of values and creates a row in the database: +=head2 SetDisabled - varchar(200) 'Name'. - varchar(255) 'Description'. - varchar(120) 'CorrespondAddress'. - varchar(120) 'CommentAddress'. - int(11) 'InitialPriority'. - int(11) 'FinalPriority'. - int(11) 'DefaultDueIn'. - smallint(6) 'Disabled'. +Takes a boolean. +1 will cause this queue to no longer be avaialble for tickets. +0 will re-enable this queue =cut +# }}} +# {{{ sub Load +=head2 Load -sub Create { +Takes either a numerical id or a textual Name and loads the specified queue. + +=cut + +sub Load { my $self = shift; - my %args = ( - Name => '', - Description => '', - CorrespondAddress => '', - CommentAddress => '', - InitialPriority => '0', - FinalPriority => '0', - DefaultDueIn => '0', - Disabled => '0', + + my $identifier = shift; + if (!$identifier) { + return (undef); + } + + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol("Name", $identifier); + } + + return ($self->Id); - @_); - $self->SUPER::Create( - Name => $args{'Name'}, - Description => $args{'Description'}, - CorrespondAddress => $args{'CorrespondAddress'}, - CommentAddress => $args{'CommentAddress'}, - InitialPriority => $args{'InitialPriority'}, - FinalPriority => $args{'FinalPriority'}, - DefaultDueIn => $args{'DefaultDueIn'}, - Disabled => $args{'Disabled'}, -); } +# }}} +# {{{ sub ValidateName +=head2 ValidateName NAME -=item id +Takes a queue name. Returns true if it's an ok name for +a new queue. Returns undef if there's already a queue by that name. -Returns the current value of id. -(In the database, id is stored as int(11).) +=cut +sub ValidateName { + my $self = shift; + my $name = shift; + + my $tempqueue = new RT::Queue($RT::SystemUser); + $tempqueue->Load($name); + + #If we couldn't load it :) + unless ($tempqueue->id()) { + return(1); + } + + #If this queue exists, return undef + #Avoid the ACL check. + if ($tempqueue->Name()){ + return(undef); + } + + #If the queue doesn't exist, return 1 + else { + return(1); + } + +} + + +# }}} + +# {{{ sub Templates + +=head2 Templates + +Returns an RT::Templates object of all of this queue's templates. =cut +sub Templates { + my $self = shift; + -=item Name + my $templates = RT::Templates->new($self->CurrentUser); -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) + if ($self->CurrentUserHasRight('ShowTemplate')) { + $templates->LimitToQueue($self->id); + } + + return ($templates); +} + +# }}} +# {{{ Dealing with watchers +# {{{ sub Watchers -=item SetName VALUE +=head2 Watchers +Watchers returns a Watchers object preloaded with this queue\'s watchers. -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) +=cut +sub Watchers { + my $self = shift; + + require RT::Watchers; + my $watchers =RT::Watchers->new($self->CurrentUser); + + if ($self->CurrentUserHasRight('SeeQueue')) { + $watchers->LimitToQueue($self->id); + } + + return($watchers); +} + +# }}} + +# {{{ sub WatchersAsString +=head2 WatchersAsString + +Returns a string of all queue watchers email addresses concatenated with ','s. =cut +sub WatchersAsString { + my $self=shift; + return($self->Watchers->EmailsAsString()); +} + +# }}} + +# {{{ sub AdminCcAsString -=item Description +=head2 AdminCcAsString -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) +Takes nothing. returns a string: All Ticket/Queue AdminCcs. +=cut -=item SetDescription VALUE +sub AdminCcAsString { + my $self=shift; + + return($self->AdminCc->EmailsAsString()); + } +# }}} -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) +# {{{ sub CcAsString +=head2 CcAsString + +B<Returns> String: All Queue Ccs as a comma delimited set of email addresses. =cut +sub CcAsString { + my $self=shift; + + return ($self->Cc->EmailsAsString()); +} + +# }}} + +# {{{ sub Cc + +=head2 Cc + +Takes nothing. +Returns a watchers object which contains this queue\'s Cc watchers -=item CorrespondAddress +=cut -Returns the current value of CorrespondAddress. -(In the database, CorrespondAddress is stored as varchar(120).) +sub Cc { + my $self = shift; + my $cc = $self->Watchers(); + if ($self->CurrentUserHasRight('SeeQueue')) { + $cc->LimitToCc(); + } + return ($cc); +} +# A helper function for Cc, so that we can call it from the ACL checks +# without going through acl checks. +sub _Cc { + my $self = shift; + my $cc = $self->Watchers(); + $cc->LimitToCc(); + return($cc); + +} -=item SetCorrespondAddress VALUE +# }}} +# {{{ sub AdminCc -Set CorrespondAddress to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, CorrespondAddress will be stored as a varchar(120).) +=head2 AdminCc +Takes nothing. +Returns this queue's administrative Ccs as an RT::Watchers object =cut +sub AdminCc { + my $self = shift; + my $admin_cc = $self->Watchers(); + if ($self->CurrentUserHasRight('SeeQueue')) { + $admin_cc->LimitToAdminCc(); + } + return($admin_cc); +} + +#helper function for AdminCc so we can call it without ACLs +sub _AdminCc { + my $self = shift; + my $admin_cc = $self->Watchers(); + $admin_cc->LimitToAdminCc(); + return($admin_cc); +} -=item CommentAddress +# }}} -Returns the current value of CommentAddress. -(In the database, CommentAddress is stored as varchar(120).) +# {{{ IsWatcher, IsCc, IsAdminCc + +# {{{ sub IsWatcher + +# a generic routine to be called by IsRequestor, IsCc and IsAdminCc + +=head2 IsWatcher + +Takes a param hash with the attributes Type and User. User is either a user object or string containing an email address. Returns true if that user or string +is a queue watcher. Returns undef otherwise + +=cut + +sub IsWatcher { + my $self = shift; + + my %args = ( Type => 'Requestor', + Id => undef, + Email => undef, + @_ + ); + #ACL check - can't do it. we need this method for ACL checks + # unless ($self->CurrentUserHasRight('SeeQueue')) { + # return(undef); + # } + + + my %cols = ('Type' => $args{'Type'}, + 'Scope' => 'Queue', + 'Value' => $self->Id + ); + if (defined ($args{'Id'})) { + if (ref($args{'Id'})){ #If it's a ref, assume it's an RT::User object; + #Dangerous but ok for now + $cols{'Owner'} = $args{'Id'}->Id; + } + elsif ($args{'Id'} =~ /^\d+$/) { # if it's an integer, it's an RT::User obj + $cols{'Owner'} = $args{'Id'}; + } + else { + $cols{'Email'} = $args{'Id'}; + } + } + + if (defined $args{'Email'}) { + $cols{'Email'} = $args{'Email'}; + } + + my ($description); + $description = join(":",%cols); + + #If we've cached a positive match... + if (defined $self->{'watchers_cache'}->{"$description"}) { + if ($self->{'watchers_cache'}->{"$description"} == 1) { + return(1); + } + #If we've cached a negative match... + else { + return(undef); + } + } + + require RT::Watcher; + my $watcher = new RT::Watcher($self->CurrentUser); + $watcher->LoadByCols(%cols); + + + if ($watcher->id) { + $self->{'watchers_cache'}->{"$description"} = 1; + return(1); + } + else { + $self->{'watchers_cache'}->{"$description"} = 0; + return(undef); + } + +} +# }}} +# {{{ sub IsCc -=item SetCommentAddress VALUE +=head2 IsCc +Takes a string. Returns true if the string is a Cc watcher of the current queue -Set CommentAddress to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, CommentAddress will be stored as a varchar(120).) +=item Bugs +Should also be able to handle an RT::User object =cut -=item InitialPriority +sub IsCc { + my $self = shift; + my $cc = shift; + + return ($self->IsWatcher( Type => 'Cc', Id => $cc )); + +} + +# }}} + +# {{{ sub IsAdminCc + +=head2 IsAdminCc + +Takes a string. Returns true if the string is an AdminCc watcher of the current queue -Returns the current value of InitialPriority. -(In the database, InitialPriority is stored as int(11).) +=item Bugs +Should also be able to handle an RT::User object + +=cut + +sub IsAdminCc { + my $self = shift; + my $admincc = shift; + + return ($self->IsWatcher( Type => 'AdminCc', Id => $admincc )); + +} +# }}} -=item SetInitialPriority VALUE +# }}} +# {{{ sub AddWatcher -Set InitialPriority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, InitialPriority will be stored as a int(11).) +=head2 AddWatcher +Takes a paramhash of Email, Owner and Type. Type is one of 'Cc' or 'AdminCc', +We need either an Email Address in Email or a userid in Owner =cut +sub AddWatcher { + my $self = shift; + my %args = ( Email => undef, + Type => undef, + Owner => 0, + @_ + ); + + # {{{ Check ACLS + #If the watcher we're trying to add is for the current user + if ( ( ( defined $args{'Email'}) && + ( $args{'Email'} eq $self->CurrentUser->EmailAddress) ) or + ($args{'Owner'} eq $self->CurrentUser->Id)) { + + # If it's an AdminCc and they don't have + # 'WatchAsAdminCc' or 'ModifyQueueWatchers', bail + if ($args{'Type'} eq 'AdminCc') { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers') or + $self->CurrentUserHasRight('WatchAsAdminCc')) { + return(0, 'Permission Denied'); + } + } + + # If it's a Requestor or Cc and they don't have + # 'Watch' or 'ModifyQueueWatchers', bail + elsif ($args{'Type'} eq 'Cc') { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers') or + $self->CurrentUserHasRight('Watch')) { + return(0, 'Permission Denied'); + } + } + else { + $RT::Logger->warn("$self -> AddWatcher hit code". + " it never should. We got passed ". + " a type of ". $args{'Type'}); + return (0,'Error in parameters to $self AddWatcher'); + } + } + # If the watcher isn't the current user + # and the current user doesn't have 'ModifyQueueWatchers' + # bail + else { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers')) { + return (0, "Permission Denied"); + } + } + # }}} + + require RT::Watcher; + my $Watcher = new RT::Watcher ($self->CurrentUser); + return ($Watcher->Create(Scope => 'Queue', + Value => $self->Id, + Email => $args{'Email'}, + Type => $args{'Type'}, + Owner => $args{'Owner'} + )); +} -=item FinalPriority +# }}} -Returns the current value of FinalPriority. -(In the database, FinalPriority is stored as int(11).) +# {{{ sub AddCc +=head2 AddCc +Add a Cc to this queue. +Takes a paramhash of Email and Owner. +We need either an Email Address in Email or a userid in Owner -=item SetFinalPriority VALUE +=cut -Set FinalPriority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, FinalPriority will be stored as a int(11).) +sub AddCc { + my $self = shift; + return ($self->AddWatcher( Type => 'Cc', @_)); +} +# }}} +# {{{ sub AddAdminCc + +=head2 AddAdminCc + +Add an Administrative Cc to this queue. +Takes a paramhash of Email and Owner. +We need either an Email Address in Email or a userid in Owner =cut +sub AddAdminCc { + my $self = shift; + return ($self->AddWatcher( Type => 'AdminCc', @_)); +} +# }}} + +# {{{ sub DeleteWatcher + +=head2 DeleteWatcher id [type] -=item DefaultDueIn +DeleteWatcher takes a single argument which is either an email address +or a watcher id. +If the first argument is an email address, you need to specify the watcher type you're talking +about as the second argument. Valid values are 'Cc' or 'AdminCc'. +It removes that watcher from this Queue\'s list of watchers. -Returns the current value of DefaultDueIn. -(In the database, DefaultDueIn is stored as int(11).) +=cut -=item SetDefaultDueIn VALUE +sub DeleteWatcher { + my $self = shift; + my $id = shift; + + my $type; + + $type = shift if (@_); + + + require RT::Watcher; + my $Watcher = new RT::Watcher($self->CurrentUser); + + #If it\'s a numeric watcherid + if ($id =~ /^(\d*)$/) { + $Watcher->Load($id); + } + + #Otherwise, we'll assume it's an email address + elsif ($type) { + my ($result, $msg) = + $Watcher->LoadByValue( Email => $id, + Scope => 'Queue', + Value => $self->id, + Type => $type); + return (0,$msg) unless ($result); + } + + else { + return(0,"Can\'t delete a watcher by email address without specifying a type"); + } + + # {{{ Check ACLS + + #If the watcher we're trying to delete is for the current user + if ($Watcher->Email eq $self->CurrentUser->EmailAddress) { + + # If it's an AdminCc and they don't have + # 'WatchAsAdminCc' or 'ModifyQueueWatchers', bail + if ($Watcher->Type eq 'AdminCc') { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers') or + $self->CurrentUserHasRight('WatchAsAdminCc')) { + return(0, 'Permission Denied'); + } + } + + # If it's a Cc and they don't have + # 'Watch' or 'ModifyQueueWatchers', bail + elsif ($Watcher->Type eq 'Cc') { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers') or + $self->CurrentUserHasRight('Watch')) { + return(0, 'Permission Denied'); + } + } + else { + $RT::Logger->warn("$self -> DeleteWatcher hit code". + " it never should. We got passed ". + " a type of ". $args{'Type'}); + return (0,'Error in parameters to $self DeleteWatcher'); + } + } + # If the watcher isn't the current user + # and the current user doesn't have 'ModifyQueueWatchers' + # bail + else { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers')) { + return (0, "Permission Denied"); + } + } + + # }}} + + unless (($Watcher->Scope eq 'Queue') and + ($Watcher->Value == $self->id) ) { + return (0, "Not a watcher for this queue"); + } + + + #Clear out the watchers hash. + $self->{'watchers'} = undef; + + my $retval = $Watcher->Delete(); + + unless ($retval) { + return(0,"Watcher could not be deleted."); + } + + return(1, "Watcher deleted"); +} + +# {{{ sub DeleteCc +=head2 DeleteCc EMAIL -Set DefaultDueIn to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, DefaultDueIn will be stored as a int(11).) +Takes an email address. It calls DeleteWatcher with a preset +type of 'Cc' =cut +sub DeleteCc { + my $self = shift; + my $id = shift; + return ($self->DeleteWatcher ($id, 'Cc')) +} + +# }}} -=item Creator +# {{{ sub DeleteAdminCc -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +=head2 DeleteAdminCc EMAIL + +Takes an email address. It calls DeleteWatcher with a preset +type of 'AdminCc' =cut +sub DeleteAdminCc { + my $self = shift; + my $id = shift; + return ($self->DeleteWatcher ($id, 'AdminCc')) +} -=item Created +# }}} -Returns the current value of Created. -(In the database, Created is stored as datetime.) +# }}} + +# }}} + +# {{{ Dealing with keyword selects + +# {{{ sub AddKeywordSelect + +=head2 AddKeywordSelect + +Takes a paramhash of Name, Keyword, Depth and Single. Adds a new KeywordSelect for +this queue with those attributes. =cut -=item LastUpdatedBy +sub AddKeywordSelect { + my $self = shift; + my %args = ( Keyword => undef, + Depth => undef, + Single => undef, + Name => undef, + @_); + + #ACLS get handled in KeywordSelect + my $NewKeywordSelect = new RT::KeywordSelect($self->CurrentUser); + + return ($NewKeywordSelect->Create (Keyword => $args{'Keyword'}, + Depth => $args{'Depth'}, + Name => $args{'Name'}, + Single => $args{'Single'}, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => $self->Id() + ) ); +} + +# }}} + +# {{{ sub KeywordSelect -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) +=head2 KeywordSelect([NAME]) +Takes the name of a keyword select for this queue or that's global. +Returns the relevant KeywordSelect object. Prefers a keywordselect that's +specific to this queue over a global one. If it can't find the proper +Keword select or the user doesn't have permission, returns an empty +KeywordSelect object =cut +sub KeywordSelect { + my $self = shift; + my $name = shift; + + require RT::KeywordSelect; + + my $select = RT::KeywordSelect->new($self->CurrentUser); + if ($self->CurrentUserHasRight('SeeQueue')) { + $select->LoadByName( Name => $name, Queue => $self->Id); + } + return ($select); +} + -=item LastUpdated +# }}} -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +# {{{ sub KeywordSelects +=head2 KeywordSelects + +Returns an B<RT::KeywordSelects> object containing the collection of +B<RT::KeywordSelect> objects which apply to this queue. (Both queue specific keyword selects +and global keyword selects. =cut +sub KeywordSelects { + my $self = shift; -=item Disabled -Returns the current value of Disabled. -(In the database, Disabled is stored as smallint(6).) + use RT::KeywordSelects; + my $KeywordSelects = new RT::KeywordSelects($self->CurrentUser); + if ($self->CurrentUserHasRight('SeeQueue')) { + $KeywordSelects->LimitToQueue($self->id); + $KeywordSelects->IncludeGlobals(); + } + return ($KeywordSelects); +} +# }}} +# }}} -=item SetDisabled VALUE +# {{{ ACCESS CONTROL +# {{{ sub ACL -Set Disabled to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Disabled will be stored as a smallint(6).) +=head2 ACL +#Returns an RT::ACL object of ACEs everyone who has anything to do with this queue. =cut +sub ACL { + my $self = shift; + + use RT::ACL; + my $acl = new RT::ACL($self->CurrentUser); + + if ($self->CurrentUserHasRight('ShowACL')) { + $acl->LimitToQueue($self->Id); + } + + return ($acl); +} + +# }}} + +# {{{ sub _Set +sub _Set { + my $self = shift; + unless ($self->CurrentUserHasRight('AdminQueue')) { + return(0, 'Permission Denied'); + } + return ($self->SUPER::_Set(@_)); +} +# }}} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Name => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - CorrespondAddress => - {read => 1, write => 1, type => 'varchar(120)', default => ''}, - CommentAddress => - {read => 1, write => 1, type => 'varchar(120)', default => ''}, - InitialPriority => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - FinalPriority => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - DefaultDueIn => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - Disabled => - {read => 1, write => 1, type => 'smallint(6)', default => '0'}, +# {{{ sub _Value - } -}; +sub _Value { + my $self = shift; + unless ($self->CurrentUserHasRight('SeeQueue')) { + return (undef); + } - eval "require RT::Queue_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Queue_Overlay.pm}) { - die $@; - }; + return ($self->__Value(@_)); +} - eval "require RT::Queue_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Queue_Vendor.pm}) { - die $@; - }; +# }}} - eval "require RT::Queue_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Queue_Local.pm}) { - die $@; - }; +# {{{ sub CurrentUserHasRight +=head2 CurrentUserHasRight +Takes one argument. A textual string with the name of the right we want to check. +Returns true if the current user has that right for this queue. +Returns undef otherwise. +=cut -=head1 SEE ALSO +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. + return ($self->HasRight( Principal=> $self->CurrentUser, + Right => "$right")); -These overlay files can contain new subs or subs to replace existing subs in this module. +} -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +# }}} - no warnings qw(redefine); +# {{{ sub HasRight -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 HasRight -RT::Queue_Overlay, RT::Queue_Vendor, RT::Queue_Local +Takes a param hash with the fields 'Right' and 'Principal'. +Principal defaults to the current user. +Returns true if the principal has that right for this queue. +Returns undef otherwise. =cut +# TAKES: Right and optional "Principal" which defaults to the current user +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => $self->CurrentUser, + @_); + unless(defined $args{'Principal'}) { + $RT::Logger->debug("Principal undefined in Queue::HasRight"); + + } + return($args{'Principal'}->HasQueueRight(QueueObj => $self, + Right => $args{'Right'})); +} +# }}} + +# }}} 1; diff --git a/rt/lib/RT/Queues.pm b/rt/lib/RT/Queues.pm index 60aec9086..ab58d8d6d 100755 --- a/rt/lib/RT/Queues.pm +++ b/rt/lib/RT/Queues.pm @@ -1,115 +1,123 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Queues.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Queues -- Class Description - + RT::Queues - a collection of RT::Queue objects + =head1 SYNOPSIS - use RT::Queues + use RT::Queues; =head1 DESCRIPTION =head1 METHODS -=cut -package RT::Queues; +=begin testing -use RT::SearchBuilder; -use RT::Queue; +ok (require RT::TestHarness); +ok (require RT::Queues); -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +=end testing +=cut -sub _Init { - my $self = shift; - $self->{'table'} = 'Queues'; - $self->{'primary_key'} = 'id'; +package RT::Queues; +use RT::EasySearch; +@ISA= qw(RT::EasySearch); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Queues"; + $self->{'primary_key'} = "id"; + # By default, order by name + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); - return ( $self->SUPER::_Init(@_) ); + return ($self->SUPER::_Init(@_)); } +# }}} +# {{{ sub _DoSearch -=item NewItem +=head2 _DoSearch -Returns an empty new RT::Queue item + A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless +we're explicitly trying to see them. =cut -sub NewItem { +sub _DoSearch { my $self = shift; - return(RT::Queue->new($self->CurrentUser)); + + #unless we really want to find disabled rows, make sure we\'re only finding enabled ones. + unless($self->{'find_disabled_rows'}) { + $self->LimitToEnabled(); + } + + return($self->SUPER::_DoSearch(@_)); + } - eval "require RT::Queues_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Queues_Overlay.pm}) { - die $@; - }; - - eval "require RT::Queues_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Queues_Vendor.pm}) { - die $@; - }; - - eval "require RT::Queues_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Queues_Local.pm}) { - die $@; - }; +# }}} + +# {{{ sub Limit +sub Limit { + my $self = shift; + my %args = ( ENTRYAGGREGATOR => 'AND', + @_); + $self->SUPER::Limit(%args); +} +# }}} +# {{{ sub NewItem +sub NewItem { + my $self = shift; + my $item; + use RT::Queue; + $item = new RT::Queue($self->CurrentUser); + return($item); +} +# }}} -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); +# {{{ sub Next -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 Next -RT::Queues_Overlay, RT::Queues_Vendor, RT::Queues_Local +Returns the next queue that this user can see. =cut - + +sub Next { + my $self = shift; + + + my $Queue = $self->SUPER::Next(); + if ((defined($Queue)) and (ref($Queue))) { + + if ($Queue->CurrentUserHasRight('SeeQueue')) { + return($Queue); + } + + #If the user doesn't have the right to show this queue + else { + return($self->Next()); + } + } + #if there never was any queue + else { + return(undef); + } + +} +# }}} 1; + diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index 6962221ea..5340f7de4 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -1,26 +1,5 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Record.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + =head1 NAME RT::Record - Base class for RT record objects @@ -41,31 +20,20 @@ ok (require RT::Record); =cut + package RT::Record; +use DBIx::SearchBuilder::Record::Cachable; use RT::Date; use RT::User; -use RT::Base; -use DBIx::SearchBuilder::Record::Cachable; - -use strict; -use vars qw/@ISA/; - -@ISA = qw(RT::Base); - -if ($RT::DontCacheSearchBuilderRecords ) { - push (@ISA, 'DBIx::SearchBuilder::Record'); -} else { - push (@ISA, 'DBIx::SearchBuilder::Record::Cachable'); - -} +@ISA= qw(DBIx::SearchBuilder::Record::Cachable); # {{{ sub _Init -sub _Init { - my $self = shift; - $self->CurrentUser(@_); - +sub _Init { + my $self = shift; + $self->_MyCurrentUser(@_); + } # }}} @@ -80,108 +48,68 @@ The primary keys for RT classes is 'id' sub _PrimaryKeys { my $self = shift; - return ( ['id'] ); + return(['id']); } # }}} -# {{{ sub _Handle -sub _Handle { +# {{{ sub _MyCurrentUser + +sub _MyCurrentUser { my $self = shift; - return ($RT::Handle); + + $self->CurrentUser(@_); + if(!defined($self->CurrentUser)) { + use Carp; + Carp::cluck(); + $RT::Logger->err("$self was created without a CurrentUser\n"); + return(0); + } } # }}} -# {{{ sub Create - -=item Create PARAMHASH - -Takes a PARAMHASH of Column -> Value pairs. -If any Column has a Validate$PARAMNAME subroutine defined and the -value provided doesn't pass validation, this routine returns -an error. - -If this object's table has any of the following atetributes defined as -'Auto', this routine will automatically fill in their values. - -=cut - -sub Create { - my $self = shift; - my %attribs = (@_); - foreach my $key ( keys %attribs ) { - my $method = "Validate$key"; - unless ( $self->$method( $attribs{$key} ) ) { - if (wantarray) { - return ( 0, $self->loc('Invalid value for [_1]', $key) ); - } - else { - return (0); - } - } - } - my $now = RT::Date->new( $self->CurrentUser ); - $now->Set( Format => 'unix', Value => time ); - $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'}); - - if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) { - $attribs{'Creator'} = $self->CurrentUser->id || '0'; - } - $attribs{'LastUpdated'} = $now->ISO() - if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'}); - - $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0' - if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'}); - - my $id = $self->SUPER::Create(%attribs); - if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) { - if ( $id->errno ) { - if (wantarray) { - return ( 0, - $self->loc( "Internal Error: [_1]", $id->{error_message} ) ); - } - else { - return (0); - } - } - } - # If the object was created in the database, - # load it up now, so we're sure we get what the database - # has. Arguably, this should not be necessary, but there - # isn't much we can do about it. - - unless ($id) { - if (wantarray) { - return ( $id, $self->loc('Object could not be created') ); - } - else { - return ($id); - } - - } - - if (UNIVERSAL::isa('errno',$id)) { - exit(0); - warn "It's here!"; - return(undef); - } - - $self->Load($id) if ($id); - +# {{{ sub _Handle +sub _Handle { + my $self = shift; + return($RT::Handle); +} +# }}} +# {{{ sub Create - if (wantarray) { - return ( $id, $self->loc('Object created') ); - } - else { - return ($id); +sub Create { + my $self = shift; + my $now = new RT::Date($self->CurrentUser); + $now->Set(Format=> 'unix', Value => time); + push @_, 'Created', $now->ISO() + if ($self->_Accessible('Created', 'auto')); + + + push @_, 'Creator', $self->{'user'}->id + if $self->_Accessible('Creator', 'auto'); + + push @_, 'LastUpdated', $now->ISO() + if ($self->_Accessible('LastUpdated', 'auto')); + + push @_, 'LastUpdatedBy', $self->{'user'}->id + if $self->_Accessible('LastUpdatedBy', 'auto'); + + + + my $id = $self->SUPER::Create(@_); + + if ($id) { + $self->Load($id); } - + + return($id); + } # }}} + # {{{ sub LoadByCols =head2 LoadByCols @@ -197,33 +125,28 @@ sub LoadByCols { # If this database is case sensitive we need to uncase objects for # explicit loading - if ( $self->_Handle->CaseSensitive ) { - my %newhash; - foreach my $key ( keys %hash ) { - - # If we've been passed an empty value, we can't do the lookup. - # We don't need to explicitly downcase integers or an id. - if ( $key =~ '^id$' - || !defined( $hash{$key} ) - || $hash{$key} =~ /^\d+$/ - ) - { - $newhash{$key} = $hash{$key}; - } - else { - $newhash{ "lower(" . $key . ")" } = lc( $hash{$key} ); - } - } - - # We've clobbered everything we care about. bash the old hash - # and replace it with the new hash - %hash = %newhash; + if ($self->_Handle->CaseSensitive) { + my %newhash; + foreach my $key (keys %hash) { + # If we've been passed an empty value, we can't do the lookup. + # We don't need to explicitly downcase integers or an id. + if ($key =~ '^id$' || $hash{$key} =~/^\d+$/ || !defined ($hash{$key}) ) { + $newhash{$key} = $hash{$key}; + } + else { + $newhash{"lower(".$key.")"} = lc($hash{$key}); + } + } + $self->SUPER::LoadByCols(%newhash); + } + else { + $self->SUPER::LoadByCols(%hash); } - $self->SUPER::LoadByCols(%hash); } # }}} + # {{{ Datehandling # There is room for optimizations in most of those subs: @@ -231,10 +154,10 @@ sub LoadByCols { # {{{ LastUpdatedObj sub LastUpdatedObj { - my $self = shift; - my $obj = new RT::Date( $self->CurrentUser ); - - $obj->Set( Format => 'sql', Value => $self->LastUpdated ); + my $self=shift; + my $obj = new RT::Date($self->CurrentUser); + + $obj->Set(Format => 'sql', Value => $self->LastUpdated); return $obj; } @@ -243,11 +166,12 @@ sub LastUpdatedObj { # {{{ CreatedObj sub CreatedObj { - my $self = shift; - my $obj = new RT::Date( $self->CurrentUser ); - - $obj->Set( Format => 'sql', Value => $self->Created ); + my $self=shift; + my $obj = new RT::Date($self->CurrentUser); + + $obj->Set(Format => 'sql', Value => $self->Created); + return $obj; } @@ -258,10 +182,9 @@ sub CreatedObj { # TODO: This should be deprecated # sub AgeAsString { - my $self = shift; - return ( $self->CreatedObj->AgeAsString() ); + my $self=shift; + return($self->CreatedObj->AgeAsString()); } - # }}} # {{{ LastUpdatedAsString @@ -269,13 +192,12 @@ sub AgeAsString { # TODO this should be deprecated sub LastUpdatedAsString { - my $self = shift; - if ( $self->LastUpdated ) { - return ( $self->LastUpdatedObj->AsString() ); - - } - else { - return "never"; + my $self=shift; + if ($self->LastUpdated) { + return ($self->LastUpdatedObj->AsString()); + + } else { + return "never"; } } @@ -287,9 +209,8 @@ sub LastUpdatedAsString { # sub CreatedAsString { my $self = shift; - return ( $self->CreatedObj->AsString() ); + return ($self->CreatedObj->AsString()); } - # }}} # {{{ LongSinceUpdateAsString @@ -297,47 +218,42 @@ sub CreatedAsString { # TODO This should be deprecated # sub LongSinceUpdateAsString { - my $self = shift; - if ( $self->LastUpdated ) { - - return ( $self->LastUpdatedObj->AgeAsString() ); - - } - else { - return "never"; + my $self=shift; + if ($self->LastUpdated) { + + return ($self->LastUpdatedObj->AgeAsString()); + + } else { + return "never"; } } - # }}} # }}} Datehandling + # {{{ sub _Set -sub _Set { - my $self = shift; +sub _Set { + my $self = shift; - my %args = ( - Field => undef, - Value => undef, - IsSQL => undef, - @_ - ); + my %args = ( Field => undef, + Value => undef, + IsSQL => undef, + @_ ); - #if the user is trying to modify the record - # TODO: document _why_ this code is here - if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) { - $args{'Value'} = 0; - } + #if the user is trying to modify the record + if ((!defined ($args{'Field'})) || (!defined ($args{'Value'}))) { + $args{'Value'} = 0; + } - $self->_SetLastUpdated(); - my ( $val, $msg ) = $self->SUPER::_Set( - Field => $args{'Field'}, - Value => $args{'Value'}, - IsSQL => $args{'IsSQL'} - ); + $self->_SetLastUpdated(); + $self->SUPER::_Set(Field => $args{'Field'}, + Value => $args{'Value'}, + IsSQL => $args{'IsSQL'}); + + } - # }}} # {{{ sub _SetLastUpdated @@ -352,20 +268,16 @@ It takes no options. Arguably, this is a bug sub _SetLastUpdated { my $self = shift; use RT::Date; - my $now = new RT::Date( $self->CurrentUser ); + my $now = new RT::Date($self->CurrentUser); $now->SetToNow(); - if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) { - my ( $msg, $val ) = $self->__Set( - Field => 'LastUpdated', - Value => $now->ISO - ); + if ($self->_Accessible('LastUpdated','auto')) { + my ($msg, $val) = $self->__Set( Field => 'LastUpdated', + Value => $now->ISO); } - if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) { - my ( $msg, $val ) = $self->__Set( - Field => 'LastUpdatedBy', - Value => $self->CurrentUser->id - ); + if ($self->_Accessible('LastUpdatedBy','auto')) { + my ($msg, $val) = $self->__Set( Field => 'LastUpdatedBy', + Value => $self->CurrentUser->id); } } @@ -379,16 +291,15 @@ Returns an RT::User object with the RT account of the creator of this row =cut -sub CreatorObj { - my $self = shift; - unless ( exists $self->{'CreatorObj'} ) { - - $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser ); - $self->{'CreatorObj'}->Load( $self->Creator ); - } - return ( $self->{'CreatorObj'} ); +sub CreatorObj { + my $self = shift; + unless (exists $self->{'CreatorObj'}) { + + $self->{'CreatorObj'} = RT::User->new($self->CurrentUser); + $self->{'CreatorObj'}->Load($self->Creator); + } + return($self->{'CreatorObj'}); } - # }}} # {{{ sub LastUpdatedByObj @@ -400,56 +311,35 @@ sub CreatorObj { =cut sub LastUpdatedByObj { - my $self = shift; - unless ( exists $self->{LastUpdatedByObj} ) { - $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser ); - $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy ); + my $self=shift; + unless (exists $self->{LastUpdatedByObj}) { + $self->{'LastUpdatedByObj'}=RT::User->new($self->CurrentUser); + $self->{'LastUpdatedByObj'}->Load($self->LastUpdatedBy); } return $self->{'LastUpdatedByObj'}; } # }}} +# {{{ sub CurrentUser -require Encode::compat if $] < 5.007001; -require Encode; +=head2 CurrentUser -sub __Value { - my $self = shift; - my $field = shift; - my %args = ( decode_utf8 => 1, - @_ ); +If called with an argument, sets the current user to that user object. +This will affect ACL decisions, etc. +Returns the current user - unless (defined $field && $field) { - $RT::Logger->error("$self __Value called with undef field"); - } - my $value = $self->SUPER::__Value($field); - - return('') if ( !defined($value) || $value eq ''); - - return Encode::decode_utf8($value) || $value if $args{'decode_utf8'}; - return $value; -} +=cut -# Set up defaults for DBIx::SearchBuilder::Record::Cachable +sub CurrentUser { + my $self = shift; -sub _CacheConfig { - { - 'cache_p' => 1, - 'fast_update_p' => 1, - 'cache_for_sec' => 30, + if (@_) { + $self->{'user'} = shift; } + return ($self->{'user'}); } +# }}} -=head2 _DecodeUTF8 - - When passed a string will "decode" it int a proper UTF-8 string - -=cut - -eval "require RT::Record_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm}); -eval "require RT::Record_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm}); 1; diff --git a/rt/lib/RT/Scrip.pm b/rt/lib/RT/Scrip.pm index a69dde04e..aef011ca3 100755 --- a/rt/lib/RT/Scrip.pm +++ b/rt/lib/RT/Scrip.pm @@ -1,500 +1,372 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Scrip.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME -RT::Scrip - + RT::Scrip - an RT Scrip object =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::Scrip; -use RT::Record; -use RT::Queue; -use RT::Template; -use RT::ScripCondition; -use RT::ScripAction; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); - -sub _Init { - my $self = shift; - - $self->Table('Scrips'); - $self->SUPER::_Init(@_); -} - + use RT::Scrip; +=head1 DESCRIPTION +=head1 METHODS -=item Create PARAMHASH +=begin testing -Create takes a hash of values and creates a row in the database: +ok (require RT::TestHarness); +ok (require RT::Scrip); - varchar(255) 'Description'. - int(11) 'ScripCondition'. - int(11) 'ScripAction'. - text 'ConditionRules'. - text 'ActionRules'. - text 'CustomIsApplicableCode'. - text 'CustomPrepareCode'. - text 'CustomCommitCode'. - varchar(32) 'Stage'. - int(11) 'Queue'. - int(11) 'Template'. +=end testing =cut +package RT::Scrip; +use RT::Record; +@ISA= qw(RT::Record); - - -sub Create { +# {{{ sub _Init +sub _Init { my $self = shift; - my %args = ( - Description => '', - ScripCondition => '0', - ScripAction => '0', - ConditionRules => '', - ActionRules => '', - CustomIsApplicableCode => '', - CustomPrepareCode => '', - CustomCommitCode => '', - Stage => '', - Queue => '0', - Template => '0', - - @_); - $self->SUPER::Create( - Description => $args{'Description'}, - ScripCondition => $args{'ScripCondition'}, - ScripAction => $args{'ScripAction'}, - ConditionRules => $args{'ConditionRules'}, - ActionRules => $args{'ActionRules'}, - CustomIsApplicableCode => $args{'CustomIsApplicableCode'}, - CustomPrepareCode => $args{'CustomPrepareCode'}, - CustomCommitCode => $args{'CustomCommitCode'}, - Stage => $args{'Stage'}, - Queue => $args{'Queue'}, - Template => $args{'Template'}, -); - + $self->{'table'} = "Scrips"; + return ($self->SUPER::_Init(@_)); } +# }}} - - -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=item Description - -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) - - - -=item SetDescription VALUE - - -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) - - -=cut - - -=item ScripCondition - -Returns the current value of ScripCondition. -(In the database, ScripCondition is stored as int(11).) - - - -=item SetScripCondition VALUE - - -Set ScripCondition to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ScripCondition will be stored as a int(11).) - - -=cut - - -=item ScripConditionObj - -Returns the ScripCondition Object which has the id returned by ScripCondition - - -=cut - -sub ScripConditionObj { - my $self = shift; - my $ScripCondition = RT::ScripCondition->new($self->CurrentUser); - $ScripCondition->Load($self->__Value('ScripCondition')); - return($ScripCondition); +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( ScripAction => 'read/write', + ScripCondition => 'read/write', + Stage => 'read/write', + Queue => 'read/write', + Template => 'read/write', + ); + return($self->SUPER::_Accessible(@_, %Cols)); } +# }}} -=item ScripAction +# {{{ sub Create -Returns the current value of ScripAction. -(In the database, ScripAction is stored as int(11).) +=head2 Create +Creates a new entry in the Scrips table. Takes a paramhash with the attributes: + Queue A queue id or 0 for a global scrip + Template A template ID or name. + Behavior is undefined if you have multiple items with + the same name + ScripAction A ScripAction id or name + Behavior is undefined if you have multiple items with + the same name + ScripCondition A ScripCondition id or name + Behavior is undefined if you have multiple items with + the same name -=item SetScripAction VALUE - - -Set ScripAction to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ScripAction will be stored as a int(11).) - +Returns (retval, msg); +retval is 0 for failure or scrip id. msg is a textual description of what happened. =cut - -=item ScripActionObj - -Returns the ScripAction Object which has the id returned by ScripAction - - -=cut - -sub ScripActionObj { - my $self = shift; - my $ScripAction = RT::ScripAction->new($self->CurrentUser); - $ScripAction->Load($self->__Value('ScripAction')); - return($ScripAction); +sub Create { + my $self = shift; + my %args = ( Queue => undef, + Template => undef, + ScripAction => undef, + ScripCondition => undef, + Stage => 'TransactionCreate', + @_ + ); + + + if ($args{'Queue'} == 0 ) { + unless ($self->CurrentUser->HasSystemRight('ModifyScrips')) { + return (0, 'Permission Denied'); + } + } + else { + my $QueueObj = new RT::Queue($self->CurrentUser); + $QueueObj->Load($args{'Queue'}); + unless ($QueueObj->id()) { + return (0,'Invalid queue'); + } + unless ($QueueObj->CurrentUserHasRight('ModifyScrips')) { + return (0, 'Permssion Denied'); + } + } + + #TODO +++ validate input + + require RT::ScripAction; + my $action = new RT::ScripAction($self->CurrentUser); + $action->Load($args{'ScripAction'}); + return (0, "Action ".$args{'ScripAction'}." not found") unless $action->Id; + + require RT::Template; + my $template = new RT::Template($self->CurrentUser); + $template->Load($args{'Template'}); + return (0, 'Template not found') unless $template->Id; + + require RT::ScripCondition; + my $condition = new RT::ScripCondition($self->CurrentUser); + $condition->Load($args{'ScripCondition'}); + + unless ($condition->Id) { + return (0, 'Condition not found'); + } + + my $id = $self->SUPER::Create(Queue => $args{'Queue'}, + Template => $template->Id, + ScripCondition => $condition->id, + Stage => $args{'Stage'}, + ScripAction => $action->Id + ); + return ($id, 'Scrip Created'); } -=item ConditionRules +# }}} -Returns the current value of ConditionRules. -(In the database, ConditionRules is stored as text.) +# {{{ sub Delete +=head2 Delete - -=item SetConditionRules VALUE - - -Set ConditionRules to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ConditionRules will be stored as a text.) - +Delete this object =cut +sub Delete { + my $self = shift; + + unless ($self->CurrentUserHasRight('ModifyScrips')) { + return (0, 'Permission Denied'); + } + + return ($self->SUPER::Delete(@_)); +} +# }}} -=item ActionRules - -Returns the current value of ActionRules. -(In the database, ActionRules is stored as text.) - - - -=item SetActionRules VALUE - +# {{{ sub QueueObj -Set ActionRules to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ActionRules will be stored as a text.) +=head2 QueueObj +Retuns an RT::Queue object with this Scrip\'s queue =cut +sub QueueObj { + my $self = shift; + + if (!$self->{'QueueObj'}) { + require RT::Queue; + $self->{'QueueObj'} = RT::Queue->new($self->CurrentUser); + $self->{'QueueObj'}->Load($self->Queue); + } + return ($self->{'QueueObj'}); +} -=item CustomIsApplicableCode - -Returns the current value of CustomIsApplicableCode. -(In the database, CustomIsApplicableCode is stored as text.) - - +# }}} -=item SetCustomIsApplicableCode VALUE +# {{{ sub ActionObj -Set CustomIsApplicableCode to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, CustomIsApplicableCode will be stored as a text.) +=head2 ActionObj +Retuns an RT::Action object with this Scrip\'s Action =cut +sub ActionObj { + my $self = shift; + + unless (defined $self->{'ScripActionObj'}) { + require RT::ScripAction; + + $self->{'ScripActionObj'} = RT::ScripAction->new($self->CurrentUser); + #TODO: why are we loading Actions with templates like this. + # two seperate methods might make more sense + $self->{'ScripActionObj'}->Load($self->ScripAction, $self->Template); + } + return ($self->{'ScripActionObj'}); +} -=item CustomPrepareCode - -Returns the current value of CustomPrepareCode. -(In the database, CustomPrepareCode is stored as text.) - - - -=item SetCustomPrepareCode VALUE +# }}} -Set CustomPrepareCode to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, CustomPrepareCode will be stored as a text.) +# {{{ sub TemplateObj +=head2 TemplateObj +Retuns an RT::Template object with this Scrip\'s Template =cut +sub TemplateObj { + my $self = shift; + + unless (defined $self->{'TemplateObj'}) { + require RT::Template; + $self->{'TemplateObj'} = RT::Template->new($self->CurrentUser); + $self->{'TemplateObj'}->Load($self->Template); + } + return ($self->{'TemplateObj'}); +} -=item CustomCommitCode - -Returns the current value of CustomCommitCode. -(In the database, CustomCommitCode is stored as text.) - - - -=item SetCustomCommitCode VALUE - +# }}} -Set CustomCommitCode to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, CustomCommitCode will be stored as a text.) +# {{{ sub Prepare +=head2 Prepare +Calls the action object's prepare method =cut +sub Prepare { + my $self = shift; + $self->ActionObj->Prepare(@_); +} -=item Stage - -Returns the current value of Stage. -(In the database, Stage is stored as varchar(32).) - - - -=item SetStage VALUE - +# }}} -Set Stage to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Stage will be stored as a varchar(32).) +# {{{ sub Commit +=head2 Commit +Calls the action object's commit method =cut +sub Commit { + my $self = shift; + $self->ActionObj->Commit(@_); +} -=item Queue - -Returns the current value of Queue. -(In the database, Queue is stored as int(11).) - - - -=item SetQueue VALUE - - -Set Queue to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Queue will be stored as a int(11).) - - -=cut - +# }}} -=item QueueObj +# {{{ sub ConditionObj -Returns the Queue Object which has the id returned by Queue +=head2 ConditionObj +Retuns an RT::ScripCondition object with this Scrip's IsApplicable =cut -sub QueueObj { - my $self = shift; - my $Queue = RT::Queue->new($self->CurrentUser); - $Queue->Load($self->__Value('Queue')); - return($Queue); +sub ConditionObj { + my $self = shift; + + unless (defined $self->{'ScripConditionObj'}) { + require RT::ScripCondition; + $self->{'ScripConditionObj'} = RT::ScripCondition->new($self->CurrentUser); + $self->{'ScripConditionObj'}->Load($self->ScripCondition); + } + return ($self->{'ScripConditionObj'}); } -=item Template - -Returns the current value of Template. -(In the database, Template is stored as int(11).) - - - -=item SetTemplate VALUE +# }}} +# {{{ sub IsApplicable -Set Template to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Template will be stored as a int(11).) +=head2 IsApplicable +Calls the Condition object\'s IsApplicable method =cut +sub IsApplicable { + my $self = shift; + return ($self->ConditionObj->IsApplicable(@_)); +} -=item TemplateObj - -Returns the Template Object which has the id returned by Template - - -=cut +# }}} -sub TemplateObj { - my $self = shift; - my $Template = RT::Template->new($self->CurrentUser); - $Template->Load($self->__Value('Template')); - return($Template); +# {{{ sub DESTROY +sub DESTROY { + my $self = shift; + $self->{'ActionObj'} = undef; } +# }}} -=item Creator +# {{{ ACL related methods -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +# {{{ sub _Set +# does an acl check and then passes off the call +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('ModifyScrips')) { + $RT::Logger->debug("CurrentUser can't modify Scrips for ".$self->Queue."\n"); + return (0, 'Permission Denied'); + } + return $self->__Set(@_); +} -=cut +# }}} +# {{{ sub _Value +# does an acl check and then passes off the call +sub _Value { + my $self = shift; + + unless ($self->CurrentUserHasRight('ShowScrips')) { + $RT::Logger->debug("CurrentUser can't modify Scrips for ".$self->__Value('Queue')."\n"); + return (undef); + } + + return $self->__Value(@_); +} +# }}} -=item Created +# {{{ sub CurrentUserHasRight -Returns the current value of Created. -(In the database, Created is stored as datetime.) +=head2 CurrentUserHasRight +Helper menthod for HasRight. Presets Principal to CurrentUser then +calls HasRight. =cut +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Principal => $self->CurrentUser->UserObj, + Right => $right )); + +} -=item LastUpdatedBy - -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) - - -=cut - +# }}} -=item LastUpdated +# {{{ sub HasRight -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +=head2 HasRight +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to Scrips. =cut +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + @_ ); + + if ((defined $self->SUPER::_Value('Queue')) and ($self->SUPER::_Value('Queue') != 0)) { + return ( $args{'Principal'}->HasQueueRight( + Right => $args{'Right'}, + Queue => $self->SUPER::_Value('Queue'), + Principal => $args{'Principal'} + ) + ); + + } + else { + return( $args{'Principal'}->HasSystemRight( $args{'Right'}) ); + } +} +# }}} +# }}} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - ScripCondition => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - ScripAction => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - ConditionRules => - {read => 1, write => 1, type => 'text', default => ''}, - ActionRules => - {read => 1, write => 1, type => 'text', default => ''}, - CustomIsApplicableCode => - {read => 1, write => 1, type => 'text', default => ''}, - CustomPrepareCode => - {read => 1, write => 1, type => 'text', default => ''}, - CustomCommitCode => - {read => 1, write => 1, type => 'text', default => ''}, - Stage => - {read => 1, write => 1, type => 'varchar(32)', default => ''}, - Queue => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Template => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::Scrip_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Scrip_Overlay.pm}) { - die $@; - }; - - eval "require RT::Scrip_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Scrip_Vendor.pm}) { - die $@; - }; - - eval "require RT::Scrip_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Scrip_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::Scrip_Overlay, RT::Scrip_Vendor, RT::Scrip_Local - -=cut +1; -1; diff --git a/rt/lib/RT/ScripAction.pm b/rt/lib/RT/ScripAction.pm index 26824df5d..471ad9191 100755 --- a/rt/lib/RT/ScripAction.pm +++ b/rt/lib/RT/ScripAction.pm @@ -1,279 +1,200 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# Copyright 1999-2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripAction.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME -RT::ScripAction - + RT::ScripAction - RT Action object =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::ScripAction; -use RT::Record; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); + use RT::ScripAction; -sub _Init { - my $self = shift; - - $self->Table('ScripActions'); - $self->SUPER::_Init(@_); -} +=head1 DESCRIPTION +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in other modules. +=begin testing -=item Create PARAMHASH +ok (require RT::TestHarness); +ok (require RT::ScripAction); -Create takes a hash of values and creates a row in the database: +=end testing - varchar(200) 'Name'. - varchar(255) 'Description'. - varchar(60) 'ExecModule'. - varchar(255) 'Argument'. +=head1 METHODS =cut +package RT::ScripAction; +use RT::Record; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ScripActions"; + return ($self->SUPER::_Init(@_)); +} +# }}} - - -sub Create { +# {{{ sub _Accessible +sub _Accessible { my $self = shift; - my %args = ( - Name => '', - Description => '', - ExecModule => '', - Argument => '', - - @_); - $self->SUPER::Create( - Name => $args{'Name'}, - Description => $args{'Description'}, - ExecModule => $args{'ExecModule'}, - Argument => $args{'Argument'}, -); - + my %Cols = ( Name => 'read', + Description => 'read', + ExecModule => 'read', + Argument => 'read', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); + return($self->SUPER::_Accessible(@_, %Cols)); } +# }}} - - -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - +# {{{ sub Create +=head2 Create + + Takes a hash. Creates a new Action entry. + should be better documented. =cut +sub Create { + my $self = shift; + #TODO check these args and do smart things. + return($self->SUPER::Create(@_)); +} +# }}} -=item Name - -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) - - - -=item SetName VALUE - - -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) - - -=cut - - -=item Description - -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) - - - -=item SetDescription VALUE - - -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) - - -=cut - - -=item ExecModule - -Returns the current value of ExecModule. -(In the database, ExecModule is stored as varchar(60).) - - - -=item SetExecModule VALUE - - -Set ExecModule to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ExecModule will be stored as a varchar(60).) - - -=cut - - -=item Argument - -Returns the current value of Argument. -(In the database, Argument is stored as varchar(255).) - - - -=item SetArgument VALUE - - -Set Argument to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Argument will be stored as a varchar(255).) - - -=cut - - -=item Creator - -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) - - -=cut - - -=item Created - -Returns the current value of Created. -(In the database, Created is stored as datetime.) - - -=cut +# {{{ sub Delete +sub Delete { + my $self = shift; + + return (0, "ScripAction->Delete not implemented"); +} +# }}} +# {{{ sub Load +sub Load { + my $self = shift; + my $identifier = shift; + + if (!$identifier) { + return (0, 'Input error'); + } + + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol('Name', $identifier); + + } + + if (@_) { + # Set the template Id to the passed in template + my $template = shift; + + $self->{'Template'} = $template; + } + return ($self->Id, 'ScripAction loaded'); +} +# }}} -=item LastUpdatedBy +# {{{ sub LoadAction -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) +=head2 LoadAction HASH + Takes a hash consisting of TicketObj and TransactionObj. Loads an RT::Action:: module. =cut +sub LoadAction { + my $self = shift; + my %args = ( TransactionObj => undef, + TicketObj => undef, + @_ ); + + #TODO: Put this in an eval + $self->ExecModule =~ /^(\w+)$/; + my $module = $1; + my $type = "RT::Action::". $module; + + $RT::Logger->debug("now requiring $type\n"); + eval "require $type" || die "Require of $type failed.\n$@\n"; + + $self->{'Action'} = $type->new ( 'ScripActionObj' => $self, + 'TicketObj' => $args{'TicketObj'}, + 'TransactionObj' => $args{'TransactionObj'}, + 'TemplateObj' => $self->TemplateObj, + 'Argument' => $self->Argument, + ); +} +# }}} -=item LastUpdated +# {{{ sub TemplateObj -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +=head2 TemplateObj +Return this action\'s template object =cut +sub TemplateObj { + my $self = shift; + return undef unless $self->{Template}; + if (!$self->{'TemplateObj'}) { + require RT::Template; + $self->{'TemplateObj'} = RT::Template->new($self->CurrentUser); + $self->{'TemplateObj'}->LoadById($self->{'Template'}); + + } + + return ($self->{'TemplateObj'}); +} +# }}} +# The following methods call the action object -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Name => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - ExecModule => - {read => 1, write => 1, type => 'varchar(60)', default => ''}, - Argument => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::ScripAction_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripAction_Overlay.pm}) { - die $@; - }; - - eval "require RT::ScripAction_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripAction_Vendor.pm}) { - die $@; - }; - - eval "require RT::ScripAction_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripAction_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +# {{{ sub Prepare -These overlay files can contain new subs or subs to replace existing subs in this module. +sub Prepare { + my $self = shift; + return ($self->{'Action'}->Prepare()); + +} +# }}} -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +# {{{ sub Commit +sub Commit { + my $self = shift; + return($self->{'Action'}->Commit()); + + +} +# }}} - no warnings qw(redefine); +# {{{ sub Describe +sub Describe { + my $self = shift; + return ($self->{'Action'}->Describe()); + +} +# }}} -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +# {{{ sub DESTROY +sub DESTROY { + my $self=shift; + $self->{'Action'} = undef; + $self->{'TemplateObj'} = undef; +} +# }}} -RT::ScripAction_Overlay, RT::ScripAction_Vendor, RT::ScripAction_Local -=cut +1; -1; diff --git a/rt/lib/RT/ScripActions.pm b/rt/lib/RT/ScripActions.pm index 614ff374f..ec6141559 100755 --- a/rt/lib/RT/ScripActions.pm +++ b/rt/lib/RT/ScripActions.pm @@ -1,115 +1,70 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripActions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::ScripActions -- Class Description - + RT::ScripActions - Collection of Action objects + =head1 SYNOPSIS - use RT::ScripActions + use RT::ScripActions; + =head1 DESCRIPTION +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ScripActions); + +=end testing + =head1 METHODS =cut package RT::ScripActions; - -use RT::SearchBuilder; +use RT::EasySearch; use RT::ScripAction; -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); - +@ISA= qw(RT::EasySearch); -sub _Init { - my $self = shift; - $self->{'table'} = 'ScripActions'; - $self->{'primary_key'} = 'id'; - - - return ( $self->SUPER::_Init(@_) ); +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ScripActions"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); } - - -=item NewItem - -Returns an empty new RT::ScripAction item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ScripAction->new($self->CurrentUser)); +# }}} + +# {{{ sub LimitToType +sub LimitToType { + my $self = shift; + my $type = shift; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Type', + VALUE => "$type") + if defined $type; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Type', + VALUE => "Correspond") + if $type eq "Create"; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Type', + VALUE => 'any'); + } +# }}} - eval "require RT::ScripActions_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripActions_Overlay.pm}) { - die $@; - }; +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::ScripAction->new($self->CurrentUser)); - eval "require RT::ScripActions_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripActions_Vendor.pm}) { - die $@; - }; - - eval "require RT::ScripActions_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripActions_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::ScripActions_Overlay, RT::ScripActions_Vendor, RT::ScripActions_Local - -=cut +} +# }}} 1; + diff --git a/rt/lib/RT/ScripCondition.pm b/rt/lib/RT/ScripCondition.pm index fe0aa2d5a..253502bd4 100755 --- a/rt/lib/RT/ScripCondition.pm +++ b/rt/lib/RT/ScripCondition.pm @@ -1,302 +1,192 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# Copyright 1999-2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripCondition.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME -RT::ScripCondition - + RT::ScripCondition - RT scrip conditional =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut + use RT::ScripCondition; -package RT::ScripCondition; -use RT::Record; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); - -sub _Init { - my $self = shift; - - $self->Table('ScripConditions'); - $self->SUPER::_Init(@_); -} +=head1 DESCRIPTION +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in other modules. +=begin testing -=item Create PARAMHASH +ok (require RT::TestHarness); +ok (require RT::ScripCondition); -Create takes a hash of values and creates a row in the database: +=end testing - varchar(200) 'Name'. - varchar(255) 'Description'. - varchar(60) 'ExecModule'. - varchar(255) 'Argument'. - varchar(60) 'ApplicableTransTypes'. +=head1 METHODS =cut +package RT::ScripCondition; +use RT::Record; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ScripConditions"; + return ($self->SUPER::_Init(@_)); +} +# }}} - - -sub Create { +# {{{ sub _Accessible +sub _Accessible { my $self = shift; - my %args = ( - Name => '', - Description => '', - ExecModule => '', - Argument => '', - ApplicableTransTypes => '', - - @_); - $self->SUPER::Create( - Name => $args{'Name'}, - Description => $args{'Description'}, - ExecModule => $args{'ExecModule'}, - Argument => $args{'Argument'}, - ApplicableTransTypes => $args{'ApplicableTransTypes'}, -); - + my %Cols = ( Name => 'read', + Description => 'read', + ApplicableTransTypes => 'read', + ExecModule => 'read', + Argument => 'read', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); + return($self->SUPER::_Accessible(@_, %Cols)); } +# }}} +# {{{ sub Create - -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=item Name - -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) - - - -=item SetName VALUE - - -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) - +=head2 Create + + Takes a hash. Creates a new Condition entry. + should be better documented. =cut +sub Create { + my $self = shift; + return($self->SUPER::Create(@_)); +} +# }}} -=item Description - -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) - - - -=item SetDescription VALUE - - -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) - - -=cut - - -=item ExecModule - -Returns the current value of ExecModule. -(In the database, ExecModule is stored as varchar(60).) - - - -=item SetExecModule VALUE - - -Set ExecModule to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ExecModule will be stored as a varchar(60).) - - -=cut - - -=item Argument - -Returns the current value of Argument. -(In the database, Argument is stored as varchar(255).) - - - -=item SetArgument VALUE - +# {{{ sub Delete -Set Argument to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Argument will be stored as a varchar(255).) +=head2 Delete +No API available for deleting things just yet. =cut +sub Delete { + my $self = shift; + return(0,'Unimplemented'); +} +# }}} -=item ApplicableTransTypes - -Returns the current value of ApplicableTransTypes. -(In the database, ApplicableTransTypes is stored as varchar(60).) - - - -=item SetApplicableTransTypes VALUE - +# {{{ sub Load -Set ApplicableTransTypes to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ApplicableTransTypes will be stored as a varchar(60).) +=head2 Load IDENTIFIER +Loads a condition takes a name or ScripCondition id. =cut +sub Load { + my $self = shift; + my $identifier = shift; + + unless (defined $identifier) { + return (undef); + } + + if ($identifier !~ /\D/) { + return ($self->SUPER::LoadById($identifier)); + } + else { + return ($self->LoadByCol('Name', $identifier)); + } +} +# }}} -=item Creator +# {{{ sub LoadCondition -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +=head2 LoadCondition HASH +takes a hash which has the following elements: TransactionObj and TicketObj. +Loads the Condition module in question. =cut -=item Created - -Returns the current value of Created. -(In the database, Created is stored as datetime.) - +sub LoadCondition { + my $self = shift; + my %args = ( TransactionObj => undef, + TicketObj => undef, + @_ ); + + #TODO: Put this in an eval + $self->ExecModule =~ /^(\w+)$/; + my $module = $1; + my $type = "RT::Condition::". $module; + + $RT::Logger->debug("now requiring $type\n"); + eval "require $type" || die "Require of $type failed.\n$@\n"; + + $self->{'Condition'} = $type->new ( 'ScripConditionObj' => $self, + 'TicketObj' => $args{'TicketObj'}, + 'TransactionObj' => $args{'TransactionObj'}, + 'Argument' => $self->Argument, + 'ApplicableTransTypes' => $self->ApplicableTransTypes, + ); +} +# }}} -=cut +# {{{ The following methods call the Condition object -=item LastUpdatedBy +# {{{ sub Describe -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) +=head2 Describe +Helper method to call the condition module\'s Describe method. =cut +sub Describe { + my $self = shift; + return ($self->{'Condition'}->Describe()); + +} +# }}} -=item LastUpdated +# {{{ sub IsApplicable -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +=head2 IsApplicable +Helper method to call the condition module\'s IsApplicable method. =cut +sub IsApplicable { + my $self = shift; + return ($self->{'Condition'}->IsApplicable()); + +} +# }}} +# }}} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Name => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - ExecModule => - {read => 1, write => 1, type => 'varchar(60)', default => ''}, - Argument => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - ApplicableTransTypes => - {read => 1, write => 1, type => 'varchar(60)', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::ScripCondition_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripCondition_Overlay.pm}) { - die $@; - }; - - eval "require RT::ScripCondition_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripCondition_Vendor.pm}) { - die $@; - }; - - eval "require RT::ScripCondition_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripCondition_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +# {{{ sub DESTROY +sub DESTROY { + my $self=shift; + $self->{'Condition'} = undef; +} +# }}} -RT::ScripCondition_Overlay, RT::ScripCondition_Vendor, RT::ScripCondition_Local -=cut +1; -1; diff --git a/rt/lib/RT/ScripConditions.pm b/rt/lib/RT/ScripConditions.pm index 34f788d9c..236e6718d 100755 --- a/rt/lib/RT/ScripConditions.pm +++ b/rt/lib/RT/ScripConditions.pm @@ -1,115 +1,69 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripConditions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::ScripConditions -- Class Description - -=head1 SYNOPSIS - - use RT::ScripConditions - -=head1 DESCRIPTION - - -=head1 METHODS - -=cut + RT::ScripConditions - Collection of Action objects -package RT::ScripConditions; +=head1 SYNOPSIS -use RT::SearchBuilder; -use RT::ScripCondition; + use RT::ScripConditions; -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +=head1 DESCRIPTION -sub _Init { - my $self = shift; - $self->{'table'} = 'ScripConditions'; - $self->{'primary_key'} = 'id'; - return ( $self->SUPER::_Init(@_) ); -} +=begin testing +ok (require RT::TestHarness); +ok (require RT::ScripConditions); -=item NewItem +=end testing -Returns an empty new RT::ScripCondition item +=head1 METHODS =cut -sub NewItem { - my $self = shift; - return(RT::ScripCondition->new($self->CurrentUser)); +package RT::ScripConditions; +use RT::EasySearch; +use RT::ScripCondition; +@ISA= qw(RT::EasySearch); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ScripConditions"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); } +# }}} + +# {{{ sub LimitToType +sub LimitToType { + my $self = shift; + my $type = shift; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Type', + VALUE => "$type") + if defined $type; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Type', + VALUE => "Correspond") + if $type eq "Create"; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Type', + VALUE => 'any'); + +} +# }}} - eval "require RT::ScripConditions_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripConditions_Overlay.pm}) { - die $@; - }; - - eval "require RT::ScripConditions_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripConditions_Vendor.pm}) { - die $@; - }; - - eval "require RT::ScripConditions_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/ScripConditions_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::ScripConditions_Overlay, RT::ScripConditions_Vendor, RT::ScripConditions_Local - -=cut +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::ScripCondition->new($self->CurrentUser)); +} +# }}} 1; + diff --git a/rt/lib/RT/Scrips.pm b/rt/lib/RT/Scrips.pm index a39443136..90be847d8 100755 --- a/rt/lib/RT/Scrips.pm +++ b/rt/lib/RT/Scrips.pm @@ -1,115 +1,127 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# Copyright 1999-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Scrips.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Scrips -- Class Description - + RT::Scrips - a collection of RT Scrip objects + =head1 SYNOPSIS - use RT::Scrips + use RT::Scrips; =head1 DESCRIPTION =head1 METHODS -=cut -package RT::Scrips; +=begin testing -use RT::SearchBuilder; -use RT::Scrip; +ok (require RT::TestHarness); +ok (require RT::Scrips); -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +=end testing +=cut -sub _Init { - my $self = shift; - $self->{'table'} = 'Scrips'; - $self->{'primary_key'} = 'id'; +package RT::Scrips; +use RT::EasySearch; +use RT::Scrip; +@ISA= qw(RT::EasySearch); - return ( $self->SUPER::_Init(@_) ); +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Scrips"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); } +# }}} +# {{{ sub LimitToQueue -=item NewItem +=head2 LimitToQueue -Returns an empty new RT::Scrip item +Takes a queue id (numerical) as its only argument. Makes sure that +Scopes it pulls out apply to this queue (or another that you've selected with +another call to this method =cut -sub NewItem { - my $self = shift; - return(RT::Scrip->new($self->CurrentUser)); +sub LimitToQueue { + my $self = shift; + my $queue = shift; + + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Queue', + VALUE => "$queue") + if defined $queue; + } +# }}} - eval "require RT::Scrips_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Scrips_Overlay.pm}) { - die $@; - }; +# {{{ sub LimitToGlobal - eval "require RT::Scrips_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Scrips_Vendor.pm}) { - die $@; - }; +=head2 LimitToGlobal - eval "require RT::Scrips_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Scrips_Local.pm}) { - die $@; - }; +Makes sure that +Scopes it pulls out apply to all queues (or another that you've selected with +another call to this method or LimitToQueue +=cut +sub LimitToGlobal { + my $self = shift; + + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Queue', + VALUE => 0); + +} +# }}} -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +# {{{ sub NewItem +sub NewItem { + my $self = shift; + + return(new RT::Scrip($self->CurrentUser)); +} +# }}} - no warnings qw(redefine); +# {{{ sub Next -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 Next -RT::Scrips_Overlay, RT::Scrips_Vendor, RT::Scrips_Local +Returns the next scrip that this user can see. =cut - + +sub Next { + my $self = shift; + + + my $Scrip = $self->SUPER::Next(); + if ((defined($Scrip)) and (ref($Scrip))) { + + if ($Scrip->CurrentUserHasRight('ShowScrips')) { + return($Scrip); + } + + #If the user doesn't have the right to show this scrip + else { + return($self->Next()); + } + } + #if there never was any scrip + else { + return(undef); + } + +} +# }}} 1; + diff --git a/rt/lib/RT/Template.pm b/rt/lib/RT/Template.pm index f73ea3ed6..3ef96c7df 100755 --- a/rt/lib/RT/Template.pm +++ b/rt/lib/RT/Template.pm @@ -1,363 +1,395 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Template.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com> +# Portions Copyright 2000 Tobias Brox <tobix@cpan.org> +# Released under the terms of the GNU General Public License =head1 NAME -RT::Template - + RT::Template - RT's template object =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::Template; -use RT::Record; -use RT::Queue; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); - -sub _Init { - my $self = shift; - - $self->Table('Templates'); - $self->SUPER::_Init(@_); -} + use RT::Template; +=head1 DESCRIPTION +=head1 METHODS -=item Create PARAMHASH +=begin testing -Create takes a hash of values and creates a row in the database: +ok(require RT::TestHarness); +ok(require RT::Template); - int(11) 'Queue'. - varchar(200) 'Name'. - varchar(255) 'Description'. - varchar(16) 'Type'. - varchar(16) 'Language'. - int(11) 'TranslationOf'. - blob 'Content'. +=end testing =cut +package RT::Template; +use RT::Record; +use MIME::Entity; +use MIME::Parser; +@ISA = qw(RT::Record); +# {{{ sub _Init -sub Create { +sub _Init { my $self = shift; - my %args = ( - Queue => '0', - Name => '', - Description => '', - Type => '', - Language => '', - TranslationOf => '0', - Content => '', - - @_); - $self->SUPER::Create( - Queue => $args{'Queue'}, - Name => $args{'Name'}, - Description => $args{'Description'}, - Type => $args{'Type'}, - Language => $args{'Language'}, - TranslationOf => $args{'TranslationOf'}, - Content => $args{'Content'}, -); - + $self->{'table'} = "Templates"; + return ( $self->SUPER::_Init(@_) ); } +# }}} +# {{{ sub _Accessible -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut +sub _Accessible { + my $self = shift; + my %Cols = ( + id => 'read', + Name => 'read/write', + Description => 'read/write', + Type => 'read/write', #Type is one of Action or Message + Content => 'read/write', + Queue => 'read/write', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); + return $self->SUPER::_Accessible( @_, %Cols ); +} +# }}} -=item Queue +# {{{ sub _Set -Returns the current value of Queue. -(In the database, Queue is stored as int(11).) +sub _Set { + my $self = shift; + # use super::value or we get acl blocked + if ( ( defined $self->SUPER::_Value('Queue') ) + && ( $self->SUPER::_Value('Queue') == 0 ) ) + { + unless ( $self->CurrentUser->HasSystemRight('ModifyTemplate') ) { + return ( 0, 'Permission Denied' ); + } + } + else { + + unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) { + return ( 0, 'Permission Denied' ); + } + } + return ( $self->SUPER::_Set(@_) ); +} -=item SetQueue VALUE +# }}} +# {{{ sub _Value -Set Queue to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Queue will be stored as a int(11).) +=head2 _Value +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check =cut +sub _Value { -=item QueueObj - -Returns the Queue Object which has the id returned by Queue + my $self = shift; + my $field = shift; + #If the current user doesn't have ACLs, don't let em at it. + #use super::value or we get acl blocked + if ( ( !defined $self->__Value('Queue') ) + || ( $self->__Value('Queue') == 0 ) ) + { + unless ( $self->CurrentUser->HasSystemRight('ShowTemplate') ) { + return (undef); + } + } + else { + unless ( $self->CurrentUserHasQueueRight('ShowTemplate') ) { + return (undef); + } + } + return ( $self->__Value($field) ); -=cut - -sub QueueObj { - my $self = shift; - my $Queue = RT::Queue->new($self->CurrentUser); - $Queue->Load($self->__Value('Queue')); - return($Queue); } -=item Name - -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) - - +# }}} -=item SetName VALUE +# {{{ sub Load +=head2 Load <identifer> -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) - +Load a template, either by number or by name =cut +sub Load { + my $self = shift; + my $identifier = shift; -=item Description - -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) + if ( !$identifier ) { + return (undef); + } + if ( $identifier !~ /\D/ ) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol( 'Name', $identifier ); + } +} -=item SetDescription VALUE +# }}} +# {{{ sub LoadGlobalTemplate -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) +=head2 LoadGlobalTemplate NAME +Load the global tempalte with the name NAME =cut +sub LoadGlobalTemplate { + my $self = shift; + my $id = shift; -=item Type - -Returns the current value of Type. -(In the database, Type is stored as varchar(16).) - - + return ( $self->LoadQueueTemplate( Queue => 0, Name => $id ) ); +} -=item SetType VALUE +# }}} +# {{{ sub LoadQueueTemplate -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(16).) +=head2 LoadQueueTemplate (Queue => QUEUEID, Name => NAME) +Loads the Queue template named NAME for Queue QUEUE. =cut +sub LoadQueueTemplate { + my $self = shift; + my %args = ( + Queue => undef, + Name => undef + ); -=item Language + return ( $self->LoadByCols( Name => $args{'Name'}, Queue => {'Queue'} ) ); -Returns the current value of Language. -(In the database, Language is stored as varchar(16).) +} +# }}} +# {{{ sub Create -=item SetLanguage VALUE +=head2 Create +Takes a paramhash of Content, Queue, Name and Description. +Name should be a unique string identifying this Template. +Description and Content should be the template's title and content. +Queue should be 0 for a global template and the queue # for a queue-specific +template. -Set Language to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Language will be stored as a varchar(16).) +Returns the Template's id # if the create was successful. Returns undef for +unknown database failure. =cut +sub Create { + my $self = shift; + my %args = ( + Content => undef, + Queue => 0, + Description => '[no description]', + Type => 'Action', #By default, template are 'Action' templates + Name => undef, + @_ + ); + + if ( $args{'Queue'} == 0 ) { + unless ( $self->CurrentUser->HasSystemRight('ModifyTemplate') ) { + return (undef); + } + } + else { + my $QueueObj = new RT::Queue( $self->CurrentUser ); + $QueueObj->Load( $args{'Queue'} ) || return ( 0, 'Invalid queue' ); + + unless ( $QueueObj->CurrentUserHasRight('ModifyTemplate') ) { + return (undef); + } + } + + my $result = $self->SUPER::Create( + Content => $args{'Content'}, + Queue => $args{'Queue'}, + , + Description => $args{'Description'}, + Name => $args{'Name'} + ); + + return ($result); -=item TranslationOf - -Returns the current value of TranslationOf. -(In the database, TranslationOf is stored as int(11).) - - +} -=item SetTranslationOf VALUE +# }}} +# {{{ sub Delete -Set TranslationOf to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TranslationOf will be stored as a int(11).) +=head2 Delete +Delete this template. =cut +sub Delete { + my $self = shift; -=item Content + unless ( $self->CurrentUserHasRight('ModifyTemplate') ) { + return ( 0, 'Permission Denied' ); + } -Returns the current value of Content. -(In the database, Content is stored as blob.) + return ( $self->SUPER::Delete(@_) ); +} +# }}} +# {{{ sub MIMEObj +sub MIMEObj { + my $self = shift; + return ( $self->{'MIMEObj'} ); +} -=item SetContent VALUE +# }}} +# {{{ sub Parse -Set Content to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Content will be stored as a blob.) +=item Parse + This routine performs Text::Template parsing on thte template and then imports the + results into a MIME::Entity so we can really use it + It returns a tuple of (val, message) + If val is 0, the message contains an error message =cut +sub Parse { + my $self = shift; -=item LastUpdated - -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) - + #We're passing in whatever we were passed. it's destined for _ParseContent + my $content = $self->_ParseContent(@_); -=cut + #Lets build our mime Entity + my $parser = MIME::Parser->new(); + + # Do work on the parsed template in memory, rather than on disk + $parser->output_to_core(1); -=item LastUpdatedBy + ### Should we forgive normally-fatal errors? + $parser->ignore_errors(1); + $self->{'MIMEObj'} = eval { $parser->parse_data($content) }; + $error = ( $@ || $parser->last_error ); -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) + if ($error) { + $RT::Logger->error("$error"); + return ( 0, $error ); + } + # Unfold all headers + $self->{'MIMEObj'}->head->unfold(); -=cut + return ( 1, "Template parsed" ); + +} -=item Creator +# }}} -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +# {{{ sub _ParseContent +# Perform Template substitutions on the template -=cut +sub _ParseContent { + my $self = shift; + my %args = ( + Argument => undef, + TicketObj => undef, + TransactionObj => undef, + @_ + ); + + # Might be subject to change + use Text::Template; + + $T::Ticket = $args{'TicketObj'}; + $T::Transaction = $args{'TransactionObj'}; + $T::Argument = $args{'Argument'}; + $T::rtname = $RT::rtname; + + # We need to untaint the content of the template, since we'll be working + # with it + my $content = $self->Content(); + $content =~ s/^(.*)$/$1/; + $template = Text::Template->new( + TYPE => STRING, + SOURCE => $content + ); + + my $retval = $template->fill_in( PACKAGE => T ); + return ($retval); +} +# }}} -=item Created +# {{{ sub QueueObj -Returns the current value of Created. -(In the database, Created is stored as datetime.) +=head2 QueueObj +Takes nothing. returns this ticket's queue object =cut +sub QueueObj { + my $self = shift; + if ( !defined $self->{'queue'} ) { + require RT::Queue; + $self->{'queue'} = RT::Queue->new( $self->CurrentUser ); + + unless ( $self->{'queue'} ) { + $RT::Logger->crit( + "RT::Queue->new(" . $self->CurrentUser . ") returned false" ); + return (undef); + } + my ($result) = $self->{'queue'}->Load( $self->__Value('Queue') ); + + } + return ( $self->{'queue'} ); +} +# }}} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Queue => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Name => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - Type => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - Language => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - TranslationOf => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Content => - {read => 1, write => 1, type => 'blob', default => ''}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::Template_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Template_Overlay.pm}) { - die $@; - }; - - eval "require RT::Template_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Template_Vendor.pm}) { - die $@; - }; - - eval "require RT::Template_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Template_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); +# {{{ sub CurrentUserHasQueueRight -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 CurrentUserHasQueueRight -RT::Template_Overlay, RT::Template_Vendor, RT::Template_Local +Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args. =cut +sub CurrentUserHasQueueRight { + my $self = shift; + return ( $self->QueueObj->CurrentUserHasRight(@_) ); +} +# }}} 1; diff --git a/rt/lib/RT/Templates.pm b/rt/lib/RT/Templates.pm index 37db84086..b5b483c96 100755 --- a/rt/lib/RT/Templates.pm +++ b/rt/lib/RT/Templates.pm @@ -1,115 +1,122 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Templates.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Templates -- Class Description - + RT::Templates - a collection of RT Template objects + =head1 SYNOPSIS - use RT::Templates + use RT::Templates; =head1 DESCRIPTION =head1 METHODS +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Templates); + +=end testing + =cut package RT::Templates; +use RT::EasySearch; +@ISA= qw(RT::EasySearch); -use RT::SearchBuilder; -use RT::Template; -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +# {{{ sub _Init +=head2 _Init -sub _Init { - my $self = shift; - $self->{'table'} = 'Templates'; - $self->{'primary_key'} = 'id'; + Returns RT::Templates specific init info like table and primary key names +=cut - return ( $self->SUPER::_Init(@_) ); +sub _Init { + + my $self = shift; + $self->{'table'} = "Templates"; + $self->{'primary_key'} = "id"; + return ($self->SUPER::_Init(@_)); } +# }}} +# {{{ LimitToNotInQueue -=item NewItem +=head2 LimitToNotInQueue -Returns an empty new RT::Template item +Takes a queue id # and limits the returned set of templates to those which +aren't that queue's templates. =cut -sub NewItem { +sub LimitToNotInQueue { my $self = shift; - return(RT::Template->new($self->CurrentUser)); + my $queue_id = shift; + $self->Limit(FIELD => 'Queue', + VALUE => "$queue_id", + OPERATOR => '!=' + ); } +# }}} - eval "require RT::Templates_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Templates_Overlay.pm}) { - die $@; - }; +# {{{ LimitToGlobal - eval "require RT::Templates_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Templates_Vendor.pm}) { - die $@; - }; +=head2 LimitToGlobal - eval "require RT::Templates_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Templates_Local.pm}) { - die $@; - }; +Takes no arguments. Limits the returned set to "Global" templates +which can be used with any queue. +=cut +sub LimitToGlobal { + my $self = shift; + my $queue_id = shift; + $self->Limit(FIELD => 'Queue', + VALUE => "0", + OPERATOR => '=' + ); +} +# }}} +# {{{ LimitToQueue -=head1 SEE ALSO +=head2 LimitToQueue -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +Takes a queue id # and limits the returned set of templates to that queue's +templates -These overlay files can contain new subs or subs to replace existing subs in this module. +=cut -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +sub LimitToQueue { + my $self = shift; + my $queue_id = shift; + $self->Limit(FIELD => 'Queue', + VALUE => "$queue_id", + OPERATOR => '=' + ); +} +# }}} - no warnings qw(redefine); +# {{{ sub NewItem -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 NewItem -RT::Templates_Overlay, RT::Templates_Vendor, RT::Templates_Local +Returns a new empty Template object =cut +sub NewItem { + my $self = shift; + + use RT::Template; + my $item = new RT::Template($self->CurrentUser); + return($item); +} +# }}} 1; + diff --git a/rt/lib/RT/TestHarness.pm b/rt/lib/RT/TestHarness.pm new file mode 100644 index 000000000..160e9e636 --- /dev/null +++ b/rt/lib/RT/TestHarness.pm @@ -0,0 +1,14 @@ +use lib "/opt/rt2/etc/"; + +use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect + GetCurrentUser GetMessageContent); + +#Clean out all the nasties from the environment +CleanEnv(); + +#Load etc/config.pm and drop privs +LoadConfig(); + + +use RT; +RT::Init; diff --git a/rt/lib/RT/Ticket.pm b/rt/lib/RT/Ticket.pm index 2f075a20c..f7275e4e3 100755 --- a/rt/lib/RT/Ticket.pm +++ b/rt/lib/RT/Ticket.pm @@ -1,662 +1,3004 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Ticket.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2001 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL # -use strict; - - =head1 NAME -RT::Ticket - + RT::Ticket - RT ticket object =head1 SYNOPSIS + use RT::Ticket; + my $ticket = new RT::Ticket($CurrentUser); + $ticket->Load($ticket_id); + =head1 DESCRIPTION +This module lets you manipulate RT\'s ticket object. + + =head1 METHODS =cut + + package RT::Ticket; -use RT::Record; use RT::Queue; +use RT::User; +use RT::Record; +use RT::Link; +use RT::Links; +use RT::Date; +use RT::Watcher; -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +@ISA= qw(RT::Record); -sub _Init { - my $self = shift; - $self->Table('Tickets'); - $self->SUPER::_Init(@_); +=begin testing + +use RT::TestHarness; + +ok(require RT::Ticket, "Loading the RT::Ticket library"); + +=end testing + +=cut + +# {{{ sub _Init + +sub _Init { + my $self = shift; + $self->{'table'} = "Tickets"; + return ($self->SUPER::_Init(@_)); } +# }}} +# {{{ sub Load +=head2 Load +Takes a single argument. This can be a ticket id, ticket alias or +local ticket uri. If the ticket can't be loaded, returns undef. +Otherwise, returns the ticket id. -=item Create PARAMHASH +=cut + +sub Load { + my $self = shift; + my $id = shift; + + #TODO modify this routine to look at EffectiveId and do the recursive load + # thing. be careful to cache all the interim tickets we try so we don't loop forever. + + #If it's a local URI, turn it into a ticket id + if ($id =~ /^$RT::TicketBaseURI(\d+)$/) { + $id = $1; + } + #If it's a remote URI, we're going to punt for now + elsif ($id =~ '://' ) { + return (undef); + } + + #If we have an integer URI, load the ticket + if ( $id =~ /^\d+$/ ) { + my $ticketid = $self->LoadById($id); + + unless ($ticketid) { + $RT::Logger->debug("$self tried to load a bogus ticket: $id\n"); + return(undef); + } + } + + #It's not a URI. It's not a numerical ticket ID. Punt! + else { + return(undef); + } + + #If we're merged, resolve the merge. + if (($self->EffectiveId) and + ($self->EffectiveId != $self->Id)) { + return ($self->Load($self->EffectiveId)); + } + + #Ok. we're loaded. lets get outa here. + return ($self->Id); + +} -Create takes a hash of values and creates a row in the database: +# }}} - int(11) 'EffectiveId'. - int(11) 'Queue'. - varchar(16) 'Type'. - int(11) 'IssueStatement'. - int(11) 'Resolution'. - int(11) 'Owner'. - varchar(200) 'Subject' defaults to '[no subject]'. - int(11) 'InitialPriority'. - int(11) 'FinalPriority'. - int(11) 'Priority'. - int(11) 'TimeEstimated'. - int(11) 'TimeWorked'. - varchar(10) 'Status'. - int(11) 'TimeLeft'. - datetime 'Told'. - datetime 'Starts'. - datetime 'Started'. - datetime 'Due'. - datetime 'Resolved'. - smallint(6) 'Disabled'. +# {{{ sub LoadByURI + +=head2 LoadByURI + +Given a local ticket URI, loads the specified ticket. =cut +sub LoadByURI { + my $self = shift; + my $uri = shift; + + if ($uri =~ /^$RT::TicketBaseURI(\d+)$/) { + my $id = $1; + return ($self->Load($id)); + } + else { + return(undef); + } +} + +# }}} + +# {{{ sub Create +=head2 Create (ARGS) +Arguments: ARGS is a hash of named parameters. Valid parameters are: + + Queue - Either a Queue object or a Queue Name + Requestor - A reference to a list of RT::User objects, email addresses or RT user Names + Cc - A reference to a list of RT::User objects, email addresses or Names + AdminCc - A reference to a list of RT::User objects, email addresses or Names + Type -- The ticket\'s type. ignore this for now + Owner -- This ticket\'s owner. either an RT::User object or this user\'s id + Subject -- A string describing the subject of the ticket + InitialPriority -- an integer from 0 to 99 + FinalPriority -- an integer from 0 to 99 + Status -- any valid status (Defined in RT::Queue) + TimeWorked -- an integer + TimeLeft -- an integer + Starts -- an ISO date describing the ticket\'s start date and time in GMT + Due -- an ISO date describing the ticket\'s due date and time in GMT + MIMEObj -- a MIME::Entity object with the content of the initial ticket request. + + KeywordSelect-<id> -- an array of keyword ids for that keyword select + + +Returns: TICKETID, Transaction Object, Error Message + + +=begin testing + +my $t = RT::Ticket->new($RT::SystemUser); + +ok( $t->Create(Queue => 'General', Subject => 'This is a subject'), "Ticket Created"); + +ok ( my $id = $t->Id, "Got ticket id"); + +=end testing + +=cut sub Create { my $self = shift; - my %args = ( - EffectiveId => '0', - Queue => '0', - Type => '', - IssueStatement => '0', - Resolution => '0', - Owner => '0', - Subject => '[no subject]', - InitialPriority => '0', - FinalPriority => '0', - Priority => '0', - TimeEstimated => '0', - TimeWorked => '0', - Status => '', - TimeLeft => '0', - Told => '', - Starts => '', - Started => '', - Due => '', - Resolved => '', - Disabled => '0', + + my %args = ( + Queue => undef, + Requestor => undef, + Cc => undef, + AdminCc => undef, + Type => 'ticket', + Owner => $RT::Nobody->UserObj, + Subject => '[no subject]', + InitialPriority => undef, + FinalPriority => undef, + Status => 'new', + TimeWorked => "0", + TimeLeft => 0, + Due => undef, + Starts => undef, + MIMEObj => undef, + @_); + + my ($ErrStr, $QueueObj, $Owner, $resolved); + my (@non_fatal_errors); + + my $now = RT::Date->new($self->CurrentUser); + $now->SetToNow(); + + if ( (defined($args{'Queue'})) && (!ref($args{'Queue'})) ) { + $QueueObj=RT::Queue->new($RT::SystemUser); + $QueueObj->Load($args{'Queue'}); + } + elsif (ref($args{'Queue'}) eq 'RT::Queue') { + $QueueObj=RT::Queue->new($RT::SystemUser); + $QueueObj->Load($args{'Queue'}->Id); + } + else { + $RT::Logger->debug("$self ". $args{'Queue'} . + " not a recognised queue object."); + } + + #Can't create a ticket without a queue. + unless (defined ($QueueObj)) { + $RT::Logger->debug( "$self No queue given for ticket creation."); + return (0, 0,'Could not create ticket. Queue not set'); + } + + #Now that we have a queue, Check the ACLS + unless ($self->CurrentUser->HasQueueRight(Right => 'CreateTicket', + QueueObj => $QueueObj )) { + return (0,0,"No permission to create tickets in the queue '". + $QueueObj->Name."'."); + } + + #Since we have a queue, we can set queue defaults + #Initial Priority + + # If there's no queue default initial priority and it's not set, set it to 0 + $args{'InitialPriority'} = ($QueueObj->InitialPriority || 0) + unless (defined $args{'InitialPriority'}); + + #Final priority + + # If there's no queue default final priority and it's not set, set it to 0 + $args{'FinalPriority'} = ($QueueObj->FinalPriority || 0) + unless (defined $args{'FinalPriority'}); + + + #TODO we should see what sort of due date we're getting, rather + + # than assuming it's in ISO format. + + #Set the due date. if we didn't get fed one, use the queue default due in + my $due = new RT::Date($self->CurrentUser); + if (defined $args{'Due'}) { + $due->Set (Format => 'ISO', + Value => $args{'Due'}); + } + elsif (defined ($QueueObj->DefaultDueIn)) { + $due->SetToNow; + $due->AddDays($QueueObj->DefaultDueIn); + } + + my $starts = new RT::Date($self->CurrentUser); + if (defined $args{'Starts'}) { + $starts->Set (Format => 'ISO', + Value => $args{'Starts'}); + } + + + # {{{ Deal with setting the owner + + if (ref($args{'Owner'}) eq 'RT::User') { + $Owner = $args{'Owner'}; + } + #If we've been handed something else, try to load the user. + elsif ($args{'Owner'}) { + $Owner = new RT::User($self->CurrentUser); + $Owner->Load($args{'Owner'}); + + } + #If we can't handle it, call it nobody + else { + if (ref($args{'Owner'})) { + $RT::Logger->warning("$ticket ->Create called with an Owner of ". + "type ".ref($args{'Owner'}) .". Defaulting to nobody.\n"); + + push @non_fatal_errors, "Invalid owner. Defaulting to 'nobody'."; + } + else { + $RT::Logger->warning("$self ->Create called with an ". + "unknown datatype for Owner: ".$args{'Owner'} . + ". Defaulting to Nobody.\n"); + } + } + + #If we have a proposed owner and they don't have the right + #to own a ticket, scream about it and make them not the owner + if ((defined ($Owner)) and + ($Owner->Id != $RT::Nobody->Id) and + (!$Owner->HasQueueRight( QueueObj => $QueueObj, + Right => 'OwnTicket'))) { + + $RT::Logger->warning("$self user ".$Owner->Name . "(".$Owner->id . + ") was proposed ". + "as a ticket owner but has no rights to own ". + "tickets in this queue\n"); + + push @non_fatal_errors, "Invalid owner. Defaulting to 'nobody'."; + + $Owner = undef; + } + + #If we haven't been handed a valid owner, make it nobody. + unless (defined ($Owner)) { + $Owner = new RT::User($self->CurrentUser); + $Owner->Load($RT::Nobody->UserObj->Id); + } + + # }}} + + unless ($self->ValidateStatus($args{'Status'})) { + return (0,0,'Invalid value for status'); + } + + if ($args{'Status'} eq 'resolved') { + $resolved = $now->ISO; + } else{ + $resolved = undef; + } + + my $id = $self->SUPER::Create( + Queue => $QueueObj->Id, + Owner => $Owner->Id, + Subject => $args{'Subject'}, + InitialPriority => $args{'InitialPriority'}, + FinalPriority => $args{'FinalPriority'}, + Priority => $args{'InitialPriority'}, + Status => $args{'Status'}, + TimeWorked => $args{'TimeWorked'}, + TimeLeft => $args{'TimeLeft'}, + Type => $args{'Type'}, + Starts => $starts->ISO, + Resolved => $resolved, + Due => $due->ISO + ); + #Set the ticket's effective ID now that we've created it. + my ($val, $msg) = $self->__Set(Field => 'EffectiveId', Value => $id); + + unless ($val) { + $RT::Logger->err("$self ->Create couldn't set EffectiveId: $msg\n"); + } + - @_); - $self->SUPER::Create( - EffectiveId => $args{'EffectiveId'}, - Queue => $args{'Queue'}, - Type => $args{'Type'}, - IssueStatement => $args{'IssueStatement'}, - Resolution => $args{'Resolution'}, - Owner => $args{'Owner'}, - Subject => $args{'Subject'}, - InitialPriority => $args{'InitialPriority'}, - FinalPriority => $args{'FinalPriority'}, - Priority => $args{'Priority'}, - TimeEstimated => $args{'TimeEstimated'}, - TimeWorked => $args{'TimeWorked'}, - Status => $args{'Status'}, - TimeLeft => $args{'TimeLeft'}, - Told => $args{'Told'}, - Starts => $args{'Starts'}, - Started => $args{'Started'}, - Due => $args{'Due'}, - Resolved => $args{'Resolved'}, - Disabled => $args{'Disabled'}, -); + my $watcher; + foreach $watcher (@{$args{'Cc'}}) { + my ($wval, $wmsg) = + $self->_AddWatcher( Type => 'Cc', Person => $watcher, Silent => 1); + push @non_fatal_errors, $wmsg unless ($wval); + } + + foreach $watcher (@{$args{'Requestor'}}) { + my ($wval, $wmsg) = + $self->_AddWatcher( Type => 'Requestor', Person => $watcher, Silent => 1); + push @non_fatal_errors, $wmsg unless ($wval); + } + + foreach $watcher (@{$args{'AdminCc'}}) { + # Note that we're using AddWatcher, rather than _AddWatcher, as we + # actually _want_ that ACL check. Otherwise, random ticket creators + # could make themselves adminccs and maybe get ticket rights. that would + # be poor + my ($wval, $wmsg) = + $self->AddWatcher( Type => 'AdminCc', Person => $watcher, Silent => 1); + push @non_fatal_errors, $wmsg unless ($wval); + } + + # Iterate through all the KeywordSelect-<int> params passed in, calling _AddKeyword + # for each of them + + + foreach my $key (keys %args) { + + next unless ($key =~ /^KeywordSelect-(.*)$/); + + my $ks = $1; + + + my @keywords = ref($args{$key}) eq 'ARRAY' ? + @{$args{$key}} : ($args{$key}); + + foreach my $keyword (@keywords) { + my ($kval, $kmsg) = $self->_AddKeyword(KeywordSelect => $ks, + Keyword => $keyword, + Silent => 1); + } + push @non_fatal_errors, $kmsg unless ($kval); + } + + + + #Add a transaction for the create + my ($Trans, $Msg, $TransObj) = + $self->_NewTransaction( Type => "Create", + TimeTaken => 0, + MIMEObj=>$args{'MIMEObj'}); + + # Logging + if ($self->Id && $Trans) { + $ErrStr = "Ticket ".$self->Id . " created in queue '". $QueueObj->Name. + "'.\n" . join("\n", @non_fatal_errors); + + $RT::Logger->info($ErrStr); + } + else { + # TODO where does this get errstr from? + $RT::Logger->warning("Ticket couldn't be created: $ErrStr"); + } + + return($self->Id, $TransObj->Id, $ErrStr); +} +# }}} + +# {{{ sub Import + +=head2 Import PARAMHASH + +Import a ticket. +Doesn\'t create a transaction. +Doesn\'t supply queue defaults, etc. + +Arguments are identical to Create(), with the addition of + Id - Ticket Id + +Returns: TICKETID + +=cut + + +sub Import { + my $self = shift; + my ( $ErrStr, $QueueObj, $Owner); + + my %args = (id => undef, + EffectiveId => undef, + Queue => undef, + Requestor => undef, + Type => 'ticket', + Owner => $RT::Nobody->Id, + Subject => '[no subject]', + InitialPriority => undef, + FinalPriority => undef, + Status => 'new', + TimeWorked => "0", + Due => undef, + Created => undef, + Updated => undef, + Resolved => undef, + Told => undef, + @_); + + if ( (defined($args{'Queue'})) && (!ref($args{'Queue'})) ) { + $QueueObj=RT::Queue->new($RT::SystemUser); + $QueueObj->Load($args{'Queue'}); + #TODO error check this and return 0 if it\'s not loading properly +++ + } + elsif (ref($args{'Queue'}) eq 'RT::Queue') { + $QueueObj=RT::Queue->new($RT::SystemUser); + $QueueObj->Load($args{'Queue'}->Id); + } + else { + $RT::Logger->debug("$self ". $args{'Queue'} . + " not a recognised queue object."); + } + + #Can't create a ticket without a queue. + unless (defined ($QueueObj) and $QueueObj->Id) { + $RT::Logger->debug( "$self No queue given for ticket creation."); + return (0,'Could not create ticket. Queue not set'); + } + + #Now that we have a queue, Check the ACLS + unless ($self->CurrentUser->HasQueueRight(Right => 'CreateTicket', + QueueObj => $QueueObj )) { + return (0,"No permission to create tickets in the queue '". + $QueueObj->Name."'."); + } + + + + + # {{{ Deal with setting the owner + + # Attempt to take user object, user name or user id. + # Assign to nobody if lookup fails. + if (defined ($args{'Owner'})) { + if ( ref($args{'Owner'}) ) { + $Owner = $args{'Owner'}; + } + else { + $Owner = new RT::User($self->CurrentUser); + $Owner->Load($args{'Owner'}); + if ( ! defined($Owner->id) ) { + $Owner->Load($RT::Nobody->id); + } + } + } + + + #If we have a proposed owner and they don't have the right + #to own a ticket, scream about it and make them not the owner + if ((defined ($Owner)) and + ($Owner->Id != $RT::Nobody->Id) and + (!$Owner->HasQueueRight( QueueObj => $QueueObj, + Right => 'OwnTicket'))) { + + $RT::Logger->warning("$self user ".$Owner->Name . "(".$Owner->id . + ") was proposed ". + "as a ticket owner but has no rights to own ". + "tickets in '".$QueueObj->Name."'\n"); + + $Owner = undef; + } + + #If we haven't been handed a valid owner, make it nobody. + unless (defined ($Owner)) { + $Owner = new RT::User($self->CurrentUser); + $Owner->Load($RT::Nobody->UserObj->Id); + } + + # }}} + + unless ($self->ValidateStatus($args{'Status'})) { + return (0,"'$args{'Status'}' is an invalid value for status"); + } + + $self->{'_AccessibleCache'}{Created} = { 'read'=>1, 'write'=>1 }; + $self->{'_AccessibleCache'}{Creator} = { 'read'=>1, 'auto'=>1 }; + $self->{'_AccessibleCache'}{LastUpdated} = { 'read'=>1, 'write'=>1 }; + $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read'=>1, 'auto'=>1 }; + + + # If we're coming in with an id, set that now. + my $EffectiveId = undef; + if ($args{'id'}) { + $EffectiveId = $args{'id'}; + + } + + + my $id = $self->SUPER::Create( + id => $args{'id'}, + EffectiveId => $EffectiveId, + Queue => $QueueObj->Id, + Owner => $Owner->Id, + Subject => $args{'Subject'}, + InitialPriority => $args{'InitialPriority'}, + FinalPriority => $args{'FinalPriority'}, + Priority => $args{'InitialPriority'}, + Status => $args{'Status'}, + TimeWorked => $args{'TimeWorked'}, + Type => $args{'Type'}, + Created => $args{'Created'}, + Told => $args{'Told'}, + LastUpdated => $args{'Updated'}, + Resolved => $args{Resolved}, + Due => $args{'Due'}, + ); + + + + # If the ticket didn't have an id + # Set the ticket's effective ID now that we've created it. + if ($args{'id'} ) { + $self->Load($args{'id'}); + } + else { + my ($val, $msg) = $self->__Set(Field => 'EffectiveId', Value => $id); + + unless ($val) { + $RT::Logger->err($self."->Import couldn't set EffectiveId: $msg\n"); + } + } + + my $watcher; + foreach $watcher (@{$args{'Cc'}}) { + $self->_AddWatcher( Type => 'Cc', Person => $watcher, Silent => 1); + } + foreach $watcher (@{$args{'AdminCc'}}) { + $self->_AddWatcher( Type => 'AdminCc', Person => $watcher, Silent => 1); + } + foreach $watcher (@{$args{'Requestor'}}) { + $self->_AddWatcher( Type => 'Requestor', Person => $watcher, Silent => 1); + } + + return($self->Id, $ErrStr); } +# }}} +# {{{ sub Delete + +sub Delete { + my $self = shift; + return (0, 'Deleting this object would violate referential integrity.'. + ' That\'s bad.'); +} +# }}} -=item id +# {{{ Routines dealing with watchers. -Returns the current value of id. -(In the database, id is stored as int(11).) +# {{{ Routines dealing with adding new watchers +# {{{ sub AddWatcher + +=head2 AddWatcher + +AddWatcher takes a parameter hash. The keys are as follows: + +Email +Type +Owner + +If the watcher you\'re trying to set has an RT account, set the Owner paremeter to their User Id. Otherwise, set the Email parameter to their Email address. =cut +sub AddWatcher { + my $self = shift; + my %args = ( Email => undef, + Type => undef, + Owner => undef, + @_ + ); + + # {{{ Check ACLS + #If the watcher we're trying to add is for the current user + if ( ( $self->CurrentUser->EmailAddress && + ($args{'Email'} eq $self->CurrentUser->EmailAddress) ) or + ($args{'Owner'} eq $self->CurrentUser->Id) + ) { + + + # If it's an AdminCc and they don't have + # 'WatchAsAdminCc' or 'ModifyTicket', bail + if ($args{'Type'} eq 'AdminCc') { + unless ($self->CurrentUserHasRight('ModifyTicket') or + $self->CurrentUserHasRight('WatchAsAdminCc')) { + return(0, 'Permission Denied'); + } + } + + # If it's a Requestor or Cc and they don't have + # 'Watch' or 'ModifyTicket', bail + elsif (($args{'Type'} eq 'Cc') or + ($args{'Type'} eq 'Requestor')) { + + unless ($self->CurrentUserHasRight('ModifyTicket') or + $self->CurrentUserHasRight('Watch')) { + return(0, 'Permission Denied'); + } + } + else { + $RT::Logger->warn("$self -> AddWatcher hit code". + " it never should. We got passed ". + " a type of ". $args{'Type'}); + return (0,'Error in parameters to TicketAddWatcher'); + } + } + # If the watcher isn't the current user + # and the current user doesn't have 'ModifyTicket' + # bail + else { + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + } + # }}} + + return ($self->_AddWatcher(%args)); +} + -=item EffectiveId +#This contains the meat of AddWatcher. but can be called from a routine like +# Create, which doesn't need the additional acl check +sub _AddWatcher { + my $self = shift; + my %args = ( + Type => undef, + Silent => undef, + Email => undef, + Owner => 0, + Person => undef, + @_ ); + + + + #clear the watchers cache + $self->{'watchers_cache'} = undef; + + if (defined $args{'Person'}) { + #if it's an RT::User object, pull out the id and shove it in Owner + if (ref ($args{'Person'}) =~ /RT::User/) { + $args{'Owner'} = $args{'Person'}->id; + } + #if it's an int, shove it in Owner + elsif ($args{'Person'} =~ /^\d+$/) { + $args{'Owner'} = $args{'Person'}; + } + #if it's an email address, shove it in Email + else { + $args{'Email'} = $args{'Person'}; + } + } + + # Turn an email address int a watcher if we possibly can. + if ($args{'Email'}) { + my $watcher = new RT::User($self->CurrentUser); + $watcher->LoadByEmail($args{'Email'}); + if ($watcher->Id) { + $args{'Owner'} = $watcher->Id; + delete $args{'Email'}; + } + } + + + # see if this user is already a watcher. if we have an owner, check it + # otherwise, we've got an email-address watcher. use that. + + if ($self->IsWatcher(Type => $args{'Type'}, + Id => ($args{'Owner'} || $args{'Email'}) ) ) { + + + return(0, 'That user is already that sort of watcher for this ticket'); + } + + + require RT::Watcher; + my $Watcher = new RT::Watcher ($self->CurrentUser); + my ($retval, $msg) = ($Watcher->Create( Value => $self->Id, + Scope => 'Ticket', + Email => $args{'Email'}, + Type => $args{'Type'}, + Owner => $args{'Owner'}, + )); + + unless ($args{'Silent'}) { + $self->_NewTransaction( Type => 'AddWatcher', + NewValue => $Watcher->Email, + Field => $Watcher->Type); + } + + return ($retval, $msg); +} + +# }}} + +# {{{ sub AddRequestor -Returns the current value of EffectiveId. -(In the database, EffectiveId is stored as int(11).) +=head2 AddRequestor +AddRequestor takes what AddWatcher does, except it presets +the "Type" parameter to \'Requestor\' +=cut + +sub AddRequestor { + my $self = shift; + return ($self->AddWatcher ( Type => 'Requestor', @_)); +} -=item SetEffectiveId VALUE +# }}} +# {{{ sub AddCc -Set EffectiveId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, EffectiveId will be stored as a int(11).) +=head2 AddCc +AddCc takes what AddWatcher does, except it presets +the "Type" parameter to \'Cc\' =cut +sub AddCc { + my $self = shift; + return ($self->AddWatcher ( Type => 'Cc', @_)); +} +# }}} + +# {{{ sub AddAdminCc + +=head2 AddAdminCc -=item Queue +AddAdminCc takes what AddWatcher does, except it presets +the "Type" parameter to \'AdminCc\' -Returns the current value of Queue. -(In the database, Queue is stored as int(11).) +=cut +sub AddAdminCc { + my $self = shift; + return ($self->AddWatcher ( Type => 'AdminCc', @_)); +} +# }}} -=item SetQueue VALUE +# }}} +# {{{ sub DeleteWatcher -Set Queue to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Queue will be stored as a int(11).) +=head2 DeleteWatcher id [type] + +DeleteWatcher takes a single argument which is either an email address +or a watcher id. +If the first argument is an email address, you need to specify the watcher type you're talking +about as the second argument. Valid values are 'Requestor', 'Cc' or 'AdminCc'. +It removes that watcher from this Ticket\'s list of watchers. =cut +#TODO It is lame that you can't call this the same way you can call AddWatcher -=item QueueObj +sub DeleteWatcher { + my $self = shift; + my $id = shift; + + my $type; + + $type = shift if (@_); + + my $Watcher = new RT::Watcher($self->CurrentUser); + + #If it\'s a numeric watcherid + if ($id =~ /^(\d*)$/) { + $Watcher->Load($id); + } + + #Otherwise, we'll assume it's an email address + elsif ($type) { + my ($result, $msg) = + $Watcher->LoadByValue( Email => $id, + Scope => 'Ticket', + Value => $self->id, + Type => $type); + return (0,$msg) unless ($result); + } + + else { + return(0,"Can\'t delete a watcher by email address without specifying a type"); + } + + # {{{ Check ACLS + + #If the watcher we're trying to delete is for the current user + if ($Watcher->Email eq $self->CurrentUser->EmailAddress) { + + # If it's an AdminCc and they don't have + # 'WatchAsAdminCc' or 'ModifyTicket', bail + if ($Watcher->Type eq 'AdminCc') { + unless ($self->CurrentUserHasRight('ModifyTicket') or + $self->CurrentUserHasRight('WatchAsAdminCc')) { + return(0, 'Permission Denied'); + } + } + + # If it's a Requestor or Cc and they don't have + # 'Watch' or 'ModifyTicket', bail + elsif (($Watcher->Type eq 'Cc') or + ($Watcher->Type eq 'Requestor')) { + + unless ($self->CurrentUserHasRight('ModifyTicket') or + $self->CurrentUserHasRight('Watch')) { + return(0, 'Permission Denied'); + } + } + else { + $RT::Logger->warn("$self -> DeleteWatcher hit code". + " it never should. We got passed ". + " a type of ". $args{'Type'}); + return (0,'Error in parameters to $self DeleteWatcher'); + } + } + # If the watcher isn't the current user + # and the current user doesn't have 'ModifyTicket' + # bail + else { + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + } + + # }}} + + unless (($Watcher->Scope eq 'Ticket') and + ($Watcher->Value == $self->id) ) { + return (0, "Not a watcher for this ticket"); + } + + + #Clear out the watchers hash. + $self->{'watchers'} = undef; + + #If we\'ve validated that it is a watcher for this ticket + $self->_NewTransaction ( Type => 'DelWatcher', + OldValue => $Watcher->Email, + Field => $Watcher->Type, + ); + + my $retval = $Watcher->Delete(); + + unless ($retval) { + return(0,"Watcher could not be deleted. Database inconsistency possible."); + } + + return(1, "Watcher deleted"); +} -Returns the Queue Object which has the id returned by Queue +# {{{ sub DeleteRequestor + +=head2 DeleteRequestor EMAIL + +Takes an email address. It calls DeleteWatcher with a preset +type of 'Requestor' =cut -sub QueueObj { - my $self = shift; - my $Queue = RT::Queue->new($self->CurrentUser); - $Queue->Load($self->__Value('Queue')); - return($Queue); +sub DeleteRequestor { + my $self = shift; + my $id = shift; + return ($self->DeleteWatcher ($id, 'Requestor')) } -=item Type +# }}} -Returns the current value of Type. -(In the database, Type is stored as varchar(16).) +# {{{ sub DeleteCc +=head2 DeleteCc EMAIL +Takes an email address. It calls DeleteWatcher with a preset +type of 'Cc' -=item SetType VALUE +=cut + +sub DeleteCc { + my $self = shift; + my $id = shift; + return ($self->DeleteWatcher ($id, 'Cc')) +} -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(16).) +# }}} +# {{{ sub DeleteAdminCc + +=head2 DeleteAdminCc EMAIL + +Takes an email address. It calls DeleteWatcher with a preset +type of 'AdminCc' + + +=cut + +sub DeleteAdminCc { + my $self = shift; + my $id = shift; + return ($self->DeleteWatcher ($id, 'AdminCc')) +} + +# }}} + + +# }}} + +# {{{ sub Watchers + +=head2 Watchers + +Watchers returns a Watchers object preloaded with this ticket\'s watchers. + +# It should return only the ticket watchers. the actual FooAsString +# methods capture the queue watchers too. I don't feel thrilled about this, +# but we don't want the Cc Requestors and AdminCc objects to get filled up +# with all the queue watchers too. we've got seperate objects for that. + # should we rename these as s/(.*)AsString/$1Addresses/ or somesuch? =cut +sub Watchers { + my $self = shift; + + require RT::Watchers; + my $watchers=RT::Watchers->new($self->CurrentUser); + if ($self->CurrentUserHasRight('ShowTicket')) { + $watchers->LimitToTicket($self->id); + } + + return($watchers); + +} -=item IssueStatement +# }}} -Returns the current value of IssueStatement. -(In the database, IssueStatement is stored as int(11).) +# {{{ a set of [foo]AsString subs that will return the various sorts of watchers for a ticket/queue as a comma delineated string +=head2 RequestorsAsString + B<Returns> String: All Ticket Requestor email addresses as a string. -=item SetIssueStatement VALUE +=cut +sub RequestorsAsString { + my $self=shift; -Set IssueStatement to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, IssueStatement will be stored as a int(11).) + unless ($self->CurrentUserHasRight('ShowTicket')) { + return undef; + } + + return ($self->Requestors->EmailsAsString() ); +} +=head2 WatchersAsString + +B<Returns> String: All Ticket Watchers email addresses as a string =cut +sub WatchersAsString { + my $self=shift; -=item Resolution + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (0, "Permission Denied"); + } + + return ($self->Watchers->EmailsAsString()); -Returns the current value of Resolution. -(In the database, Resolution is stored as int(11).) +} +=head2 AdminCcAsString +returns String: All Ticket AdminCc email addresses as a string -=item SetResolution VALUE +=cut -Set Resolution to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Resolution will be stored as a int(11).) +sub AdminCcAsString { + my $self=shift; + unless ($self->CurrentUserHasRight('ShowTicket')) { + return undef; + } + + return ($self->AdminCc->EmailsAsString()); + +} + +=head2 CcAsString + +returns String: All Ticket Ccs as a string of email addresses =cut +sub CcAsString { + my $self=shift; + + unless ($self->CurrentUserHasRight('ShowTicket')) { + return undef; + } + + return ($self->Cc->EmailsAsString()); + +} + +# }}} -=item Owner +# {{{ Routines that return RT::Watchers objects of Requestors, Ccs and AdminCcs -Returns the current value of Owner. -(In the database, Owner is stored as int(11).) +# {{{ sub Requestors +=head2 Requestors +Takes nothing. +Returns this ticket's Requestors as an RT::Watchers object -=item SetOwner VALUE +=cut +sub Requestors { + my $self = shift; + + my $requestors = $self->Watchers(); + if ($self->CurrentUserHasRight('ShowTicket')) { + $requestors->LimitToRequestors(); + } + + return($requestors); + +} -Set Owner to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Owner will be stored as a int(11).) +# }}} +# {{{ sub Cc + +=head2 Cc + +Takes nothing. +Returns a watchers object which contains this ticket's Cc watchers =cut +sub Cc { + my $self = shift; + + my $cc = $self->Watchers(); + + if ($self->CurrentUserHasRight('ShowTicket')) { + $cc->LimitToCc(); + } + + return($cc); + +} + +# }}} -=item Subject +# {{{ sub AdminCc -Returns the current value of Subject. -(In the database, Subject is stored as varchar(200).) +=head2 AdminCc +Takes nothing. +Returns this ticket\'s administrative Ccs as an RT::Watchers object + +=cut + +sub AdminCc { + my $self = shift; + + my $admincc = $self->Watchers(); + if ($self->CurrentUserHasRight('ShowTicket')) { + $admincc->LimitToAdminCc(); + } + return($admincc); +} +# }}} -=item SetSubject VALUE +# }}} +# {{{ IsWatcher,IsRequestor,IsCc, IsAdminCc -Set Subject to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Subject will be stored as a varchar(200).) +# {{{ sub IsWatcher +# a generic routine to be called by IsRequestor, IsCc and IsAdminCc +=head2 IsWatcher + +Takes a param hash with the attributes Type and User. User is either a user object or string containing an email address. Returns true if that user or string +is a ticket watcher. Returns undef otherwise =cut +sub IsWatcher { + my $self = shift; -=item InitialPriority + my %args = ( Type => 'Requestor', + Email => undef, + Id => undef, + @_ + ); + + my %cols = ('Type' => $args{'Type'}, + 'Scope' => 'Ticket', + 'Value' => $self->Id, + 'Owner' => undef, + 'Email' => undef + ); + + if (ref($args{'Id'})){ + #If it's a ref, it's an RT::User object; + $cols{'Owner'} = $args{'Id'}->Id; + } + elsif ($args{'Id'} =~ /^\d+$/) { + # if it's an integer, it's a reference to an RT::User obj + $cols{'Owner'} = $args{'Id'}; + } + else { + $cols{'Email'} = $args{'Id'}; + } + + if ($args{'Email'}) { + $cols{'Email'} = $args{'Email'}; + } + + my $description = join(":",%cols); + + #If we've cached a positive match... + if (defined $self->{'watchers_cache'}->{"$description"}) { + if ($self->{'watchers_cache'}->{"$description"} == 1) { + return(1); + } + else { #If we've cached a negative match... + return(undef); + } + } + + + my $watcher = new RT::Watcher($self->CurrentUser); + $watcher->LoadByCols(%cols); + + + if ($watcher->id) { + $self->{'watchers_cache'}->{"$description"} = 1; + return(1); + } + else { + $self->{'watchers_cache'}->{"$description"} = 0; + return(undef); + } + +} +# }}} -Returns the current value of InitialPriority. -(In the database, InitialPriority is stored as int(11).) +# {{{ sub IsRequestor +=head2 IsRequestor + + Takes an email address, RT::User object or integer (RT user id) + Returns true if the string is a requestor of the current ticket. -=item SetInitialPriority VALUE +=cut +sub IsRequestor { + my $self = shift; + my $person = shift; + + return ($self->IsWatcher(Type => 'Requestor', Id => $person)); + +}; -Set InitialPriority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, InitialPriority will be stored as a int(11).) +# }}} +# {{{ sub IsCc + +=head2 IsCc + +Takes a string. Returns true if the string is a Cc watcher of the current ticket. =cut +sub IsCc { + my $self = shift; + my $cc = shift; + + return ($self->IsWatcher( Type => 'Cc', Id => $cc )); + +} + +# }}} + +# {{{ sub IsAdminCc -=item FinalPriority +=head2 IsAdminCc -Returns the current value of FinalPriority. -(In the database, FinalPriority is stored as int(11).) +Takes a string. Returns true if the string is an AdminCc watcher of the current ticket. +=cut +sub IsAdminCc { + my $self = shift; + my $person = shift; + + return ($self->IsWatcher( Type => 'AdminCc', Id => $person )); + +} -=item SetFinalPriority VALUE +# }}} +# {{{ sub IsOwner -Set FinalPriority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, FinalPriority will be stored as a int(11).) +=head2 IsOwner + Takes an RT::User object. Returns true if that user is this ticket's owner. +returns undef otherwise =cut +sub IsOwner { + my $self = shift; + my $person = shift; + + + # no ACL check since this is used in acl decisions + # unless ($self->CurrentUserHasRight('ShowTicket')) { + # return(undef); + # } + + + #Tickets won't yet have owners when they're being created. + unless ($self->OwnerObj->id) { + return(undef); + } + + if ($person->id == $self->OwnerObj->id) { + return(1); + } + else { + return(undef); + } +} + + +# }}} + +# }}} + +# }}} -=item Priority +# {{{ Routines dealing with queues -Returns the current value of Priority. -(In the database, Priority is stored as int(11).) +# {{{ sub ValidateQueue +sub ValidateQueue { + my $self = shift; + my $Value = shift; + + #TODO I don't think this should be here. We shouldn't allow anything to have an undef queue, + if (!$Value) { + $RT::Logger->warning( " RT:::Queue::ValidateQueue called with a null value. this isn't ok."); + return (1); + } + + my $QueueObj = RT::Queue->new($self->CurrentUser); + my $id = $QueueObj->Load($Value); + + if ($id) { + return (1); + } + else { + return (undef); + } +} + +# }}} +# {{{ sub SetQueue -=item SetPriority VALUE +sub SetQueue { + my $self = shift; + my $NewQueue = shift; + + #Redundant. ACL gets checked in _Set; + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + + my $NewQueueObj = RT::Queue->new($self->CurrentUser); + $NewQueueObj->Load($NewQueue); + + unless ($NewQueueObj->Id()) { + return (0, "That queue does not exist"); + } + + if ($NewQueueObj->Id == $self->QueueObj->Id) { + return (0, 'That is the same value'); + } + unless ($self->CurrentUser->HasQueueRight(Right =>'CreateTicket', + QueueObj => $NewQueueObj )) { + return (0, "You may not create requests in that queue."); + } + + unless ($self->OwnerObj->HasQueueRight(Right=> 'OwnTicket', + QueueObj => $NewQueueObj)) { + $self->Untake(); + } + + return($self->_Set(Field => 'Queue', Value => $NewQueueObj->Id())); + +} +# }}} -Set Priority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Priority will be stored as a int(11).) +# {{{ sub QueueObj +=head2 QueueObj + +Takes nothing. returns this ticket's queue object =cut +sub QueueObj { + my $self = shift; + + my $queue_obj = RT::Queue->new($self->CurrentUser); + #We call __Value so that we can avoid the ACL decision and some deep recursion + my ($result) = $queue_obj->Load($self->__Value('Queue')); + return ($queue_obj); +} + + +# }}} + +# }}} -=item TimeEstimated +# {{{ Date printing routines -Returns the current value of TimeEstimated. -(In the database, TimeEstimated is stored as int(11).) +# {{{ sub DueObj +=head2 DueObj + Returns an RT::Date object containing this ticket's due date -=item SetTimeEstimated VALUE +=cut +sub DueObj { + my $self = shift; + + my $time = new RT::Date($self->CurrentUser); + + # -1 is RT::Date slang for never + if ($self->Due) { + $time->Set(Format => 'sql', Value => $self->Due ); + } + else { + $time->Set(Format => 'unix', Value => -1); + } + + return $time; +} +# }}} +# {{{ sub DueAsString -Set TimeEstimated to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeEstimated will be stored as a int(11).) +=head2 DueAsString +Returns this ticket's due date as a human readable string =cut +sub DueAsString { + my $self = shift; + return $self->DueObj->AsString(); +} + +# }}} + +# {{{ sub GraceTimeAsString -=item TimeWorked +=head2 GraceTimeAsString -Returns the current value of TimeWorked. -(In the database, TimeWorked is stored as int(11).) +Return the time until this ticket is due as a string +=cut + +# TODO This should be deprecated +sub GraceTimeAsString { + my $self=shift; + + if ($self->Due) { + return ($self->DueObj->AgeAsString()); + } else { + return ""; + } +} -=item SetTimeWorked VALUE +# }}} -Set TimeWorked to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeWorked will be stored as a int(11).) +# {{{ sub ResolvedObj +=head2 ResolvedObj + + Returns an RT::Date object of this ticket's 'resolved' time. =cut +sub ResolvedObj { + my $self = shift; -=item Status + my $time = new RT::Date($self->CurrentUser); + $time->Set(Format => 'sql', Value => $self->Resolved); + return $time; +} +# }}} -Returns the current value of Status. -(In the database, Status is stored as varchar(10).) +# {{{ sub SetStarted +=head2 SetStarted +Takes a date in ISO format or undef +Returns a transaction id and a message +The client calls "Start" to note that the project was started on the date in $date. +A null date means "now" -=item SetStatus VALUE +=cut + +sub SetStarted { + my $self = shift; + my $time = shift || 0; + + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + #We create a date object to catch date weirdness + my $time_obj = new RT::Date($self->CurrentUser()); + if ($time != 0) { + $time_obj->Set(Format => 'ISO', Value => $time); + } + else { + $time_obj->SetToNow(); + } + + #Now that we're starting, open this ticket + #TODO do we really want to force this as policy? it should be a scrip + + #We need $TicketAsSystem, in case the current user doesn't have + #ShowTicket + # + my $TicketAsSystem = new RT::Ticket($RT::SystemUser); + $TicketAsSystem->Load($self->Id); + if ($TicketAsSystem->Status eq 'new') { + $TicketAsSystem->Open(); + } + + return ($self->_Set(Field => 'Started', Value =>$time_obj->ISO)); + +} + +# }}} +# {{{ sub StartedObj -Set Status to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Status will be stored as a varchar(10).) +=head2 StartedObj + Returns an RT::Date object which contains this ticket's +'Started' time. =cut -=item TimeLeft +sub StartedObj { + my $self = shift; + + my $time = new RT::Date($self->CurrentUser); + $time->Set(Format => 'sql', Value => $self->Started); + return $time; +} +# }}} + +# {{{ sub StartsObj -Returns the current value of TimeLeft. -(In the database, TimeLeft is stored as int(11).) +=head2 StartsObj + Returns an RT::Date object which contains this ticket's +'Starts' time. +=cut -=item SetTimeLeft VALUE +sub StartsObj { + my $self = shift; + + my $time = new RT::Date($self->CurrentUser); + $time->Set(Format => 'sql', Value => $self->Starts); + return $time; +} +# }}} +# {{{ sub ToldObj -Set TimeLeft to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeLeft will be stored as a int(11).) +=head2 ToldObj + Returns an RT::Date object which contains this ticket's +'Told' time. =cut -=item Told +sub ToldObj { + my $self = shift; + + my $time = new RT::Date($self->CurrentUser); + $time->Set(Format => 'sql', Value => $self->Told); + return $time; +} + +# }}} -Returns the current value of Told. -(In the database, Told is stored as datetime.) +# {{{ sub LongSinceToldAsString +# TODO this should be deprecated -=item SetTold VALUE +sub LongSinceToldAsString { + my $self = shift; + if ($self->Told) { + return $self->ToldObj->AgeAsString(); + } else { + return "Never"; + } +} +# }}} -Set Told to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Told will be stored as a datetime.) +# {{{ sub ToldAsString +=head2 ToldAsString + +A convenience method that returns ToldObj->AsString + +TODO: This should be deprecated =cut -=item Starts +sub ToldAsString { + my $self = shift; + if ($self->Told) { + return $self->ToldObj->AsString(); + } + else { + return("Never"); + } +} +# }}} -Returns the current value of Starts. -(In the database, Starts is stored as datetime.) +# {{{ sub TimeWorkedAsString +=head2 TimeWorkedAsString +Returns the amount of time worked on this ticket as a Text String -=item SetStarts VALUE +=cut + +sub TimeWorkedAsString { + my $self=shift; + return "0" unless $self->TimeWorked; + + #This is not really a date object, but if we diff a number of seconds + #vs the epoch, we'll get a nice description of time worked. + + my $worked = new RT::Date($self->CurrentUser); + #return the #of minutes worked turned into seconds and written as + # a simple text string + + return($worked->DurationAsString($self->TimeWorked*60)); +} +# }}} -Set Starts to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Starts will be stored as a datetime.) +# }}} + +# {{{ Routines dealing with correspondence/comments + +# {{{ sub Comment + +=head2 Comment + +Comment on this ticket. +Takes a hashref with the follwoing attributes: + +MIMEObj, TimeTaken, CcMessageTo, BccMessageTo =cut +sub Comment { + my $self = shift; + + my %args = ( + CcMessageTo => undef, + BccMessageTo => undef, + MIMEObj => undef, + TimeTaken => 0, + @_ ); + + unless (($self->CurrentUserHasRight('CommentOnTicket')) or + ($self->CurrentUserHasRight('ModifyTicket'))) { + return (0, "Permission Denied"); + } + + unless ($args{'MIMEObj'}) { + return(0,"No correspondence attached"); + } + + # If we've been passed in CcMessageTo and BccMessageTo fields, + # add them to the mime object for passing on to the transaction handler + # The "NotifyOtherRecipients" scripAction will look for RT--Send-Cc: and + # RT-Send-Bcc: headers + + $args{'MIMEObj'}->head->add('RT-Send-Cc', $args{'CcMessageTo'}); + $args{'MIMEObj'}->head->add('RT-Send-Bcc', $args{'BccMessageTo'}); + + #Record the correspondence (write the transaction) + my ($Trans, $Msg, $TransObj) = $self->_NewTransaction( Type => 'Comment', + Data =>($args{'MIMEObj'}->head->get('subject') || 'No Subject'), + TimeTaken => $args{'TimeTaken'}, + MIMEObj => $args{'MIMEObj'} + ); + + + return ($Trans, "The comment has been recorded"); +} -=item Started +# }}} -Returns the current value of Started. -(In the database, Started is stored as datetime.) +# {{{ sub Correspond +=head2 Correspond +Correspond on this ticket. +Takes a hashref with the following attributes: -=item SetStarted VALUE +MIMEObj, TimeTaken, CcMessageTo, BccMessageTo -Set Started to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Started will be stored as a datetime.) +=cut + +sub Correspond { + my $self = shift; + my %args = ( + CcMessageTo => undef, + BccMessageTo => undef, + MIMEObj => undef, + TimeTaken => 0, + @_ ); + + unless (($self->CurrentUserHasRight('ReplyToTicket')) or + ($self->CurrentUserHasRight('ModifyTicket'))) { + return (0, "Permission Denied"); + } + + unless ($args{'MIMEObj'}) { + return(0,"No correspondence attached"); + } + + # If we've been passed in CcMessageTo and BccMessageTo fields, + # add them to the mime object for passing on to the transaction handler + # The "NotifyOtherRecipients" scripAction will look for RT-Send-Cc: and RT-Send-Bcc: + # headers + + $args{'MIMEObj'}->head->add('RT-Send-Cc', $args{'CcMessageTo'}); + $args{'MIMEObj'}->head->add('RT-Send-Bcc', $args{'BccMessageTo'}); + + #Record the correspondence (write the transaction) + my ($Trans,$msg, $TransObj) = $self->_NewTransaction + (Type => 'Correspond', + Data => ($args{'MIMEObj'}->head->get('subject') || 'No Subject'), + TimeTaken => $args{'TimeTaken'}, + MIMEObj=> $args{'MIMEObj'} + ); + + # TODO this bit of logic should really become a scrip for 2.2 + my $TicketAsSystem = new RT::Ticket($RT::SystemUser); + $TicketAsSystem->Load($self->Id); + + if ( + ($TicketAsSystem->Status ne 'open') and + ($TicketAsSystem->Status ne 'new') + ) { + + my $oldstatus = $TicketAsSystem->Status(); + $TicketAsSystem->__Set(Field => 'Status', Value => 'open'); + $TicketAsSystem->_NewTransaction + ( Type => 'Set', + Field => 'Status', + OldValue => $oldstatus, + NewValue => 'open', + Data => 'Ticket auto-opened on incoming correspondence' + ); + } + + unless ($Trans) { + $RT::Logger->err("$self couldn't init a transaction ($msg)\n"); + return ($Trans, "correspondence (probably) not sent", $args{'MIMEObj'}); + } + + #Set the last told date to now if this isn't mail from the requestor. + #TODO: Note that this will wrongly ack mail from any non-requestor as a "told" + + unless ($TransObj->IsInbound) { + $self->_SetTold; + } + + return ($Trans, "correspondence sent"); +} + +# }}} + +# }}} + +# {{{ Routines dealing with Links and Relations between tickets +# {{{ Link Collections + +# {{{ sub Members + +=head2 Members + + This returns an RT::Links object which references all the tickets +which are 'MembersOf' this ticket =cut +sub Members { + my $self = shift; + return ($self->_Links('Target', 'MemberOf')); +} + +# }}} + +# {{{ sub MemberOf -=item Due +=head2 MemberOf -Returns the current value of Due. -(In the database, Due is stored as datetime.) + This returns an RT::Links object which references all the tickets that this +ticket is a 'MemberOf' +=cut +sub MemberOf { + my $self = shift; + return ($self->_Links('Base', 'MemberOf')); +} -=item SetDue VALUE +# }}} +# {{{ RefersTo -Set Due to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Due will be stored as a datetime.) +=head2 RefersTo + This returns an RT::Links object which shows all references for which this ticket is a base =cut +sub RefersTo { + my $self = shift; + return ($self->_Links('Base', 'RefersTo')); +} -=item Resolved +# }}} -Returns the current value of Resolved. -(In the database, Resolved is stored as datetime.) +# {{{ ReferredToBy +=head2 ReferredToBy + This returns an RT::Links object which shows all references for which this ticket is a target -=item SetResolved VALUE +=cut +sub ReferredToBy { + my $self = shift; + return ($self->_Links('Target', 'RefersTo')); +} -Set Resolved to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Resolved will be stored as a datetime.) +# }}} +# {{{ DependedOnBy + +=head2 DependedOnBy + + This returns an RT::Links object which references all the tickets that depend on this one =cut +sub DependedOnBy { + my $self = shift; + return ($self->_Links('Target','DependsOn')); +} +# }}} -=item LastUpdatedBy +# {{{ DependsOn -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) +=head2 DependsOn + This returns an RT::Links object which references all the tickets that this ticket depends on =cut +sub DependsOn { + my $self = shift; + return ($self->_Links('Base','DependsOn')); +} +# }}} -=item LastUpdated +# {{{ sub _Links -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +sub _Links { + my $self = shift; + + #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic --- + #tobias meant by $f + my $field = shift; + my $type =shift || ""; + + unless ($self->{"$field$type"}) { + $self->{"$field$type"} = new RT::Links($self->CurrentUser); + if ($self->CurrentUserHasRight('ShowTicket')) { + + $self->{"$field$type"}->Limit(FIELD=>$field, VALUE=>$self->URI); + $self->{"$field$type"}->Limit(FIELD=>'Type', + VALUE=>$type) if ($type); + } + } + return ($self->{"$field$type"}); +} + +# }}} + +# }}} + + +# {{{ sub DeleteLink + +=head2 DeleteLink + +Delete a link. takes a paramhash of Base, Target and Type. +Either Base or Target must be null. The null value will +be replaced with this ticket\'s id + +=cut + +sub DeleteLink { + my $self = shift; + my %args = ( Base => undef, + Target => undef, + Type => undef, + @_ ); + + #check acls + unless ($self->CurrentUserHasRight('ModifyTicket')) { + $RT::Logger->debug("No permission to delete links\n"); + return (0, 'Permission Denied'); + + + } + + #we want one of base and target. we don't care which + #but we only want _one_ + + if ($args{'Base'} and $args{'Target'}) { + $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n"); + return (0, 'Can\'t specifiy both base and target'); + } + elsif ($args{'Base'}) { + $args{'Target'} = $self->Id(); + } + elsif ($args{'Target'}) { + $args{'Base'} = $self->Id(); + } + else { + $RT::Logger->debug("$self: Base or Target must be specified\n"); + return (0, 'Either base or target must be specified'); + } + + my $link = new RT::Link($self->CurrentUser); + $RT::Logger->debug("Trying to load link: ". $args{'Base'}." ". $args{'Type'}. " ". $args{'Target'}. "\n"); + + $link->Load($args{'Base'}, $args{'Type'}, $args{'Target'}); + + + + #it's a real link. + if ($link->id) { + $RT::Logger->debug("We're going to delete link ".$link->id."\n"); + $link->Delete(); + + my $TransString= + "Ticket $args{'Base'} no longer $args{Type} ticket $args{'Target'}."; + my ($Trans, $Msg, $TransObj) = $self->_NewTransaction + (Type => 'DeleteLink', + Field => $args{'Type'}, + Data => $TransString, + TimeTaken => 0 + ); + + return ($linkid, "Link deleted ($TransString)", $transactionid); + } + #if it's not a link we can find + else { + $RT::Logger->debug("Couldn't find that link\n"); + return (0, "Link not found"); + } +} + +# }}} + +# {{{ sub AddLink + +=head2 AddLink + +Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket. =cut +sub AddLink { + my $self = shift; + my %args = ( Target => '', + Base => '', + Type => '', + @_ ); + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + if ($args{'Base'} and $args{'Target'}) { + $RT::Logger->debug("$self tried to delete a link. both base and target were specified\n"); + return (0, 'Can\'t specifiy both base and target'); + } + elsif ($args{'Base'}) { + $args{'Target'} = $self->Id(); + } + elsif ($args{'Target'}) { + $args{'Base'} = $self->Id(); + } + else { + return (0, 'Either base or target must be specified'); + } + + # {{{ We don't want references to ourself + if ($args{Base} eq $args{Target}) { + return (0, "Can\'t link a ticket to itself"); + } + + # }}} + + # If the base isn't a URI, make it a URI. + # If the target isn't a URI, make it a URI. + + # {{{ Check if the link already exists - we don't want duplicates + my $old_link= new RT::Link ($self->CurrentUser); + $old_link->Load($args{'Base'}, $args{'Type'}, $args{'Target'}); + if ($old_link->Id) { + $RT::Logger->debug("$self Somebody tried to duplicate a link"); + return ($old_link->id, "Link already exists",0); + } + # }}} + + # Storing the link in the DB. + my $link = RT::Link->new($self->CurrentUser); + my ($linkid) = $link->Create(Target => $args{Target}, + Base => $args{Base}, + Type => $args{Type}); + + unless ($linkid) { + return (0,"Link could not be created"); + } + #Write the transaction + + my $TransString="Ticket $args{'Base'} $args{Type} ticket $args{'Target'}."; + + my ($Trans, $Msg, $TransObj) = $self->_NewTransaction + (Type => 'AddLink', + Field => $args{'Type'}, + Data => $TransString, + TimeTaken => 0 + ); + + return ($Trans, "Link created ($TransString)"); + + +} +# }}} + +# {{{ sub URI + +=head2 URI + +Returns this ticket's URI + +=cut + +sub URI { + my $self = shift; + return $RT::TicketBaseURI.$self->id; +} + +# }}} -=item Creator +# {{{ sub MergeInto -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +=head2 MergeInto +MergeInto take the id of the ticket to merge this ticket into. +=cut + +sub MergeInto { + my $self = shift; + my $MergeInto = shift; + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + # Load up the new ticket. + my $NewTicket = RT::Ticket->new($RT::SystemUser); + $NewTicket->Load($MergeInto); + + # make sure it exists. + unless (defined $NewTicket->Id) { + return (0, 'New ticket doesn\'t exist'); + } + + + # Make sure the current user can modify the new ticket. + unless ($NewTicket->CurrentUserHasRight('ModifyTicket')) { + $RT::Logger->debug("failed..."); + return (0, "Permission Denied"); + } + + $RT::Logger->debug("checking if the new ticket has the same id and effective id..."); + unless ($NewTicket->id == $NewTicket->EffectiveId) { + $RT::Logger->err('$self trying to merge into '.$NewTicket->Id . + ' which is itself merged.\n'); + return (0, "Can't merge into a merged ticket. ". + "You should never get this error"); + } + + + # We use EffectiveId here even though it duplicates information from + # the links table becasue of the massive performance hit we'd take + # by trying to do a seperate database query for merge info everytime + # loaded a ticket. + + + #update this ticket's effective id to the new ticket's id. + my ($id_val, $id_msg) = $self->__Set(Field => 'EffectiveId', + Value => $NewTicket->Id()); + + unless ($id_val) { + $RT::Logger->error("Couldn't set effective ID for ".$self->Id. + ": $id_msg"); + return(0,"Merge failed. Couldn't set EffectiveId"); + } + + my ($status_val, $status_msg) = $self->__Set(Field => 'Status', + Value => 'resolved'); + + unless ($status_val) { + $RT::Logger->error("$self couldn't set status to resolved.". + "RT's Database may be inconsistent."); + } + + #make a new link: this ticket is merged into that other ticket. + $self->AddLink( Type =>'MergedInto', + Target => $NewTicket->Id() ); + + #add all of this ticket's watchers to that ticket. + my $watchers = $self->Watchers(); + + while (my $watcher = $watchers->Next()) { + unless ( + ($watcher->Owner && + $NewTicket->IsWatcher (Type => $watcher->Type, + Id => $watcher->Owner)) or + ($watcher->Email && + $NewTicket->IsWatcher (Type => $watcher->Type, + Id => $watcher->Email)) + ) { + + + + $NewTicket->_AddWatcher(Silent => 1, + Type => $watcher->Type, + Email => $watcher->Email, + Owner => $watcher->Owner); + } + } + + + #find all of the tickets that were merged into this ticket. + my $old_mergees = new RT::Tickets($self->CurrentUser); + $old_mergees->Limit( FIELD => 'EffectiveId', + OPERATOR => '=', + VALUE => $self->Id ); + + # update their EffectiveId fields to the new ticket's id + while (my $ticket = $old_mergees->Next()) { + my ($val, $msg) = $ticket->__Set(Field => 'EffectiveId', + Value => $NewTicket->Id()); + } + $NewTicket->_SetLastUpdated; + + return ($TransactionObj, "Merge Successful"); +} + +# }}} + +# }}} + +# {{{ Routines dealing with keywords + +# {{{ sub KeywordsObj + +=head2 KeywordsObj [KEYWORD_SELECT_ID] + + Returns an B<RT::ObjectKeywords> object preloaded with this ticket's ObjectKeywords. +If the optional KEYWORD_SELECT_ID parameter is set, limit the keywords object to that keyword +select. =cut +sub KeywordsObj { + my $self = shift; + my $keyword_select; + + $keyword_select = shift if (@_); + + use RT::ObjectKeywords; + my $Keywords = new RT::ObjectKeywords($self->CurrentUser); + + #ACL check + if ($self->CurrentUserHasRight('ShowTicket')) { + $Keywords->LimitToTicket($self->id); + if ($keyword_select) { + $Keywords->LimitToKeywordSelect($keyword_select); + } + } + return ($Keywords); +} +# }}} + +# {{{ sub AddKeyword -=item Created +=head2 AddKeyword -Returns the current value of Created. -(In the database, Created is stored as datetime.) +Takes a paramhash of Keyword and KeywordSelect. If Keyword is a valid choice +for KeywordSelect, creates a KeywordObject. If the KeywordSelect says this should +be a single KeywordObject, automatically removes the old value. + Issues: probably doesn't enforce the depth restrictions or make sure that keywords +are coming from the right part of the tree. really should. =cut +sub AddKeyword { + my $self = shift; + #ACL check + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, 'Permission Denied'); + } + + return($self->_AddKeyword(@_)); + +} + -=item Disabled +# Helper version of AddKeyword without that pesky ACL check +sub _AddKeyword { + my $self = shift; + my %args = ( KeywordSelect => undef, # id of a keyword select record + Keyword => undef, #id of the keyword to add + Silent => 0, + @_ + ); + + my ($OldValue); + + #TODO make sure that $args{'Keyword'} is valid for $args{'KeywordSelect'} + + #TODO: make sure that $args{'KeywordSelect'} applies to this ticket's queue. + + my $Keyword = new RT::Keyword($self->CurrentUser); + unless ($Keyword->Load($args{'Keyword'}) ) { + $RT::Logger->err("$self Couldn't load Keyword ".$args{'Keyword'} ."\n"); + return(0, "Couldn't load keyword"); + } + + my $KeywordSelectObj = new RT::KeywordSelect($self->CurrentUser); + unless ($KeywordSelectObj->Load($args{'KeywordSelect'})) { + $RT::Logger->err("$self Couldn't load KeywordSelect ".$args{'KeywordSelect'}); + return(0, "Couldn't load keywordselect"); + } + + my $Keywords = $self->KeywordsObj($KeywordSelectObj->id); + + #If the ticket already has this keyword, just get out of here. + if ($Keywords->HasEntry($Keyword->id)) { + return(0, "That is already the current value"); + } + + #If the keywordselect wants this to be a singleton: + + if ($KeywordSelectObj->Single) { + + #Whack any old values...keep track of the last value that we get. + #we shouldn't need a loop ehre, but we do it anyway, to try to + # help keep the database clean. + while (my $OldKey = $Keywords->Next) { + $OldValue = $OldKey->KeywordObj->Name; + $OldKey->Delete(); + } + + + } + + # create the new objectkeyword + my $ObjectKeyword = new RT::ObjectKeyword($self->CurrentUser); + my $result = $ObjectKeyword->Create( Keyword => $Keyword->Id, + ObjectType => 'Ticket', + ObjectId => $self->Id, + KeywordSelect => $KeywordSelectObj->Id ); + + + # record a single transaction, unless we were told not to + unless ($args{'Silent'}) { + my ($TransactionId, $Msg, $TransactionObj) = + $self->_NewTransaction( Type => 'Keyword', + Field => $KeywordSelectObj->Id, + OldValue => $OldValue, + NewValue => $Keyword->Name ); + } + return ($TransactionId, "Keyword ".$ObjectKeyword->KeywordObj->Name ." added."); + +} + +# }}} + +# {{{ sub DeleteKeyword + +=head2 DeleteKeyword + + Takes a paramhash. Deletes the Keyword denoted by the I<Keyword> parameter from this + ticket's object keywords. -Returns the current value of Disabled. -(In the database, Disabled is stored as smallint(6).) +=cut + +sub DeleteKeyword { + my $self = shift; + my %args = ( Keyword => undef, + KeywordSelect => undef, + @_ ); + + #ACL check + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, 'Permission Denied'); + } + + + #Load up the ObjectKeyword we\'re talking about + my $ObjectKeyword = new RT::ObjectKeyword($self->CurrentUser); + $ObjectKeyword->LoadByCols(Keyword => $args{'Keyword'}, + KeywordSelect => $args{'KeywordSelect'}, + ObjectType => 'Ticket', + ObjectId => $self->id() + ); + + #if we can\'t find it, bail + unless ($ObjectKeyword->id) { + $RT::Logger->err("Couldn't find the keyword ".$args{'Keyword'} . + " for keywordselect ". $args{'KeywordSelect'} . + "for ticket ".$self->id ); + return (undef, "Couldn't load keyword while trying to delete it."); + }; + + #record transaction here. + my ($TransactionId, $Msg, $TransObj) = + $self->_NewTransaction( Type => 'Keyword', + OldValue => $ObjectKeyword->KeywordObj->Name); + + $ObjectKeyword->Delete(); + + return ($TransactionId, "Keyword ".$ObjectKeyword->KeywordObj->Name ." deleted."); + +} +# }}} +# }}} -=item SetDisabled VALUE +# {{{ Routines dealing with ownership +# {{{ sub OwnerObj -Set Disabled to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Disabled will be stored as a smallint(6).) +=head2 OwnerObj +Takes nothing and returns an RT::User object of +this ticket's owner =cut +sub OwnerObj { + my $self = shift; + + #If this gets ACLed, we lose on a rights check in User.pm and + #get deep recursion. if we need ACLs here, we need + #an equiv without ACLs + + $owner = new RT::User ($self->CurrentUser); + $owner->Load($self->__Value('Owner')); + + #Return the owner object + return ($owner); +} + +# }}} + +# {{{ sub OwnerAsString + +=head2 OwnerAsString + +Returns the owner's email address + +=cut + +sub OwnerAsString { + my $self = shift; + return($self->OwnerObj->EmailAddress); + +} + +# }}} + +# {{{ sub SetOwner +=head2 SetOwner + +Takes two arguments: + the Id or Name of the owner +and (optionally) the type of the SetOwner Transaction. It defaults +to 'Give'. 'Steal' is also a valid option. + +=cut + +sub SetOwner { + my $self = shift; + my $NewOwner = shift; + my $Type = shift || "Give"; + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + my $NewOwnerObj = RT::User->new($self->CurrentUser); + my $OldOwnerObj = $self->OwnerObj; + + $NewOwnerObj->Load($NewOwner); + if (!$NewOwnerObj->Id) { + return (0, "That user does not exist"); + } + + #If thie ticket has an owner and it's not the current user + + if (($Type ne 'Steal' ) and ($Type ne 'Force') and #If we're not stealing + ($self->OwnerObj->Id != $RT::Nobody->Id ) and #and the owner is set + ($self->CurrentUser->Id ne $self->OwnerObj->Id())) { #and it's not us + return(0, "You can only reassign tickets that you own or that are unowned"); + } + + #If we've specified a new owner and that user can't modify the ticket + elsif (($NewOwnerObj->Id) and + (!$NewOwnerObj->HasQueueRight(Right => 'OwnTicket', + QueueObj => $self->QueueObj, + TicketObj => $self)) + ) { + return (0, "That user may not own requests in that queue"); + } + + + #If the ticket has an owner and it's the new owner, we don't need + #To do anything + elsif (($self->OwnerObj) and ($NewOwnerObj->Id eq $self->OwnerObj->Id)) { + return(0, "That user already owns that request"); + } + + + my ($trans,$msg)=$self->_Set(Field => 'Owner', + Value => $NewOwnerObj->Id, + TimeTaken => 0, + TransactionType => $Type); + + if ($trans) { + $msg = "Owner changed from ".$OldOwnerObj->Name." to ".$NewOwnerObj->Name; + } + return ($trans, $msg); + +} + +# }}} + +# {{{ sub Take + +=head2 Take + +A convenince method to set the ticket's owner to the current user + +=cut + +sub Take { + my $self = shift; + return ($self->SetOwner($self->CurrentUser->Id, 'Take')); +} + +# }}} + +# {{{ sub Untake + +=head2 Untake + +Convenience method to set the owner to 'nobody' if the current user is the owner. + +=cut + +sub Untake { + my $self = shift; + return($self->SetOwner($RT::Nobody->UserObj->Id, 'Untake')); +} +# }}} + +# {{{ sub Steal + +=head2 Steal + +A convenience method to change the owner of the current ticket to the +current user. Even if it's owned by another user. + +=cut + +sub Steal { + my $self = shift; + + if ($self->IsOwner($self->CurrentUser)) { + return (0,"You already own this ticket"); + } else { + return($self->SetOwner($self->CurrentUser->Id, 'Steal')); + + } + +} + +# }}} + +# }}} + +# {{{ Routines dealing with status + +# {{{ sub ValidateStatus + +=head2 ValidateStatus STATUS + +Takes a string. Returns true if that status is a valid status for this ticket. +Returns false otherwise. + +=cut + +sub ValidateStatus { + my $self = shift; + my $status = shift; + + #Make sure the status passed in is valid + unless ($self->QueueObj->IsValidStatus($status)) { + return (undef); + } + + return (1); + +} + + +# }}} + +# {{{ sub SetStatus + +=head2 SetStatus STATUS + +Set this ticket\'s status. STATUS can be one of: new, open, stalled, resolved or dead. + +=cut + +sub SetStatus { + my $self = shift; + my $status = shift; + + #Check ACL + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, 'Permission Denied'); + } + + my $now = new RT::Date($self->CurrentUser); + $now->SetToNow(); + + #If we're changing the status from new, record that we've started + if (($self->Status =~ /new/) && ($status ne 'new')) { + #Set the Started time to "now" + $self->_Set(Field => 'Started', + Value => $now->ISO, + RecordTransaction => 0); + } + + + if ($status eq 'resolved') { + #When we resolve a ticket, set the 'Resolved' attribute to now. + $self->_Set(Field => 'Resolved', + Value => $now->ISO, + RecordTransaction => 0); + } + + + #Actually update the status + return($self->_Set(Field => 'Status', + Value => $status, + TimeTaken => 0, + TransactionType => 'Status')); +} + +# }}} + +# {{{ sub Kill + +=head2 Kill + +Takes no arguments. Marks this ticket for garbage collection + +=cut + +sub Kill { + my $self = shift; + return ($self->SetStatus('dead')); + # TODO: garbage collection +} + +# }}} + +# {{{ sub Stall + +=head2 Stall + +Sets this ticket's status to stalled + +=cut + +sub Stall { + my $self = shift; + return ($self->SetStatus('stalled')); +} + +# }}} + +# {{{ sub Open + +=head2 Open + +Sets this ticket\'s status to Open + +=cut + +sub Open { + my $self = shift; + return ($self->SetStatus('open')); +} + +# }}} + +# {{{ sub Resolve + +=head2 Resolve + +Sets this ticket\'s status to Resolved + +=cut + +sub Resolve { + my $self = shift; + return ($self->SetStatus('resolved')); +} + +# }}} + +# }}} + +# {{{ Actions + Routines dealing with transactions + +# {{{ sub SetTold and _SetTold + +=head2 SetTold ISO [TIMETAKEN] + +Updates the told and records a transaction + +=cut + +sub SetTold { + my $self=shift; + my $told; + $told = shift if (@_); + my $timetaken=shift || 0; + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + my $datetold = new RT::Date($self->CurrentUser); + if ($told) { + $datetold->Set( Format => 'iso', + Value => $told); + } + else { + $datetold->SetToNow(); + } + + return($self->_Set(Field => 'Told', + Value => $datetold->ISO, + TimeTaken => $timetaken, + TransactionType => 'Told')); +} + +=head2 _SetTold + +Updates the told without a transaction or acl check. Useful when we're sending replies. + +=cut + +sub _SetTold { + my $self=shift; + + my $now = new RT::Date($self->CurrentUser); + $now->SetToNow(); + #use __Set to get no ACLs ;) + return($self->__Set(Field => 'Told', + Value => $now->ISO)); +} + +# }}} + +# {{{ sub Transactions + +=head2 Transactions + + Returns an RT::Transactions object of all transactions on this ticket + +=cut + +sub Transactions { + my $self = shift; + + use RT::Transactions; + my $transactions = RT::Transactions->new($self->CurrentUser); + + #If the user has no rights, return an empty object + if ($self->CurrentUserHasRight('ShowTicket')) { + my $tickets = $transactions->NewAlias('Tickets'); + $transactions->Join( ALIAS1 => 'main', + FIELD1 => 'Ticket', + ALIAS2 => $tickets, + FIELD2 => 'id'); + $transactions->Limit( ALIAS => $tickets, + FIELD => 'EffectiveId', + VALUE => $self->id()); + # if the user may not see comments do not return them + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + $transactions->Limit( FIELD => 'Type', + OPERATOR => '!=', + VALUE => "Comment"); + } + } + + return($transactions); +} + +# }}} + +# {{{ sub _NewTransaction + +sub _NewTransaction { + my $self = shift; + my %args = ( TimeTaken => 0, + Type => undef, + OldValue => undef, + NewValue => undef, + Data => undef, + Field => undef, + MIMEObj => undef, + @_ ); + + + require RT::Transaction; + my $trans = new RT::Transaction($self->CurrentUser); + my ($transaction, $msg) = + $trans->Create( Ticket => $self->Id, + TimeTaken => $args{'TimeTaken'}, + Type => $args{'Type'}, + Data => $args{'Data'}, + Field => $args{'Field'}, + NewValue => $args{'NewValue'}, + OldValue => $args{'OldValue'}, + MIMEObj => $args{'MIMEObj'} + ); + + $RT::Logger->warning($msg) unless $transaction; + + $self->_SetLastUpdated; + + if (defined $args{'TimeTaken'} ) { + $self->_UpdateTimeTaken($args{'TimeTaken'}); + } + return($transaction, $msg, $trans); +} + +# }}} + +# }}} + +# {{{ PRIVATE UTILITY METHODS. Mostly needed so Ticket can be a DBIx::Record + +# {{{ sub _ClassAccessible sub _ClassAccessible { { - - id => - {read => 1, type => 'int(11)', default => ''}, - EffectiveId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Queue => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Type => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - IssueStatement => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Resolution => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Owner => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Subject => - {read => 1, write => 1, type => 'varchar(200)', default => '[no subject]'}, - InitialPriority => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - FinalPriority => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Priority => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - TimeEstimated => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - TimeWorked => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Status => - {read => 1, write => 1, type => 'varchar(10)', default => ''}, - TimeLeft => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Told => - {read => 1, write => 1, type => 'datetime', default => ''}, - Starts => - {read => 1, write => 1, type => 'datetime', default => ''}, - Started => - {read => 1, write => 1, type => 'datetime', default => ''}, - Due => - {read => 1, write => 1, type => 'datetime', default => ''}, - Resolved => - {read => 1, write => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - Disabled => - {read => 1, write => 1, type => 'smallint(6)', default => '0'}, - - } -}; + EffectiveId => { 'read' => 1, 'write' => 1, 'public' => 1 }, + Queue => { 'read' => 1, 'write' => 1 }, + Requestors => { 'read' => 1, 'write' => 1 }, + Owner => { 'read' => 1, 'write' => 1 }, + Subject => { 'read' => 1, 'write' => 1 }, + InitialPriority => { 'read' => 1, 'write' => 1 }, + FinalPriority => { 'read' => 1, 'write' => 1 }, + Priority => { 'read' => 1, 'write' => 1 }, + Status => { 'read' => 1, 'write' => 1 }, + TimeWorked => { 'read' => 1, 'write' => 1 }, + TimeLeft => { 'read' => 1, 'write' => 1 }, + Created => { 'read' => 1, 'auto' => 1 }, + Creator => { 'read' => 1, 'auto' => 1 }, + Told => { 'read' => 1, 'write' => 1 }, + Resolved => {'read' => 1}, + Starts => { 'read' => 1, 'write' => 1 }, + Started => { 'read' => 1, 'write' => 1 }, + Due => { 'read' => 1, 'write' => 1 }, + Creator => { 'read' => 1, 'auto' => 1 }, + Created => { 'read' => 1, 'auto' => 1 }, + LastUpdatedBy => { 'read' => 1, 'auto' => 1 }, + LastUpdated => { 'read' => 1, 'auto' => 1 } + }; + +} + +# }}} + +# {{{ sub _Set + +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + my %args = (Field => undef, + Value => undef, + TimeTaken => 0, + RecordTransaction => 1, + TransactionType => 'Set', + @_ + ); + #if the user is trying to modify the record + + #Take care of the old value we really don't want to get in an ACL loop. + # so ask the super::_Value + my $Old=$self->SUPER::_Value("$args{'Field'}"); + + #Set the new value + my ($ret, $msg)=$self->SUPER::_Set(Field => $args{'Field'}, + Value=> $args{'Value'}); + + #If we can't actually set the field to the value, don't record + # a transaction. instead, get out of here. + if ($ret==0) {return (0,$msg);} + + if ($args{'RecordTransaction'} == 1) { + + my ($Trans, $Msg, $TransObj) = + $self->_NewTransaction(Type => $args{'TransactionType'}, + Field => $args{'Field'}, + NewValue => $args{'Value'}, + OldValue => $Old, + TimeTaken => $args{'TimeTaken'}, + ); + return ($Trans,$TransObj->Description); + } + else { + return ($ret, $msg); + } +} +# }}} - eval "require RT::Ticket_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Ticket_Overlay.pm}) { - die $@; - }; +# {{{ sub _Value - eval "require RT::Ticket_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Ticket_Vendor.pm}) { - die $@; - }; +=head2 _Value - eval "require RT::Ticket_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Ticket_Local.pm}) { - die $@; - }; +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check +=cut +sub _Value { + + my $self = shift; + my $field = shift; + + + #if the field is public, return it. + if ($self->_Accessible($field, 'public')) { + #$RT::Logger->debug("Skipping ACL check for $field\n"); + return($self->SUPER::_Value($field)); + + } + + #If the current user doesn't have ACLs, don't let em at it. + + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (undef); + } + return($self->SUPER::_Value($field)); + +} +# }}} -=head1 SEE ALSO +# {{{ sub _UpdateTimeTaken + +=head2 _UpdateTimeTaken -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +This routine will increment the timeworked counter. it should +only be called from _NewTransaction -These overlay files can contain new subs or subs to replace existing subs in this module. +=cut + +sub _UpdateTimeTaken { + my $self = shift; + my $Minutes = shift; + my ($Total); + + $Total = $self->SUPER::_Value("TimeWorked"); + $Total = ($Total || 0) + ($Minutes || 0); + $self->SUPER::_Set(Field => "TimeWorked", + Value => $Total); + + return ($Total); +} -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +# }}} - no warnings qw(redefine); +# }}} -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +# {{{ Routines dealing with ACCESS CONTROL -RT::Ticket_Overlay, RT::Ticket_Vendor, RT::Ticket_Local +# {{{ sub CurrentUserHasRight + +=head2 CurrentUserHasRight + + Takes the textual name of a Ticket scoped right (from RT::ACE) and returns +1 if the user has that right. It returns 0 if the user doesn't have that right. =cut +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return ($self->HasRight( Principal=> $self->CurrentUser->UserObj(), + Right => "$right")); + +} + +# }}} + +# {{{ sub HasRight + +=head2 HasRight + + Takes a paramhash with the attributes 'Right' and 'Principal' + 'Right' is a ticket-scoped textual right from RT::ACE + 'Principal' is an RT::User object + + Returns 1 if the principal has the right. Returns undef if not. + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + @_); + + unless ((defined $args{'Principal'}) and (ref($args{'Principal'}))) { + $RT::Logger->warning("Principal attrib undefined for Ticket::HasRight"); + } + + return($args{'Principal'}->HasQueueRight(TicketObj => $self, + Right => $args{'Right'})); +} + +# }}} + +# }}} + 1; + +=head1 AUTHOR + +Jesse Vincent, jesse@fsck.com + +=head1 SEE ALSO + +RT + +=cut + + diff --git a/rt/lib/RT/Tickets.pm b/rt/lib/RT/Tickets.pm index b6b349144..dd91126c4 100755 --- a/rt/lib/RT/Tickets.pm +++ b/rt/lib/RT/Tickets.pm @@ -1,115 +1,1789 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Tickets.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ -use strict; +=head1 NAME + RT::Tickets - A collection of Ticket objects -=head1 NAME - RT::Tickets -- Class Description - =head1 SYNOPSIS - use RT::Tickets + use RT::Tickets; + my $tickets = new RT::Tickets($CurrentUser); =head1 DESCRIPTION + A collection of RT::Tickets. =head1 METHODS +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Tickets); + +=end testing + =cut package RT::Tickets; - -use RT::SearchBuilder; +use RT::EasySearch; use RT::Ticket; +@ISA= qw(RT::EasySearch); + +use vars qw(%TYPES @SORTFIELDS); + +# {{{ TYPES + +%TYPES = ( Status => 'ENUM', + Queue => 'ENUM', + Type => 'ENUM', + Creator => 'ENUM', + LastUpdatedBy => 'ENUM', + Owner => 'ENUM', + EffectiveId => 'INT', + id => 'INT', + InitialPriority => 'INT', + FinalPriority => 'INT', + Priority => 'INT', + TimeLeft => 'INT', + TimeWorked => 'INT', + MemberOf => 'LINK', + DependsOn => 'LINK', + HasMember => 'LINK', + HasDepender => 'LINK', + RelatedTo => 'LINK', + Told => 'DATE', + StartsBy => 'DATE', + Started => 'DATE', + Due => 'DATE', + Resolved => 'DATE', + LastUpdated => 'DATE', + Created => 'DATE', + Subject => 'STRING', + Type => 'STRING', + Content => 'TRANSFIELD', + ContentType => 'TRANSFIELD', + TransactionDate => 'TRANSDATE', + Watcher => 'WATCHERFIELD', + LinkedTo => 'LINKFIELD', + Keyword => 'KEYWORDFIELD' + + ); + + +# }}} + +# {{{ sub SortFields + +@SORTFIELDS = qw(id Status Owner Created Due Starts Started + Queue Subject Told Started + Resolved LastUpdated Priority TimeWorked TimeLeft); + +=head2 SortFields + +Returns the list of fields that lists of tickets can easily be sorted by + +=cut + + +sub SortFields { + my $self = shift; + return(@SORTFIELDS); +} + + +# }}} + +# {{{ Limit the result set based on content + +# {{{ sub Limit + +=head2 Limit + +Takes a paramhash with the fields FIELD, OPERATOR, VALUE and DESCRIPTION +Generally best called from LimitFoo methods + +=cut +sub Limit { + my $self = shift; + my %args = ( FIELD => undef, + OPERATOR => '=', + VALUE => undef, + DESCRIPTION => undef, + @_ + ); + $args{'DESCRIPTION'} = "Autodescribed: ".$args{'FIELD'} . $args{'OPERATOR'} . $args{'VALUE'}, + if (!defined $args{'DESCRIPTION'}) ; + + my $index = $self->_NextIndex; + + #make the TicketRestrictions hash the equivalent of whatever we just passed in; + + %{$self->{'TicketRestrictions'}{$index}} = %args; + + $self->{'RecalcTicketLimits'} = 1; + + # If we're looking at the effective id, we don't want to append the other clause + # which limits us to tickets where id = effective id + if ($args{'FIELD'} eq 'EffectiveId') { + $self->{'looking_at_effective_id'} = 1; + } + + return ($index); +} + +# }}} + + + + +=head2 FreezeLimits + +Returns a frozen string suitable for handing back to ThawLimits. + +=cut +# {{{ sub FreezeLimits + +sub FreezeLimits { + my $self = shift; + require FreezeThaw; + return (FreezeThaw::freeze($self->{'TicketRestrictions'}, + $self->{'restriction_index'} + )); +} + +# }}} + +=head2 ThawLimits + +Take a frozen Limits string generated by FreezeLimits and make this tickets +object have that set of limits. + +=cut +# {{{ sub ThawLimits + +sub ThawLimits { + my $self = shift; + my $in = shift; + + #if we don't have $in, get outta here. + return undef unless ($in); + + $self->{'RecalcTicketLimits'} = 1; + + require FreezeThaw; + + #We don't need to die if the thaw fails. + + eval { + ($self->{'TicketRestrictions'}, + $self->{'restriction_index'} + ) = FreezeThaw::thaw($in); + } + +} + +# }}} + +# {{{ Limit by enum or foreign key + +# {{{ sub LimitQueue + +=head2 LimitQueue + +LimitQueue takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. (It defaults to =). +VALUE is a queue id. + +=cut + +sub LimitQueue { + my $self = shift; + my %args = (VALUE => undef, + OPERATOR => '=', + @_); + + #TODO VALUE should also take queue names and queue objects + my $queue = new RT::Queue($self->CurrentUser); + $queue->Load($args{'VALUE'}); + + #TODO check for a valid queue here + + $self->Limit (FIELD => 'Queue', + VALUE => $queue->id(), + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Queue ' . $args{'OPERATOR'}. " ". $queue->Name + ); + +} +# }}} + +# {{{ sub LimitStatus + +=head2 LimitStatus + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. +VALUE is a status. + +=cut + +sub LimitStatus { + my $self = shift; + my %args = ( OPERATOR => '=', + @_); + $self->Limit (FIELD => 'Status', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Status ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# {{{ sub LimitType + +=head2 LimitType + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=, it defaults to "=". +VALUE is a string to search for in the type of the ticket. + +=cut + +sub LimitType { + my $self = shift; + my %args = (OPERATOR => '=', + VALUE => undef, + @_); + $self->Limit (FIELD => 'Type', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Type ' . $args{'OPERATOR'}. " ". $args{'Limit'}, + ); +} + +# }}} + +# }}} + +# {{{ Limit by string field + +# {{{ sub LimitSubject + +=head2 LimitSubject + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. +VALUE is a string to search for in the subject of the ticket. + +=cut + +sub LimitSubject { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'Subject', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Subject ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# }}} + +# {{{ Limit based on ticket numerical attributes +# Things that can be > < = != + +# {{{ sub LimitId + +=head2 LimitId + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a ticket Id to search for + +=cut + +sub LimitId { + my $self = shift; + my %args = (OPERATOR => '=', + @_); + + $self->Limit (FIELD => 'id', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Id ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# {{{ sub LimitPriority + +=head2 LimitPriority + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket\'s priority against + +=cut + +sub LimitPriority { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'Priority', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Priority ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# {{{ sub LimitInitialPriority + +=head2 LimitInitialPriority + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket\'s initial priority against + + +=cut + +sub LimitInitialPriority { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'InitialPriority', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Initial Priority ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# {{{ sub LimitFinalPriority + +=head2 LimitFinalPriority + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket\'s final priority against + +=cut + +sub LimitFinalPriority { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'FinalPriority', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Final Priority ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# {{{ sub LimitTimeWorked + +=head2 LimitTimeWorked + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's TimeWorked attribute + +=cut + +sub LimitTimeWorked { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'TimeWorked', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Time worked ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# {{{ sub LimitTimeLeft + +=head2 LimitTimeLeft + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, >, < or !=. +VALUE is a value to match the ticket's TimeLeft attribute + +=cut + +sub LimitTimeLeft { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'TimeLeft', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Time left ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} + +# }}} + +# {{{ Limiting based on attachment attributes + +# {{{ sub LimitContent + +=head2 LimitContent + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, LIKE, NOT LIKE or !=. +VALUE is a string to search for in the body of the ticket + +=cut +sub LimitContent { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'Content', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Ticket content ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} + +# }}} +# {{{ sub LimitContentType + +=head2 LimitContentType + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of =, LIKE, NOT LIKE or !=. +VALUE is a content type to search ticket attachments for + +=cut + +sub LimitContentType { + my $self = shift; + my %args = (@_); + $self->Limit (FIELD => 'ContentType', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Ticket content type ' . $args{'OPERATOR'}. " ". $args{'VALUE'}, + ); +} +# }}} + +# }}} + +# {{{ Limiting based on people + +# {{{ sub LimitOwner + +=head2 LimitOwner + +Takes a paramhash with the fields OPERATOR and VALUE. +OPERATOR is one of = or !=. +VALUE is a user id. + +=cut + +sub LimitOwner { + my $self = shift; + my %args = ( OPERATOR => '=', + @_); + + my $owner = new RT::User($self->CurrentUser); + $owner->Load($args{'VALUE'}); + $self->Limit (FIELD => 'Owner', + VALUE => $owner->Id, + OPERATOR => $args{'OPERATOR'}, + DESCRIPTION => 'Owner ' . $args{'OPERATOR'}. " ". $owner->Name() + ); + +} + +# }}} + +# {{{ Limiting watchers + +# {{{ sub LimitWatcher + + +=head2 LimitWatcher + + Takes a paramhash with the fields OPERATOR, TYPE and VALUE. + OPERATOR is one of =, LIKE, NOT LIKE or !=. + VALUE is a value to match the ticket\'s watcher email addresses against + TYPE is the sort of watchers you want to match against. Leave it undef if you want to search all of them + +=cut + +sub LimitWatcher { + my $self = shift; + my %args = ( OPERATOR => '=', + VALUE => undef, + TYPE => undef, + @_); + + + #build us up a description + my ($watcher_type, $desc); + if ($args{'TYPE'}) { + $watcher_type = $args{'TYPE'}; + } + else { + $watcher_type = "Watcher"; + } + $desc = "$watcher_type ".$args{'OPERATOR'}." ".$args{'VALUE'}; + + + $self->Limit (FIELD => 'Watcher', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + TYPE => $args{'TYPE'}, + DESCRIPTION => "$desc" + ); +} + +# }}} + +# {{{ sub LimitRequestor + +=head2 LimitRequestor + +It\'s like LimitWatcher, but it presets TYPE to Requestor + +=cut + + +sub LimitRequestor { + my $self = shift; + $self->LimitWatcher(TYPE=> 'Requestor', @_); +} + +# }}} + +# {{{ sub LimitCc + +=head2 LimitCC + +It\'s like LimitWatcher, but it presets TYPE to Cc + +=cut + +sub LimitCc { + my $self = shift; + $self->LimitWatcher(TYPE=> 'Cc', @_); +} + +# }}} + +# {{{ sub LimitAdminCc + +=head2 LimitAdminCc + +It\'s like LimitWatcher, but it presets TYPE to AdminCc + +=cut + +sub LimitAdminCc { + my $self = shift; + $self->LimitWatcher(TYPE=> 'AdminCc', @_); +} + +# }}} + +# }}} + +# }}} + +# {{{ Limiting based on links + +# {{{ LimitLinkedTo + +=head2 LimitLinkedTo + +LimitLinkedTo takes a paramhash with two fields: TYPE and TARGET +TYPE limits the sort of relationship we want to search on + +TARGET is the id or URI of the TARGET of the link +(TARGET used to be 'TICKET'. 'TICKET' is deprecated, but will be treated as TARGET + +=cut + +sub LimitLinkedTo { + my $self = shift; + my %args = ( + TICKET => undef, + TARGET => undef, + TYPE => undef, + @_); + + + $self->Limit( FIELD => 'LinkedTo', + BASE => undef, + TARGET => ($args{'TARGET'} || $args{'TICKET'}), + TYPE => $args{'TYPE'}, + DESCRIPTION => "Tickets ".$args{'TYPE'}." by ".($args{'TARGET'} || $args{'TICKET'}) + ); +} + + +# }}} + +# {{{ LimitLinkedFrom + +=head2 LimitLinkedFrom + +LimitLinkedFrom takes a paramhash with two fields: TYPE and BASE +TYPE limits the sort of relationship we want to search on + + +BASE is the id or URI of the BASE of the link +(BASE used to be 'TICKET'. 'TICKET' is deprecated, but will be treated as BASE + + +=cut + +sub LimitLinkedFrom { + my $self = shift; + my %args = ( BASE => undef, + TICKET => undef, + TYPE => undef, + @_); + + + $self->Limit( FIELD => 'LinkedTo', + TARGET => undef, + BASE => ($args{'BASE'} || $args{'TICKET'}), + TYPE => $args{'TYPE'}, + DESCRIPTION => "Tickets " .($args{'BASE'} || $args{'TICKET'}) ." ".$args{'TYPE'} + ); +} + + +# }}} + +# {{{ LimitMemberOf +sub LimitMemberOf { + my $self = shift; + my $ticket_id = shift; + $self->LimitLinkedTo ( TARGET=> "$ticket_id", + TYPE => 'MemberOf', + ); + +} +# }}} + +# {{{ LimitHasMember +sub LimitHasMember { + my $self = shift; + my $ticket_id =shift; + $self->LimitLinkedFrom ( BASE => "$ticket_id", + TYPE => 'MemberOf', + ); + +} +# }}} + +# {{{ LimitDependsOn + +sub LimitDependsOn { + my $self = shift; + my $ticket_id = shift; + $self->LimitLinkedTo ( TARGET => "$ticket_id", + TYPE => 'DependsOn', + ); + +} -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +# }}} +# {{{ LimitDependedOnBy -sub _Init { +sub LimitDependedOnBy { my $self = shift; - $self->{'table'} = 'Tickets'; - $self->{'primary_key'} = 'id'; + my $ticket_id = shift; + $self->LimitLinkedFrom ( BASE => "$ticket_id", + TYPE => 'DependsOn', + ); + +} + +# }}} - return ( $self->SUPER::_Init(@_) ); +# {{{ LimitRefersTo + +sub LimitRefersTo { + my $self = shift; + my $ticket_id = shift; + $self->LimitLinkedTo ( TARGET => "$ticket_id", + TYPE => 'RefersTo', + ); + } +# }}} + +# {{{ LimitReferredToBy + +sub LimitReferredToBy { + my $self = shift; + my $ticket_id = shift; + $self->LimitLinkedFrom ( BASE=> "$ticket_id", + TYPE => 'RefersTo', + ); + +} + +# }}} + +# }}} + +# {{{ limit based on ticket date attribtes + +# {{{ sub LimitDate -=item NewItem +=head2 LimitDate (FIELD => 'DateField', OPERATOR => $oper, VALUE => $ISODate) -Returns an empty new RT::Ticket item +Takes a paramhash with the fields FIELD OPERATOR and VALUE. + +OPERATOR is one of > or < +VALUE is a date and time in ISO format in GMT +FIELD is one of Starts, Started, Told, Created, Resolved, LastUpdated + +There are also helper functions of the form LimitFIELD that eliminate +the need to pass in a FIELD argument. =cut -sub NewItem { +sub LimitDate { my $self = shift; - return(RT::Ticket->new($self->CurrentUser)); + my %args = ( + FIELD => undef, + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + + @_); + + #Set the description if we didn't get handed it above + unless ($args{'DESCRIPTION'} ) { + $args{'DESCRIPTION'} = $args{'FIELD'} . " " .$args{'OPERATOR'}. " ". $args{'VALUE'} . " GMT" + } + + $self->Limit (%args); + } - eval "require RT::Tickets_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Tickets_Overlay.pm}) { - die $@; - }; +# }}} - eval "require RT::Tickets_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Tickets_Vendor.pm}) { - die $@; - }; - eval "require RT::Tickets_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Tickets_Local.pm}) { - die $@; - }; +sub LimitCreated { + my $self = shift; + $self->LimitDate( FIELD => 'Created', @_); +} +sub LimitDue { + my $self = shift; + $self->LimitDate( FIELD => 'Due', @_); +} +sub LimitStarts { + my $self = shift; + $self->LimitDate( FIELD => 'Starts', @_); -=head1 SEE ALSO +} +sub LimitStarted { + my $self = shift; + $self->LimitDate( FIELD => 'Started', @_); +} +sub LimitResolved { + my $self = shift; + $self->LimitDate( FIELD => 'Resolved', @_); +} +sub LimitTold { + my $self = shift; + $self->LimitDate( FIELD => 'Told', @_); +} +sub LimitLastUpdated { + my $self = shift; + $self->LimitDate( FIELD => 'LastUpdated', @_); +} +# +# {{{ sub LimitTransactionDate + +=head2 LimitTransactionDate (OPERATOR => $oper, VALUE => $ISODate) + +Takes a paramhash with the fields FIELD OPERATOR and VALUE. + +OPERATOR is one of > or < +VALUE is a date and time in ISO format in GMT + + +=cut + +sub LimitTransactionDate { + my $self = shift; + my %args = ( + FIELD => 'TransactionDate', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + + @_); + + #Set the description if we didn't get handed it above + unless ($args{'DESCRIPTION'} ) { + $args{'DESCRIPTION'} = $args{'FIELD'} . " " .$args{'OPERATOR'}. " ". $args{'VALUE'} . " GMT" + } + + $self->Limit (%args); -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +} + +# }}} + +# }}} + +# {{{ sub LimitKeyword -These overlay files can contain new subs or subs to replace existing subs in this module. +=head2 LimitKeyword -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +Takes a paramhash of key/value pairs with the following keys: - no warnings qw(redefine); +=over 4 -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=item KEYWORDSELECT - KeywordSelect id -RT::Tickets_Overlay, RT::Tickets_Vendor, RT::Tickets_Local +=item OPERATOR - (for KEYWORD only - KEYWORDSELECT operator is always `=') + +=item KEYWORD - Keyword id + +=back =cut +sub LimitKeyword { + my $self = shift; + my %args = ( KEYWORD => undef, + KEYWORDSELECT => undef, + OPERATOR => '=', + DESCRIPTION => undef, + FIELD => 'Keyword', + QUOTEVALUE => 1, + @_ + ); + + use RT::KeywordSelect; + my $KeywordSelect = RT::KeywordSelect->new($self->CurrentUser); + $KeywordSelect->Load($args{KEYWORDSELECT}); + + + # Below, We're checking to see whether the keyword we're searching for + # is null or not. + # This could probably be rewritten to be easier to read and understand + + + #If we are looking to compare with a null value. + if ($args{'OPERATOR'} =~ /is/i) { + if ($args{'OPERATOR'} =~ /^is$/i) { + $args{'DESCRIPTION'} ||= "Keyword Selection ". $KeywordSelect->Name . " has no value"; + } + elsif ($args{'OPERATOR'} =~ /^is not$/i) { + $args{'DESCRIPTION'} ||= "Keyword Selection ". $KeywordSelect->Name . " has a value"; + } + } + # if we're not looking to compare with a null value + else { + use RT::Keyword; + my $Keyword = RT::Keyword->new($self->CurrentUser); + $Keyword->Load($args{KEYWORD}); + $args{'DESCRIPTION'} ||= "Keyword Selection " . $KeywordSelect->Name. " $args{OPERATOR} ". $Keyword->Name; + } + + $args{SingleValued} = $KeywordSelect->Single(); + + + my $index = $self->_NextIndex; + %{$self->{'TicketRestrictions'}{$index}} = %args; + + $self->{'RecalcTicketLimits'} = 1; + return ($index); +} + +# }}} + +# {{{ sub _NextIndex + +=head2 _NextIndex + +Keep track of the counter for the array of restrictions + +=cut + +sub _NextIndex { + my $self = shift; + return ($self->{'restriction_index'}++); +} +# }}} + +# }}} + +# {{{ Core bits to make this a DBIx::SearchBuilder object + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Tickets"; + $self->{'RecalcTicketLimits'} = 1; + $self->{'looking_at_effective_id'} = 0; + $self->{'restriction_index'} =1; + $self->{'primary_key'} = "id"; + $self->SUPER::_Init(@_); + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::Ticket->new($self->CurrentUser)); + +} +# }}} + +# {{{ sub Count +sub Count { + my $self = shift; + $self->_ProcessRestrictions if ($self->{'RecalcTicketLimits'} == 1 ); + return($self->SUPER::Count()); +} +# }}} + +# {{{ sub ItemsArrayRef + +=head2 ItemsArrayRef + +Returns a reference to the set of all items found in this search + +=cut + +sub ItemsArrayRef { + my $self = shift; + my @items; + + my $placeholder = $self->_ItemsCounter; + $self->GotoFirstItem(); + while (my $item = $self->Next) { + push (@items, $item); + } + + $self->GotoItem($placeholder); + return(\@items); +} +# }}} + +# {{{ sub Next +sub Next { + my $self = shift; + + $self->_ProcessRestrictions if ($self->{'RecalcTicketLimits'} == 1 ); + + my $Ticket = $self->SUPER::Next(); + if ((defined($Ticket)) and (ref($Ticket))) { + + #Make sure we _never_ show dead tickets + #TODO we should be doing this in the where clause. + #but you can't do multiple clauses on the same field just yet :/ + + if ($Ticket->Status eq 'dead') { + return($self->Next()); + } + elsif ($Ticket->CurrentUserHasRight('ShowTicket')) { + return($Ticket); + } + + #If the user doesn't have the right to show this ticket + else { + return($self->Next()); + } + } + #if there never was any ticket + else { + return(undef); + } + +} +# }}} + +# }}} + +# {{{ Deal with storing and restoring restrictions + +# {{{ sub LoadRestrictions + +=head2 LoadRestrictions + +LoadRestrictions takes a string which can fully populate the TicketRestrictons hash. +TODO It is not yet implemented + +=cut + +# }}} + +# {{{ sub DescribeRestrictions + +=head2 DescribeRestrictions + +takes nothing. +Returns a hash keyed by restriction id. +Each element of the hash is currently a one element hash that contains DESCRIPTION which +is a description of the purpose of that TicketRestriction + +=cut + +sub DescribeRestrictions { + my $self = shift; + + my ($row, %listing); + + foreach $row (keys %{$self->{'TicketRestrictions'}}) { + $listing{$row} = $self->{'TicketRestrictions'}{$row}{'DESCRIPTION'}; + } + return (%listing); +} +# }}} + +# {{{ sub RestrictionValues + +=head2 RestrictionValues FIELD + +Takes a restriction field and returns a list of values this field is restricted +to. + +=cut + +sub RestrictionValues { + my $self = shift; + my $field = shift; + map $self->{'TicketRestrictions'}{$_}{'VALUE'}, + grep { + $self->{'TicketRestrictions'}{$_}{'FIELD'} eq $field + && $self->{'TicketRestrictions'}{$_}{'OPERATOR'} eq "=" + } + keys %{$self->{'TicketRestrictions'}}; +} + +# }}} + +# {{{ sub ClearRestrictions + +=head2 ClearRestrictions + +Removes all restrictions irretrievably + +=cut + +sub ClearRestrictions { + my $self = shift; + delete $self->{'TicketRestrictions'}; + $self->{'looking_at_effective_id'} = 0; + $self->{'RecalcTicketLimits'} =1; +} + +# }}} + +# {{{ sub DeleteRestriction + +=head2 DeleteRestriction + +Takes the row Id of a restriction (From DescribeRestrictions' output, for example. +Removes that restriction from the session's limits. + +=cut + + +sub DeleteRestriction { + my $self = shift; + my $row = shift; + delete $self->{'TicketRestrictions'}{$row}; + + $self->{'RecalcTicketLimits'} = 1; + #make the underlying easysearch object forget all its preconceptions +} + +# }}} + +# {{{ sub _ProcessRestrictions + +sub _ProcessRestrictions { + my $self = shift; + + #Need to clean the EasySearch slate because it makes things too sticky + $self->CleanSlate(); + + #Blow away ticket aliases since we'll need to regenerate them for a new search + delete $self->{'TicketAliases'}; + delete $self->{KeywordsAliases}; + + my $row; + + foreach $row (keys %{$self->{'TicketRestrictions'}}) { + my $restriction = $self->{'TicketRestrictions'}{$row}; + # {{{ if it's an int + + if ($TYPES{$restriction->{'FIELD'}} eq 'INT' ) { + if ($restriction->{'OPERATOR'} =~ /^(=|!=|>|<|>=|<=)$/) { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => $restriction->{'OPERATOR'}, + VALUE => $restriction->{'VALUE'}, + ); + } + } + # }}} + # {{{ if it's an enum + elsif ($TYPES{$restriction->{'FIELD'}} eq 'ENUM') { + + if ($restriction->{'OPERATOR'} eq '=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'OR', + OPERATOR => '=', + VALUE => $restriction->{'VALUE'}, + ); + } + elsif ($restriction->{'OPERATOR'} eq '!=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => '!=', + VALUE => $restriction->{'VALUE'}, + ); + } + + } + # }}} + # {{{ if it's a date + + elsif ($TYPES{$restriction->{'FIELD'}} eq 'DATE') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => $restriction->{'OPERATOR'}, + VALUE => $restriction->{'VALUE'}, + ); + } + # }}} + # {{{ if it's a string + + elsif ($TYPES{$restriction->{'FIELD'}} eq 'STRING') { + + if ($restriction->{'OPERATOR'} eq '=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'OR', + OPERATOR => '=', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + elsif ($restriction->{'OPERATOR'} eq '!=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => '!=', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + elsif ($restriction->{'OPERATOR'} eq 'LIKE') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => 'LIKE', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + elsif ($restriction->{'OPERATOR'} eq 'NOT LIKE') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => 'NOT LIKE', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + } + + # }}} + # {{{ if it's Transaction content that we're hunting for + elsif ($TYPES{$restriction->{'FIELD'}} eq 'TRANSFIELD') { + + #Basically, we want to make sure that the limits apply to the same attachment, + #rather than just another attachment for the same ticket, no matter how many + #clauses we lump on. + #We put them in TicketAliases so that they get nuked when we redo the join. + + unless (defined $self->{'TicketAliases'}{'TransFieldAlias'}) { + $self->{'TicketAliases'}{'TransFieldAlias'} = $self->NewAlias ('Transactions'); + } + unless (defined $self->{'TicketAliases'}{'TransFieldAttachAlias'}){ + $self->{'TicketAliases'}{'TransFieldAttachAlias'} = $self->NewAlias('Attachments'); + + } + #Join transactions to attachments + $self->Join( ALIAS1 => $self->{'TicketAliases'}{'TransFieldAttachAlias'}, + FIELD1 => 'TransactionId', + ALIAS2 => $self->{'TicketAliases'}{'TransFieldAlias'}, FIELD2=> 'id'); + + #Join transactions to tickets + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 =>$self->{'TicketAliases'}{'TransFieldAlias'}, FIELD2 => 'Ticket'); + + #Search for the right field + $self->SUPER::Limit(ALIAS => $self->{'TicketAliases'}{'TransFieldAttachAlias'}, + ENTRYAGGREGATOR => 'AND', + FIELD => $restriction->{'FIELD'}, + OPERATOR => $restriction->{'OPERATOR'} , + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + + + } + + # }}} + # {{{ if it's a Transaction date that we're hunting for + elsif ($TYPES{$restriction->{'FIELD'}} eq 'TRANSDATE') { + + #Basically, we want to make sure that the limits apply to the same attachment, + #rather than just another attachment for the same ticket, no matter how many + #clauses we lump on. + #We put them in TicketAliases so that they get nuked when we redo the join. + + unless (defined $self->{'TicketAliases'}{'TransFieldAlias'}) { + $self->{'TicketAliases'}{'TransFieldAlias'} = $self->NewAlias ('Transactions'); + } + + #Join transactions to tickets + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 =>$self->{'TicketAliases'}{'TransFieldAlias'}, FIELD2 => 'Ticket'); + + #Search for the right field + $self->SUPER::Limit(ALIAS => $self->{'TicketAliases'}{'TransFieldAlias'}, + ENTRYAGGREGATOR => 'AND', + FIELD => 'Created', + OPERATOR => $restriction->{'OPERATOR'} , + VALUE => $restriction->{'VALUE'} ); + } + + # }}} + # {{{ if it's a relationship that we're hunting for + + # Takes FIELD: which is something like "LinkedTo" + # takes TARGET or BASE which is the TARGET or BASE id that we're searching for + # takes TYPE which is the type of link we're looking for. + + elsif ($TYPES{$restriction->{'FIELD'}} eq 'LINKFIELD') { + + + my $LinkAlias = $self->NewAlias ('Links'); + + + #Make sure we get the right type of link, if we're restricting it + if ($restriction->{'TYPE'}) { + $self->SUPER::Limit(ALIAS => $LinkAlias, + ENTRYAGGREGATOR => 'AND', + FIELD => 'Type', + OPERATOR => '=', + VALUE => $restriction->{'TYPE'} ); + } + + #If we're trying to limit it to things that are target of + if ($restriction->{'TARGET'}) { + + + # If the TARGET is an integer that means that we want to look at the LocalTarget + # field. otherwise, we want to look at the "Target" field + + my ($matchfield); + if ($restriction->{'TARGET'} =~/^(\d+)$/) { + $matchfield = "LocalTarget"; + } + else { + $matchfield = "Target"; + } + + $self->SUPER::Limit(ALIAS => $LinkAlias, + ENTRYAGGREGATOR => 'AND', + FIELD => $matchfield, + OPERATOR => '=', + VALUE => $restriction->{'TARGET'} ); + + + #If we're searching on target, join the base to ticket.id + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 => $LinkAlias, + FIELD2 => 'LocalBase'); + + + + + } + #If we're trying to limit it to things that are base of + elsif ($restriction->{'BASE'}) { + + + # If we're trying to match a numeric link, we want to look at LocalBase, + # otherwise we want to look at "Base" + + my ($matchfield); + if ($restriction->{'BASE'} =~/^(\d+)$/) { + $matchfield = "LocalBase"; + } + else { + $matchfield = "Base"; + } + + + $self->SUPER::Limit(ALIAS => $LinkAlias, + ENTRYAGGREGATOR => 'AND', + FIELD => $matchfield, + OPERATOR => '=', + VALUE => $restriction->{'BASE'} ); + + #If we're searching on base, join the target to ticket.id + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 => $LinkAlias, + FIELD2 => 'LocalTarget'); + + } + + } + + # }}} + # {{{ if it's a watcher that we're hunting for + elsif ($TYPES{$restriction->{'FIELD'}} eq 'WATCHERFIELD') { + + my $Watch = $self->NewAlias('Watchers'); + + #Join watchers to users + my $User = $self->Join( TYPE => 'left', + ALIAS1 => $Watch, + FIELD1 => 'Owner', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + + #Join Ticket to watchers + $self->Join( ALIAS1 => 'main', FIELD1 => 'id', + ALIAS2 => $Watch, FIELD2 => 'Value'); + + + #Make sure we're only talking about ticket watchers + $self->SUPER::Limit( ALIAS => $Watch, + FIELD => 'Scope', + VALUE => 'Ticket', + OPERATOR => '='); + + + # Find email address watchers + $self->SUPER::Limit( SUBCLAUSE => 'WatcherEmailAddress', + ALIAS => $Watch, + FIELD => 'Email', + ENTRYAGGREGATOR => 'OR', + VALUE => $restriction->{'VALUE'}, + OPERATOR => $restriction->{'OPERATOR'}, + CASESENSITIVE => 0 + ); + + + + #Find user watchers + $self->SUPER::Limit( + SUBCLAUSE => 'WatcherEmailAddress', + ALIAS => $User, + FIELD => 'EmailAddress', + ENTRYAGGREGATOR => 'OR', + VALUE => $restriction->{'VALUE'}, + OPERATOR => $restriction->{'OPERATOR'}, + CASESENSITIVE => 0 + ); + + + #If we only want a specific type of watchers, then limit it to that + if ($restriction->{'TYPE'}) { + $self->SUPER::Limit( ALIAS => $Watch, + FIELD => 'Type', + ENTRYAGGREGATOR => 'OR', + VALUE => $restriction->{'TYPE'}, + OPERATOR => '='); + } + } + + # }}} + # {{{ if it's a keyword + elsif ($TYPES{$restriction->{'FIELD'}} eq 'KEYWORDFIELD') { + + my $null_columns_ok; + + my $ObjKeywordsAlias; + $ObjKeywordsAlias = $self->{KeywordsAliases}{$restriction->{'KEYWORDSELECT'}} + if $restriction->{SingleValued}; + unless (defined $ObjKeywordsAlias) { + $ObjKeywordsAlias = $self->Join( + TYPE => 'left', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'ObjectKeywords', + FIELD2 => 'ObjectId' + ); + if ($restriction->{'SingleValued'}) { + $self->{KeywordsAliases}{$restriction->{'KEYWORDSELECT'}} + = $ObjKeywordsAlias; + } + } + + + $self->SUPER::Limit( + ALIAS => $ObjKeywordsAlias, + FIELD => 'Keyword', + OPERATOR => $restriction->{'OPERATOR'}, + VALUE => $restriction->{'KEYWORD'}, + QUOTEVALUE => $restriction->{'QUOTEVALUE'}, + ENTRYAGGREGATOR => 'OR', + ); + + if ( ($restriction->{'OPERATOR'} =~ /^IS$/i) or + ($restriction->{'OPERATOR'} eq '!=') ) { + + $null_columns_ok=1; + + } + + #If we're trying to find tickets where the keyword isn't somethng, also check ones where it _IS_ null + if ( $restriction->{'OPERATOR'} eq '!=') { + $self->SUPER::Limit( + ALIAS => $ObjKeywordsAlias, + FIELD => 'Keyword', + OPERATOR => 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'OR', + ); + } + + + $self->SUPER::Limit(LEFTJOIN => $ObjKeywordsAlias, + FIELD => 'KeywordSelect', + VALUE => $restriction->{'KEYWORDSELECT'}, + ENTRYAGGREGATOR => 'OR'); + + + + $self->SUPER::Limit( ALIAS => $ObjKeywordsAlias, + FIELD => 'ObjectType', + VALUE => 'Ticket', + ENTRYAGGREGATOR => 'AND'); + + if ($null_columns_ok) { + $self->SUPER::Limit(ALIAS => $ObjKeywordsAlias, + FIELD => 'ObjectType', + OPERATOR => 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'OR'); + } + + } + # }}} + + + } + + + # here, we make sure we don't get any tickets that have been merged into other tickets + # (Ticket Id == Ticket EffectiveId + # note that we _really_ don't want to do this if we're already looking at the effectiveid + if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) { + $self->SUPER::Limit( FIELD => 'EffectiveId', + OPERATOR => '=', + QUOTEVALUE => 0, + VALUE => 'main.id'); #TODO, we shouldn't be hard coding the tablename to main. + } + $self->{'RecalcTicketLimits'} = 0; +} + +# }}} + +# }}} + +# {{{ Deal with displaying rows of the listing + +# +# Everything in this section is stub code for 2.2 +# It's not part of the API. It's not for your use +# It's not for our use. +# + + +# {{{ sub SetListingFormat + +=head2 SetListingFormat + +Takes a single Format string as specified below. parses that format string and makes the various listing output +things DTRT. + +=item Format strings + +Format strings are made up of a chain of Elements delimited with vertical pipes (|). +Elements of a Format string + + +FormatString: Element[::FormatString] + +Element: AttributeName[;HREF=<URL>][;TITLE=<TITLE>] + +AttributeName Id | Subject | Status | Owner | Priority | InitialPriority | TimeWorked | TimeLeft | + + Keywords[;SELECT=<KeywordSelect>] | + + <Created|Starts|Started|Contacted|Due|Resolved>Date<AsString|AsISO|AsAge> + + +=cut + + + + +#accept a format string + + + +sub SetListingFormat { + my $self = shift; + my $listing_format = shift; + + my ($element, $attribs); + my $i = 0; + foreach $element (split (/::/,$listing_format)) { + if ($element =~ /^(.*?);(.*)$/) { + $element = $1; + $attribs = $2; + } + $self->{'format_string'}->[$i]->{'Element'} = $element; + foreach $attrib (split (/;/, $attribs)) { + my $value = ""; + if ($attrib =~ /^(.*?)=(.*)$/) { + $attrib = $1; + $value = $2; + } + $self->{'format_string'}->[$i]->{"$attrib"} = $val; + + } + + } + return(1); +} + +# }}} + +# {{{ sub HeaderAsHTML +sub HeaderAsHTML { + my $self = shift; + my $header = ""; + my $col; + foreach $col ( @{[ $self->{'format_string'} ]}) { + $header .= "<TH>" . $self->_ColumnTitle($self->{'format_string'}->[$col]) . "</TH>"; + + } + return ($header); +} +# }}} + +# {{{ sub HeaderAsText +#Print text header +sub HeaderAsText { + my $self = shift; + my ($header); + + return ($header); +} +# }}} + +# {{{ sub TicketAsHTMLRow +#Print HTML row +sub TicketAsHTMLRow { + my $self = shift; + my $Ticket = shift; + my ($row, $col); + foreach $col (@{[$self->{'format_string'}]}) { + $row .= "<TD>" . $self->_TicketColumnValue($ticket,$self->{'format_string'}->[$col]) . "</TD>"; + + } + return ($row); +} +# }}} + +# {{{ sub TicketAsTextRow +#Print text row +sub TicketAsTextRow { + my $self = shift; + my ($row); + + #TODO implement + + return ($row); +} +# }}} + +# {{{ _ColumnTitle { + +sub _ColumnTitle { + my $self = shift; + + # Attrib is a hash + my $attrib = shift; + + # return either attrib->{'TITLE'} or.. + if ($attrib->{'TITLE'}) { + return($attrib->{'TITLE'}); + } + # failing that, Look up the title in a hash + else { + #TODO create $self->{'ColumnTitles'}; + return ($self->{'ColumnTitles'}->{$attrib->{'Element'}}); + } + +} + +# }}} + +# {{{ _TicketColumnValue +sub _TicketColumnValue { + my $self = shift; + my $Ticket = shift; + my $attrib = shift; + + + my $out; + + SWITCH: { + /^id/i && do { + $out = $Ticket->id; + last SWITCH; + }; + /^subj/i && do { + last SWITCH; + $Ticket->Subject; + }; + /^status/i && do { + last SWITCH; + $Ticket->Status; + }; + /^prio/i && do { + last SWITCH; + $Ticket->Priority; + }; + /^finalprio/i && do { + + last SWITCH; + $Ticket->FinalPriority + }; + /^initialprio/i && do { + + last SWITCH; + $Ticket->InitialPriority; + }; + /^timel/i && do { + + last SWITCH; + $Ticket->TimeWorked; + }; + /^timew/i && do { + + last SWITCH; + $Ticket->TimeLeft; + }; + + /^(.*?)date(.*)$/i && do { + my $o = $1; + my $m = $2; + my ($obj); + #TODO: optimize + $obj = $Ticket->DueObj if $o =~ /due/i; + $obj = $Ticket->CreatedObj if $o =~ /created/i; + $obj = $Ticket->StartsObj if $o =~ /starts/i; + $obj = $Ticket->StartedObj if $o =~ /started/i; + $obj = $Ticket->ToldObj if $o =~ /told/i; + $obj = $Ticket->LastUpdatedObj if $o =~ /lastu/i; + + $method = 'ISO' if $m =~ /iso/i; + + $method = 'AsString' if $m =~ /asstring/i; + $method = 'AgeAsString' if $m =~ /age/i; + last SWITCH; + $obj->$method(); + + }; + + /^watcher/i && do { + last SWITCH; + $Ticket->WatchersAsString(); + }; + + /^requestor/i && do { + last SWITCH; + $Ticket->RequestorsAsString(); + }; + /^cc/i && do { + last SWITCH; + $Ticket->CCAsString(); + }; + + + /^admincc/i && do { + last SWITCH; + $Ticket->AdminCcAsString(); + }; + + /^keywords/i && do { + last SWITCH; + #Limit it to the keyword select we're talking about, if we've got one. + my $objkeys =$Ticket->KeywordsObj($attrib->{'SELECT'}); + $objkeys->KeywordRelativePathsAsString(); + }; + + } + +} + +# }}} + +# }}} + +# {{{ POD +=head2 notes +"Enum" Things that get Is, IsNot + + +"Int" Things that get Is LessThan and GreaterThan +id +InitialPriority +FinalPriority +Priority +TimeLeft +TimeWorked + +"Text" Things that get Is, Like +Subject +TransactionContent + + +"Link" OPERATORs + + +"Date" OPERATORs Is, Before, After + =cut +# }}} 1; diff --git a/rt/lib/RT/Transaction.pm b/rt/lib/RT/Transaction.pm index ca491a6c7..ee1f069b2 100755 --- a/rt/lib/RT/Transaction.pm +++ b/rt/lib/RT/Transaction.pm @@ -1,364 +1,783 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Transaction.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1999-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License =head1 NAME -RT::Transaction - + RT::Transaction - RT\'s transaction object =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::Transaction; -use RT::Record; -use RT::Ticket; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); + use RT::Transaction; -sub _Init { - my $self = shift; - $self->Table('Transactions'); - $self->SUPER::_Init(@_); -} +=head1 DESCRIPTION +Each RT::Transaction describes an atomic change to a ticket object +or an update to an RT::Ticket object. +It can have arbitrary MIME attachments. +=head1 METHODS -=item Create PARAMHASH +=begin testing -Create takes a hash of values and creates a row in the database: +ok(require RT::TestHarness); +ok(require RT::Transaction); - int(11) 'EffectiveTicket'. - int(11) 'Ticket'. - int(11) 'TimeTaken'. - varchar(20) 'Type'. - varchar(40) 'Field'. - varchar(255) 'OldValue'. - varchar(255) 'NewValue'. - varchar(100) 'Data'. +=end testing =cut +package RT::Transaction; +use RT::Record; +@ISA= qw(RT::Record); + +use RT::Attachments; - -sub Create { +# {{{ sub _Init +sub _Init { my $self = shift; - my %args = ( - EffectiveTicket => '0', - Ticket => '0', - TimeTaken => '0', - Type => '', - Field => '', - OldValue => '', - NewValue => '', - Data => '', - - @_); - $self->SUPER::Create( - EffectiveTicket => $args{'EffectiveTicket'}, - Ticket => $args{'Ticket'}, - TimeTaken => $args{'TimeTaken'}, - Type => $args{'Type'}, - Field => $args{'Field'}, - OldValue => $args{'OldValue'}, - NewValue => $args{'NewValue'}, - Data => $args{'Data'}, -); + $self->{'table'} = "Transactions"; + return ($self->SUPER::_Init(@_)); } +# }}} +# {{{ sub Create +=head2 Create -=item id +Create a new transaction. -Returns the current value of id. -(In the database, id is stored as int(11).) +This routine should _never_ be called anything other Than RT::Ticket. It should not be called +from client code. Ever. Not ever. If you do this, we will hunt you down. and break your kneecaps. +Then the unpleasant stuff will start. +TODO: Document what gets passed to this =cut +sub Create { + my $self = shift; + my %args = ( id => undef, + TimeTaken => 0, + Ticket => 0 , + Type => 'undefined', + Data => '', + Field => undef, + OldValue => undef, + NewValue => undef, + MIMEObj => undef, + ActivateScrips => 1, + @_ + ); + + #if we didn't specify a ticket, we need to bail + unless ( $args{'Ticket'} ) { + return(0, "RT::Transaction->Create couldn't, as you didn't specify a ticket id"); + } + + #lets create our transaction + my $id = $self->SUPER::Create(Ticket => $args{'Ticket'}, + TimeTaken => $args{'TimeTaken'}, + Type => $args{'Type'}, + Data => $args{'Data'}, + Field => $args{'Field'}, + OldValue => $args{'OldValue'}, + NewValue => $args{'NewValue'}, + Created => $args{'Created'} + ); + $self->Load($id); + $self->_Attach($args{'MIMEObj'}) + if defined $args{'MIMEObj'}; + + #Provide a way to turn off scrips if we need to + if ($args{'ActivateScrips'}) { + + #We're really going to need a non-acled ticket for the scrips to work + my $TicketAsSystem = RT::Ticket->new($RT::SystemUser); + $TicketAsSystem->Load($args{'Ticket'}) || + $RT::Logger->err("$self couldn't load ticket $args{'Ticket'}\n"); + + my $TransAsSystem = RT::Transaction->new($RT::SystemUser); + $TransAsSystem->Load($self->id) || + $RT::Logger->err("$self couldn't load a copy of itself as superuser\n"); + + # {{{ Deal with Scrips + + #Load a scripscopes object + use RT::Scrips; + my $PossibleScrips = RT::Scrips->new($RT::SystemUser); + + $PossibleScrips->LimitToQueue($TicketAsSystem->QueueObj->Id); #Limit it to $Ticket->QueueObj->Id + $PossibleScrips->LimitToGlobal(); # or to "global" + my $ConditionsAlias = $PossibleScrips->NewAlias('ScripConditions'); + + $PossibleScrips->Join(ALIAS1 => 'main', FIELD1 => 'ScripCondition', + ALIAS2 => $ConditionsAlias, FIELD2=> 'id'); + + + #We only want things where the scrip applies to this sort of transaction + $PossibleScrips->Limit(ALIAS=> $ConditionsAlias, + FIELD=>'ApplicableTransTypes', + OPERATOR => 'LIKE', + VALUE => $args{'Type'}, + ENTRYAGGREGATOR => 'OR', + ); + + # Or where the scrip applies to any transaction + $PossibleScrips->Limit(ALIAS=> $ConditionsAlias, + FIELD=>'ApplicableTransTypes', + OPERATOR => 'LIKE', + VALUE => "Any", + ENTRYAGGREGATOR => 'OR', + ); + + #Iterate through each script and check it's applicability. + + while (my $Scrip = $PossibleScrips->Next()) { + + #TODO: properly deal with errors raised in this scrip loop + + #$RT::Logger->debug("$self now dealing with ".$Scrip->Id. "\n"); + eval { + local $SIG{__DIE__} = sub { $RT::Logger->error($_[0])}; + + + #Load the scrip's Condition object + $Scrip->ConditionObj->LoadCondition(TicketObj => $TicketAsSystem, + TransactionObj => $TransAsSystem); + + + #If it's applicable, prepare and commit it + + $RT::Logger->debug ("$self: Checking condition ".$Scrip->ConditionObj->Name. "...\n"); + + if ( $Scrip->IsApplicable() ) { + + $RT::Logger->debug ("$self: Matches condition ".$Scrip->ConditionObj->Name. "...\n"); + #TODO: handle some errors here + + $Scrip->ActionObj->LoadAction(TicketObj => $TicketAsSystem, + TransactionObj => $TransAsSystem); + + + if ($Scrip->Prepare()) { + $RT::Logger->debug("$self: Prepared " . + $Scrip->ActionObj->Name . "\n"); + if ($Scrip->Commit()) { + $RT::Logger->debug("$self: Committed " . + $Scrip->ActionObj->Name . "\n"); + } + else { + $RT::Logger->info("$self: Failed to commit ". + $Scrip->ActionObj->Name . "\n"); + } + } + else { + $RT::Logger->info("$self: Failed to prepare " . + $Scrip->ActionObj->Name . "\n"); + } + + #We're done with it. lets clean up. + #TODO: something else isn't letting these get garbage collected. check em out. + $Scrip->ActionObj->DESTROY(); + $Scrip->ConditionObj->DESTROY; + } + + + else { + $RT::Logger->debug ("$self: Doesn't match condition ".$Scrip->ConditionObj->Name. "...\n"); + + # TODO: why doesn't this catch all the ScripObjs we create. + # and why do we explictly need to destroy them? + $Scrip->ConditionObj->DESTROY; + } + } + } + + # }}} + + } + + return ($id, "Transaction Created"); +} -=item EffectiveTicket +# }}} -Returns the current value of EffectiveTicket. -(In the database, EffectiveTicket is stored as int(11).) +# {{{ sub Delete +sub Delete { + my $self = shift; + return (0, 'Deleting this object could break referential integrity'); +} +# }}} -=item SetEffectiveTicket VALUE +# {{{ Routines dealing with Attachments +# {{{ sub Message -Set EffectiveTicket to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, EffectiveTicket will be stored as a int(11).) +=head2 Message + Returns the RT::Attachments Object which contains the "top-level" object + attachment for this transaction =cut +sub Message { -=item Ticket - -Returns the current value of Ticket. -(In the database, Ticket is stored as int(11).) - - - -=item SetTicket VALUE - - -Set Ticket to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Ticket will be stored as a int(11).) + my $self = shift; + + if (!defined ($self->{'message'}) ){ + + $self->{'message'} = new RT::Attachments($self->CurrentUser); + $self->{'message'}->Limit(FIELD => 'TransactionId', + VALUE => $self->Id); + + $self->{'message'}->ChildrenOf(0); + } + return($self->{'message'}); +} +# }}} +# {{{ sub Content -=cut +=head2 Content PARAMHASH +If this transaction has attached mime objects, returns the first text/ part. +Otherwise, returns undef. -=item TicketObj - -Returns the Ticket Object which has the id returned by Ticket +Takes a paramhash. If the $args{'Quote'} parameter is set, wraps this message +at $args{'Wrap'}. $args{'Wrap'} defaults to 70. =cut -sub TicketObj { - my $self = shift; - my $Ticket = RT::Ticket->new($self->CurrentUser); - $Ticket->Load($self->__Value('Ticket')); - return($Ticket); +sub Content { + my $self = shift; + my %args = ( Quote => 0, + Wrap => 70, + @_ ); + + my $content = undef; + + # If we don\'t have any content, return undef now. + unless ($self->Message->First) { + return (undef); + } + + # Get the set of toplevel attachments to this transaction. + my $MIMEObj = $self->Message->First(); + + # If it's a message or a plain part, just return the + # body. + if ($MIMEObj->ContentType() =~ '^(text|message)(/|$)') { + $content = $MIMEObj->Content(); + } + + # If it's a multipart object, first try returning the first + # text/plain part. + + elsif ($MIMEObj->ContentType() =~ '^multipart/') { + my $plain_parts = $MIMEObj->Children(); + $plain_parts->ContentType(VALUE => 'text/plain'); + + # If we actully found a part, return its content + if ($plain_parts->First && + $plain_parts->First->Content ne '') { + $content = $plain_parts->First->Content; + } + + # If that fails, return the first text/ or message/ part + # which has some content. + + else { + my $all_parts = $MIMEObj->Children(); + while (($content == undef) && + (my $part = $all_parts->Next)) { + if (($part->ContentType() =~ '^(text|message)(/|$)') and + ($part->Content())) { + $content = $part->Content; + } + } + } + + } + # If all else fails, return a message that we couldn't find + # any content + else { + $content = 'This transaction appears to have no content'; + } + + if ($args{'Quote'}) { + # Remove quoted signature. + $content =~ s/\n-- \n(.*)$//s; + + # What's the longest line like? + foreach (split (/\n/,$content)) { + $max=length if ( length > $max); + } + + if ($max>76) { + require Text::Wrapper; + my $wrapper=new Text::Wrapper + ( + columns => $args{'Wrap'}, + body_start => ($max > 70*3 ? ' ' : ''), + par_start => '' + ); + $content=$wrapper->wrap($content); + } + + $content =~ s/^/> /gm; + $content = '[' . $self->CreatorObj->Name() . ' - ' . $self->CreatedAsString() + . "]:\n\n" + . $content . "\n\n"; + + } + + return ($content); } +# }}} -=item TimeTaken - -Returns the current value of TimeTaken. -(In the database, TimeTaken is stored as int(11).) - - - -=item SetTimeTaken VALUE - - -Set TimeTaken to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeTaken will be stored as a int(11).) +# {{{ sub Subject +=head2 Subject +If this transaction has attached mime objects, returns the first one's subject +Otherwise, returns null + =cut +sub Subject { + my $self = shift; + if ($self->Message->First) { + return ($self->Message->First->Subject); + } + else { + return (undef); + } +} +# }}} -=item Type - -Returns the current value of Type. -(In the database, Type is stored as varchar(20).) - - - -=item SetType VALUE - +# {{{ sub Attachments -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(20).) +=head2 Attachments + Returns all the RT::Attachment objects which are attached +to this transaction. Takes an optional parameter, which is +a ContentType that Attachments should be restricted to. =cut -=item Field - -Returns the current value of Field. -(In the database, Field is stored as varchar(40).) - - +sub Attachments { + my $self = shift; + my $Types = ''; + $Types = shift if (@_); + + my $Attachments = new RT::Attachments($self->CurrentUser); + + #If it's a comment, return an empty object if they don't have the right to see it + if ($self->Type eq 'Comment') { + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + return ($Attachments); + } + } + #if they ain't got rights to see, return an empty object + else { + unless ($self->CurrentUserHasRight('ShowTicket')) { + return ($Attachments); + } + } + + $Attachments->Limit(FIELD => 'TransactionId', + VALUE => $self->Id); + + # Get the attachments in the order they're put into + # the database. Arguably, we should be returning a tree + # of attachments, not a set...but no current app seems to need + # it. + + $Attachments->OrderBy(ALIAS => 'main', + FIELD => 'Id', + ORDER => 'asc'); + + if ($Types) { + $Attachments->ContentType( VALUE => "$Types", + OPERATOR => "LIKE"); + } + + + return($Attachments); + +} -=item SetField VALUE +# }}} +# {{{ sub _Attach -Set Field to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Field will be stored as a varchar(40).) +=head2 _Attach +A private method used to attach a mime object to this transaction. =cut +sub _Attach { + my $self = shift; + my $MIMEObject = shift; + + if (!defined($MIMEObject)) { + $RT::Logger->error("$self _Attach: We can't attach a mime object if you don't give us one.\n"); + return(0, "$self: no attachment specified"); + } + + + use RT::Attachment; + my $Attachment = new RT::Attachment ($self->CurrentUser); + $Attachment->Create(TransactionId => $self->Id, + Attachment => $MIMEObject); + return ($Attachment, "Attachment created"); + +} -=item OldValue - -Returns the current value of OldValue. -(In the database, OldValue is stored as varchar(255).) - +# }}} +# }}} -=item SetOldValue VALUE +# {{{ Routines dealing with Transaction Attributes +# {{{ sub TicketObj -Set OldValue to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, OldValue will be stored as a varchar(255).) +=head2 TicketObj +Returns this transaction's ticket object. =cut +sub TicketObj { + my $self = shift; + if (! exists $self->{'TicketObj'}) { + $self->{'TicketObj'} = new RT::Ticket($self->CurrentUser); + $self->{'TicketObj'}->Load($self->Ticket); + } + + return $self->{'TicketObj'}; +} +# }}} -=item NewValue - -Returns the current value of NewValue. -(In the database, NewValue is stored as varchar(255).) - - - -=item SetNewValue VALUE - +# {{{ sub Description -Set NewValue to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, NewValue will be stored as a varchar(255).) +=head2 Description +Returns a text string which describes this transaction =cut -=item Data - -Returns the current value of Data. -(In the database, Data is stored as varchar(100).) - +sub Description { + my $self = shift; + #Check those ACLs + #If it's a comment, we need to be extra special careful + if ($self->__Value('Type') eq 'Comment') { + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + return (0, "Permission Denied"); + } + } + + #if they ain't got rights to see, don't let em + else { + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (0, "Permission Denied"); + } + } + + if (!defined($self->Type)) { + return("No transaction type specified"); + } + + return ($self->BriefDescription . " by " . $self->CreatorObj->Name); +} -=item SetData VALUE +# }}} +# {{{ sub BriefDescription -Set Data to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Data will be stored as a varchar(100).) +=head2 BriefDescription +Returns a text string which briefly describes this transaction =cut -=item Creator +sub BriefDescription { + my $self = shift; -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) + #Check those ACLs + #If it's a comment, we need to be extra special careful + if ($self->__Value('Type') eq 'Comment') { + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + return (0, "Permission Denied"); + } + } + + #if they ain't got rights to see, don't let em + else { + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (0, "Permission Denied"); + } + } + + if (!defined($self->Type)) { + return("No transaction type specified"); + } + + if ($self->Type eq 'Create'){ + return("Ticket created"); + } + elsif ($self->Type =~ /Status/) { + if ($self->Field eq 'Status') { + if ($self->NewValue eq 'dead') { + return ("Ticket killed"); + } + else { + return( "Status changed from ". $self->OldValue . + " to ". $self->NewValue); + + } + } + # Generic: + return ($self->Field." changed from ".($self->OldValue||"(empty value)"). + " to ".$self->NewValue ); + } + + if ($self->Type eq 'Correspond') { + return("Correspondence added"); + } + + elsif ($self->Type eq 'Comment') { + return( "Comments added"); + } + + elsif ($self->Type eq 'Keyword') { + + my $field = 'Keyword'; + + if ($self->Field) { + my $keywordsel = new RT::KeywordSelect ($self->CurrentUser); + $keywordsel->Load($self->Field); + $field = $keywordsel->Name(); + } + + if ($self->OldValue eq '') { + return ($field." ".$self->NewValue." added"); + } + elsif ($self->NewValue eq '') { + return ($field." ".$self->OldValue." deleted"); + + } + else { + return ($field." ".$self->OldValue . " changed to ". + $self->NewValue); + } + } + + elsif ($self->Type eq 'Untake'){ + return( "Untaken"); + } + + elsif ($self->Type eq "Take") { + return( "Taken"); + } + + elsif ($self->Type eq "Force") { + my $Old = RT::User->new($self->CurrentUser); + $Old->Load($self->OldValue); + my $New = RT::User->new($self->CurrentUser); + $New->Load($self->NewValue); + return "Owner forcibly changed from ".$Old->Name . " to ". $New->Name; + } + elsif ($self->Type eq "Steal") { + my $Old = RT::User->new($self->CurrentUser); + $Old->Load($self->OldValue); + return "Stolen from ".$Old->Name; + } + + elsif ($self->Type eq "Give") { + my $New = RT::User->new($self->CurrentUser); + $New->Load($self->NewValue); + return( "Given to ".$New->Name); + } + + elsif ($self->Type eq 'AddWatcher'){ + return( $self->Field." ". $self->NewValue ." added"); + } + + elsif ($self->Type eq 'DelWatcher'){ + return( $self->Field." ".$self->OldValue ." deleted"); + } + + elsif ($self->Type eq 'Subject') { + return( "Subject changed to ".$self->Data); + } + elsif ($self->Type eq 'Told') { + return( "User notified"); + } + + elsif ($self->Type eq 'AddLink') { + return ($self->Data); + } + elsif ($self->Type eq 'DeleteLink') { + return ($self->Data); + } + elsif ($self->Type eq 'Set') { + if ($self->Field eq 'Queue') { + my $q1 = new RT::Queue($self->CurrentUser); + $q1->Load($self->OldValue); + my $q2 = new RT::Queue($self->CurrentUser); + $q2->Load($self->NewValue); + return ($self->Field . " changed from " . $q1->Name . " to ". + $q2->Name); + } + + # Write the date/time change at local time: + elsif ($self->Field =~ /Due|Starts|Started|Told/) { + my $t1 = new RT::Date($self->CurrentUser); + $t1->Set(Format => 'ISO', Value => $self->NewValue); + my $t2 = new RT::Date($self->CurrentUser); + $t2->Set(Format => 'ISO', Value => $self->OldValue); + return ($self->Field . " changed from " . $t2->AsString . + " to ".$t1->AsString); + } + else { + return ($self->Field . " changed from " . $self->OldValue . + " to ".$self->NewValue); + } + } + elsif ($self->Type eq 'PurgeTransaction') { + return ("Transaction ".$self->Data. " purged"); + } + else { + return ("Default: ". $self->Type ."/". $self->Field . + " changed from " . $self->OldValue . + " to ".$self->NewValue); + + } +} +# }}} -=cut +# {{{ Utility methods +# {{{ sub IsInbound -=item Created - -Returns the current value of Created. -(In the database, Created is stored as datetime.) +=head2 IsInbound +Returns true if the creator of the transaction is a requestor of the ticket. +Returns false otherwise =cut +sub IsInbound { + my $self=shift; + return ($self->TicketObj->IsRequestor($self->CreatorObj)); +} +# }}} + +# }}} + +# {{{ sub _Accessible + +sub _Accessible { + my $self = shift; + my %Cols = ( + TimeTaken => 'read', + Ticket => 'read/public', + Type=> 'read', + Field => 'read', + Data => 'read', + NewValue => 'read', + OldValue => 'read', + Creator => 'read/auto', + Created => 'read/auto', + ); + return $self->SUPER::_Accessible(@_, %Cols); +} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - EffectiveTicket => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Ticket => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - TimeTaken => - {read => 1, write => 1, type => 'int(11)', default => '0'}, - Type => - {read => 1, write => 1, type => 'varchar(20)', default => ''}, - Field => - {read => 1, write => 1, type => 'varchar(40)', default => ''}, - OldValue => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - NewValue => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, - Data => - {read => 1, write => 1, type => 'varchar(100)', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; +# }}} +# }}} - eval "require RT::Transaction_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Transaction_Overlay.pm}) { - die $@; - }; +# {{{ sub _Set - eval "require RT::Transaction_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Transaction_Vendor.pm}) { - die $@; - }; +sub _Set { + my $self = shift; + return(0, 'Transactions are immutable'); +} - eval "require RT::Transaction_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Transaction_Local.pm}) { - die $@; - }; +# }}} +# {{{ sub _Value +=head2 _Value +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check -=head1 SEE ALSO +=cut -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. +sub _Value { -These overlay files can contain new subs or subs to replace existing subs in this module. + my $self = shift; + my $field = shift; + + + #if the field is public, return it. + if ($self->_Accessible($field, 'public')) { + return($self->__Value($field)); + + } + #If it's a comment, we need to be extra special careful + if ($self->__Value('Type') eq 'Comment') { + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + return (undef); + } + } + #if they ain't got rights to see, don't let em + else { + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (undef); + } + } + + return($self->__Value($field)); + +} -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line +# }}} - no warnings qw(redefine); +# {{{ sub CurrentUserHasRight -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +=head2 CurrentUserHasRight RIGHT -RT::Transaction_Overlay, RT::Transaction_Vendor, RT::Transaction_Local +Calls $self->CurrentUser->HasQueueRight for the right passed in here. +passed in here. =cut +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->CurrentUser->HasQueueRight(Right => "$right", + TicketObj => $self->TicketObj)); +} + +# }}} 1; diff --git a/rt/lib/RT/Transactions.pm b/rt/lib/RT/Transactions.pm index 23a475ac6..2ae98f286 100755 --- a/rt/lib/RT/Transactions.pm +++ b/rt/lib/RT/Transactions.pm @@ -1,115 +1,78 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Transactions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ =head1 NAME - RT::Transactions -- Class Description - + RT::Transactions - a collection of RT Transaction objects + =head1 SYNOPSIS - use RT::Transactions + use RT::Transactions; + =head1 DESCRIPTION =head1 METHODS -=cut +=begin testing -package RT::Transactions; - -use RT::SearchBuilder; -use RT::Transaction; +ok (require RT::TestHarness); +ok (require RT::Transactions); -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +=end testing +=cut -sub _Init { - my $self = shift; - $self->{'table'} = 'Transactions'; - $self->{'primary_key'} = 'id'; +package RT::Transactions; +use RT::EasySearch; +@ISA= qw(RT::EasySearch); +use RT::Transaction; - return ( $self->SUPER::_Init(@_) ); +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "Transactions"; + $self->{'primary_key'} = "id"; + + # By default, order by the date of the transaction, rather than ID. + $self->OrderBy( ALIAS => 'main', + FIELD => 'Created', + ORDER => 'ASC'); + + return ( $self->SUPER::_Init(@_)); } +# }}} - -=item NewItem - -Returns an empty new RT::Transaction item - -=cut - -sub NewItem { +# {{{ sub NewItem +sub NewItem { my $self = shift; + return(RT::Transaction->new($self->CurrentUser)); } - - eval "require RT::Transactions_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Transactions_Overlay.pm}) { - die $@; - }; - - eval "require RT::Transactions_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Transactions_Vendor.pm}) { - die $@; - }; - - eval "require RT::Transactions_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Transactions_Local.pm}) { - die $@; - }; +# }}} +=head2 example methods + Queue RT::Queue or Queue Id + Ticket RT::Ticket or Ticket Id -=head1 SEE ALSO -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::Transactions_Overlay, RT::Transactions_Vendor, RT::Transactions_Local +LimitDate + +Type TRANSTYPE +Field STRING +OldValue OLDVAL +NewValue NEWVAL +Data DATA +TimeTaken +Actor USEROBJ/USERID +ContentMatches STRING =cut 1; + diff --git a/rt/lib/RT/User.pm b/rt/lib/RT/User.pm index cbc10f5b4..4e8554030 100755 --- a/rt/lib/RT/User.pm +++ b/rt/lib/RT/User.pm @@ -1,854 +1,1222 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; - +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/User.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL =head1 NAME -RT::User - + RT::User - RT User object =head1 SYNOPSIS -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package RT::User; -use RT::Record; - + use RT::User; -use vars qw( @ISA ); -@ISA= qw( RT::Record ); - -sub _Init { - my $self = shift; +=head1 DESCRIPTION - $self->Table('Users'); - $self->SUPER::_Init(@_); -} +=head1 METHODS +=begin testing +ok(require RT::TestHarness); +ok(require RT::User); +=end testing -=item Create PARAMHASH - -Create takes a hash of values and creates a row in the database: - - varchar(200) 'Name'. - varchar(40) 'Password'. - blob 'Comments'. - blob 'Signature'. - varchar(120) 'EmailAddress'. - blob 'FreeformContactInfo'. - varchar(200) 'Organization'. - varchar(120) 'RealName'. - varchar(16) 'NickName'. - varchar(16) 'Lang'. - varchar(16) 'EmailEncoding'. - varchar(16) 'WebEncoding'. - varchar(100) 'ExternalContactInfoId'. - varchar(30) 'ContactInfoSystem'. - varchar(100) 'ExternalAuthId'. - varchar(30) 'AuthSystem'. - varchar(16) 'Gecos'. - varchar(30) 'HomePhone'. - varchar(30) 'WorkPhone'. - varchar(30) 'MobilePhone'. - varchar(30) 'PagerPhone'. - varchar(200) 'Address1'. - varchar(200) 'Address2'. - varchar(100) 'City'. - varchar(100) 'State'. - varchar(16) 'Zip'. - varchar(50) 'Country'. - varchar(50) 'Timezone'. - text 'PGPKey'. =cut +package RT::User; +use RT::Record; +@ISA= qw(RT::Record); - -sub Create { +# {{{ sub _Init +sub _Init { my $self = shift; - my %args = ( - Name => '', - Password => '', - Comments => '', - Signature => '', - EmailAddress => '', - FreeformContactInfo => '', - Organization => '', - RealName => '', - NickName => '', - Lang => '', - EmailEncoding => '', - WebEncoding => '', - ExternalContactInfoId => '', - ContactInfoSystem => '', - ExternalAuthId => '', - AuthSystem => '', - Gecos => '', - HomePhone => '', - WorkPhone => '', - MobilePhone => '', - PagerPhone => '', - Address1 => '', - Address2 => '', - City => '', - State => '', - Zip => '', - Country => '', - Timezone => '', - PGPKey => '', - - @_); - $self->SUPER::Create( - Name => $args{'Name'}, - Password => $args{'Password'}, - Comments => $args{'Comments'}, - Signature => $args{'Signature'}, - EmailAddress => $args{'EmailAddress'}, - FreeformContactInfo => $args{'FreeformContactInfo'}, - Organization => $args{'Organization'}, - RealName => $args{'RealName'}, - NickName => $args{'NickName'}, - Lang => $args{'Lang'}, - EmailEncoding => $args{'EmailEncoding'}, - WebEncoding => $args{'WebEncoding'}, - ExternalContactInfoId => $args{'ExternalContactInfoId'}, - ContactInfoSystem => $args{'ContactInfoSystem'}, - ExternalAuthId => $args{'ExternalAuthId'}, - AuthSystem => $args{'AuthSystem'}, - Gecos => $args{'Gecos'}, - HomePhone => $args{'HomePhone'}, - WorkPhone => $args{'WorkPhone'}, - MobilePhone => $args{'MobilePhone'}, - PagerPhone => $args{'PagerPhone'}, - Address1 => $args{'Address1'}, - Address2 => $args{'Address2'}, - City => $args{'City'}, - State => $args{'State'}, - Zip => $args{'Zip'}, - Country => $args{'Country'}, - Timezone => $args{'Timezone'}, - PGPKey => $args{'PGPKey'}, -); - + $self->{'table'} = "Users"; + return($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _Accessible + +sub _Accessible { + my $self = shift; + my %Cols = ( + # {{{ Core RT info + Name => 'public/read/write/admin', + Password => 'write', + Comments => 'read/write/admin', + Signature => 'read/write', + EmailAddress => 'public/read/write', + PagerEmailAddress => 'read/write', + FreeformContactInfo => 'read/write', + Organization => 'public/read/write/admin', + Disabled => 'public/read/write/admin', #To modify this attribute, we have helper + #methods + Privileged => 'read/write/admin', # 0=no 1=user 2=system + + # }}} + + # {{{ Names + + RealName => 'public/read/write', + NickName => 'public/read/write', + # }}} + + # {{{ Localization and Internationalization + Lang => 'public/read/write', + EmailEncoding => 'public/read/write', + WebEncoding => 'public/read/write', + # }}} + + # {{{ External ContactInfo Linkage + ExternalContactInfoId => 'public/read/write/admin', + ContactInfoSystem => 'public/read/write/admin', + # }}} + + # {{{ User Authentication identifier + ExternalAuthId => 'public/read/write/admin', + #Authentication system used for user + AuthSystem => 'public/read/write/admin', + Gecos => 'public/read/write/admin', #Gecos is the name of the fields in a + # unix passwd file. In this case, it refers to "Unix Username" + # }}} + + # {{{ Telephone numbers + HomePhone => 'read/write', + WorkPhone => 'read/write', + MobilePhone => 'read/write', + PagerPhone => 'read/write', + + # }}} + + # {{{ Paper Address + Address1 => 'read/write', + Address2 => 'read/write', + City => 'read/write', + State => 'read/write', + Zip => 'read/write', + Country => 'read/write', + # }}} + + # {{{ Core DBIx::Record Attributes + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + + # }}} + ); + return($self->SUPER::_Accessible(@_, %Cols)); } +# }}} +# {{{ sub Create -=item id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=item Name - -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) - - - -=item SetName VALUE - - -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) - - -=cut - - -=item Password - -Returns the current value of Password. -(In the database, Password is stored as varchar(40).) - - - -=item SetPassword VALUE - - -Set Password to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Password will be stored as a varchar(40).) - - -=cut - - -=item Comments - -Returns the current value of Comments. -(In the database, Comments is stored as blob.) - - - -=item SetComments VALUE - - -Set Comments to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Comments will be stored as a blob.) - - -=cut - - -=item Signature - -Returns the current value of Signature. -(In the database, Signature is stored as blob.) - - - -=item SetSignature VALUE - - -Set Signature to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Signature will be stored as a blob.) - - -=cut - - -=item EmailAddress - -Returns the current value of EmailAddress. -(In the database, EmailAddress is stored as varchar(120).) - - - -=item SetEmailAddress VALUE - - -Set EmailAddress to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, EmailAddress will be stored as a varchar(120).) - - -=cut - - -=item FreeformContactInfo - -Returns the current value of FreeformContactInfo. -(In the database, FreeformContactInfo is stored as blob.) - - - -=item SetFreeformContactInfo VALUE - - -Set FreeformContactInfo to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, FreeformContactInfo will be stored as a blob.) - - -=cut - - -=item Organization - -Returns the current value of Organization. -(In the database, Organization is stored as varchar(200).) - - - -=item SetOrganization VALUE - - -Set Organization to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Organization will be stored as a varchar(200).) - - -=cut - - -=item RealName - -Returns the current value of RealName. -(In the database, RealName is stored as varchar(120).) - - - -=item SetRealName VALUE - - -Set RealName to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, RealName will be stored as a varchar(120).) - - -=cut - - -=item NickName - -Returns the current value of NickName. -(In the database, NickName is stored as varchar(16).) - - - -=item SetNickName VALUE - - -Set NickName to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, NickName will be stored as a varchar(16).) - - -=cut - - -=item Lang - -Returns the current value of Lang. -(In the database, Lang is stored as varchar(16).) - - - -=item SetLang VALUE - - -Set Lang to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Lang will be stored as a varchar(16).) - - -=cut - - -=item EmailEncoding - -Returns the current value of EmailEncoding. -(In the database, EmailEncoding is stored as varchar(16).) - - +sub Create { + my $self = shift; + my %args = (Privileged => 0, + @_ # get the real argumentlist + ); + + #Check the ACL + unless ($self->CurrentUserHasRight('AdminUsers')) { + return (0, 'No permission to create users'); + } + + if (! $args{'Password'}) { + $args{'Password'} = '*NO-PASSWORD*'; + } + elsif (length($args{'Password'}) < $RT::MinimumPasswordLength) { + return(0,"Password too short"); + } + else { + my $salt = join '', ('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]; + $args{'Password'} = crypt($args{'Password'}, $salt); + } + + + #TODO Specify some sensible defaults. + + unless (defined ($args{'Name'})) { + return(0, "Must specify 'Name' attribute"); + } + + + #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN + if ($RT::SystemUser) { #This only works if RT::SystemUser has been defined + my $TempUser = RT::User->new($RT::SystemUser); + $TempUser->Load($args{'Name'}); + return (0, 'Name in use') if ($TempUser->Id); + + return(0, 'Email address in use') + unless ($self->ValidateEmailAddress($args{'EmailAddress'})); + } + else { + $RT::Logger->warning("$self couldn't check for pre-existing ". + " users on create. This will happen". + " on installation\n"); + } + + my $id = $self->SUPER::Create(%args); + + #If the create failed. + unless ($id) { + return (0, 'Could not create user'); + } + + + #TODO post 2.0 + #if ($args{'SendWelcomeMessage'}) { + # #TODO: Check if the email exists and looks valid + # #TODO: Send the user a "welcome message" + #} + + return ($id, 'User created'); +} -=item SetEmailEncoding VALUE +# }}} +# {{{ sub _BootstrapCreate -Set EmailEncoding to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, EmailEncoding will be stored as a varchar(16).) +#create a user without validating _any_ data. +#To be used only on database init. -=cut +sub _BootstrapCreate { + my $self = shift; + my %args = (@_); + $args{'Password'} = "*NO-PASSWORD*"; + my $id = $self->SUPER::Create(%args); + + #If the create failed. + return (0, 'Could not create user') + unless ($id); -=item WebEncoding + return ($id, 'User created'); +} -Returns the current value of WebEncoding. -(In the database, WebEncoding is stored as varchar(16).) +# }}} +# {{{ sub Delete +sub Delete { + my $self = shift; + + return(0, 'Deleting this object would violate referential integrity'); + +} -=item SetWebEncoding VALUE +# }}} +# {{{ sub Load -Set WebEncoding to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, WebEncoding will be stored as a varchar(16).) +=head2 Load +Load a user object from the database. Takes a single argument. +If the argument is numerical, load by the column 'id'. Otherwise, load by +the "Name" column which is the user's textual username. =cut +sub Load { + my $self = shift; + my $identifier = shift || return undef; + + #if it's an int, load by id. otherwise, load by name. + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol("Name",$identifier); + } +} -=item ExternalContactInfoId - -Returns the current value of ExternalContactInfoId. -(In the database, ExternalContactInfoId is stored as varchar(100).) - +# }}} -=item SetExternalContactInfoId VALUE +# {{{ sub LoadByEmail +=head2 LoadByEmail -Set ExternalContactInfoId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ExternalContactInfoId will be stored as a varchar(100).) +Tries to load this user object from the database by the user's email address. =cut +sub LoadByEmail { + my $self=shift; + my $address = shift; -=item ContactInfoSystem - -Returns the current value of ContactInfoSystem. -(In the database, ContactInfoSystem is stored as varchar(30).) - + # Never load an empty address as an email address. + unless ($address) { + return(undef); + } + $address = RT::CanonicalizeAddress($address); + #$RT::Logger->debug("Trying to load an email address: $address\n"); + return $self->LoadByCol("EmailAddress", $address); +} +# }}} -=item SetContactInfoSystem VALUE +# {{{ sub ValidateEmailAddress -Set ContactInfoSystem to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ContactInfoSystem will be stored as a varchar(30).) +=head2 ValidateEmailAddress ADDRESS +Returns true if the email address entered is not in use by another user or is +undef or ''. Returns false if it's in use. =cut +sub ValidateEmailAddress { + my $self = shift; + my $Value = shift; -=item ExternalAuthId - -Returns the current value of ExternalAuthId. -(In the database, ExternalAuthId is stored as varchar(100).) - + # if the email address is null, it's always valid + return (1) if(!$Value || $Value eq ""); + my $TempUser = RT::User->new($RT::SystemUser); + $TempUser->LoadByEmail($Value); -=item SetExternalAuthId VALUE - - -Set ExternalAuthId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ExternalAuthId will be stored as a varchar(100).) - - -=cut - - -=item AuthSystem + if( $TempUser->id && + ($TempUser->id != $self->id)) { # if we found a user with that address + # it's invalid to set this user's address to it + return(undef); + } + else { #it's a valid email address + return(1); + } +} -Returns the current value of AuthSystem. -(In the database, AuthSystem is stored as varchar(30).) +# }}} -=item SetAuthSystem VALUE +# {{{ sub SetRandomPassword -Set AuthSystem to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, AuthSystem will be stored as a varchar(30).) +=head2 SetRandomPassword +Takes no arguments. Returns a status code and a new password or an error message. +If the status is 1, the second value returned is the new password. +If the status is anything else, the new value returned is the error code. =cut - -=item Gecos - -Returns the current value of Gecos. -(In the database, Gecos is stored as varchar(16).) - - - -=item SetGecos VALUE - - -Set Gecos to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Gecos will be stored as a varchar(16).) - - -=cut +sub SetRandomPassword { + my $self = shift; -=item HomePhone + unless ($self->CurrentUserCanModify('Password')) { + return (0, "Permission Denied"); + } + + my $pass = $self->GenerateRandomPassword(6,8); -Returns the current value of HomePhone. -(In the database, HomePhone is stored as varchar(30).) + # If we have "notify user on + my ($val, $msg) = $self->SetPassword($pass); + + #If we got an error return the error. + return (0, $msg) unless ($val); + + #Otherwise, we changed the password, lets return it. + return (1, $pass); + +} +# }}} -=item SetHomePhone VALUE +# {{{ sub ResetPassword -Set HomePhone to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, HomePhone will be stored as a varchar(30).) +=head2 ResetPassword +Returns status, [ERROR or new password]. Resets this user\'s password to +a randomly generated pronouncable password and emails them, using a +global template called "RT_PasswordChange", which can be overridden +with global templates "RT_PasswordChange_Privileged" or "RT_PasswordChange_NonPrivileged" +for privileged and Non-privileged users respectively. =cut - -=item WorkPhone - -Returns the current value of WorkPhone. -(In the database, WorkPhone is stored as varchar(30).) - +sub ResetPassword { + my $self = shift; + + unless ($self->CurrentUserCanModify('Password')) { + return (0, "Permission Denied"); + } + my ($status, $pass) = $self->SetRandomPassword(); + + unless ($status) { + return (0, "$pass"); + } + + my $template = RT::Template->new($self->CurrentUser); + + + if ($self->IsPrivileged) { + $template->LoadGlobalTemplate('RT_PasswordChange_Privileged'); + } + else { + $template->LoadGlobalTemplate('RT_PasswordChange_Privileged'); + } + + unless ($template->Id) { + $template->LoadGlobalTemplate('RT_PasswordChange'); + } + + unless ($template->Id) { + $RT::Logger->crit("$self tried to send ".$self->Name." a password reminder ". + "but couldn't find a password change template"); + } + + my $notification = RT::Action::SendPasswordEmail->new(TemplateObj => $template, + Argument => $pass); + + $notification->SetTo($self->EmailAddress); + + my ($ret); + $ret = $notification->Prepare(); + if ($ret) { + $ret = $notification->Commit(); + } + + if ($ret) { + return(1, 'New password notification sent'); + } else { + return (0, 'Notification could not be sent'); + } + +} -=item SetWorkPhone VALUE +# }}} +# {{{ sub GenerateRandomPassword -Set WorkPhone to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, WorkPhone will be stored as a varchar(30).) +=head2 GenerateRandomPassword MIN_LEN and MAX_LEN +Returns a random password between MIN_LEN and MAX_LEN characters long. =cut - -=item MobilePhone - -Returns the current value of MobilePhone. -(In the database, MobilePhone is stored as varchar(30).) +sub GenerateRandomPassword { + my $self = shift; + my $min_length = shift; + my $max_length = shift; + + #This code derived from mpw.pl, a bit of code with a sordid history + # Its notes: + + # Perl cleaned up a bit by Jesse Vincent 1/14/2001. + # Converted to perl from C by Marc Horowitz, 1/20/2000. + # Converted to C from Multics PL/I by Bill Sommerfeld, 4/21/86. + # Original PL/I version provided by Jerry Saltzer. + + + my ($frequency, $start_freq, $total_sum, $row_sums); + + #When munging characters, we need to know where to start counting letters from + my $a = ord('a'); + + # frequency of English digraphs (from D Edwards 1/27/66) + $frequency = + [ [ 4, 20, 28, 52, 2, 11, 28, 4, 32, 4, 6, 62, 23, + 167, 2, 14, 0, 83, 76, 127, 7, 25, 8, 1, 9, 1 ], # aa - az + [ 13, 0, 0, 0, 55, 0, 0, 0, 8, 2, 0, 22, 0, + 0, 11, 0, 0, 15, 4, 2, 13, 0, 0, 0, 15, 0 ], # ba - bz + [ 32, 0, 7, 1, 69, 0, 0, 33, 17, 0, 10, 9, 1, + 0, 50, 3, 0, 10, 0, 28, 11, 0, 0, 0, 3, 0 ], # ca - cz + [ 40, 16, 9, 5, 65, 18, 3, 9, 56, 0, 1, 4, 15, + 6, 16, 4, 0, 21, 18, 53, 19, 5, 15, 0, 3, 0 ], # da - dz + [ 84, 20, 55, 125, 51, 40, 19, 16, 50, 1, 4, 55, 54, + 146, 35, 37, 6, 191, 149, 65, 9, 26, 21, 12, 5, 0 ], # ea - ez + [ 19, 3, 5, 1, 19, 21, 1, 3, 30, 2, 0, 11, 1, + 0, 51, 0, 0, 26, 8, 47, 6, 3, 3, 0, 2, 0 ], # fa - fz + [ 20, 4, 3, 2, 35, 1, 3, 15, 18, 0, 0, 5, 1, + 4, 21, 1, 1, 20, 9, 21, 9, 0, 5, 0, 1, 0 ], # ga - gz + [ 101, 1, 3, 0, 270, 5, 1, 6, 57, 0, 0, 0, 3, + 2, 44, 1, 0, 3, 10, 18, 6, 0, 5, 0, 3, 0 ], # ha - hz + [ 40, 7, 51, 23, 25, 9, 11, 3, 0, 0, 2, 38, 25, + 202, 56, 12, 1, 46, 79, 117, 1, 22, 0, 4, 0, 3 ], # ia - iz + [ 3, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 0, + 0, 4, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0 ], # ja - jz + [ 1, 0, 0, 0, 11, 0, 0, 0, 13, 0, 0, 0, 0, + 2, 0, 0, 0, 0, 6, 2, 1, 0, 2, 0, 1, 0 ], # ka - kz + [ 44, 2, 5, 12, 62, 7, 5, 2, 42, 1, 1, 53, 2, + 2, 25, 1, 1, 2, 16, 23, 9, 0, 1, 0, 33, 0 ], # la - lz + [ 52, 14, 1, 0, 64, 0, 0, 3, 37, 0, 0, 0, 7, + 1, 17, 18, 1, 2, 12, 3, 8, 0, 1, 0, 2, 0 ], # ma - mz + [ 42, 10, 47, 122, 63, 19, 106, 12, 30, 1, 6, 6, 9, + 7, 54, 7, 1, 7, 44, 124, 6, 1, 15, 0, 12, 0 ], # na - nz + [ 7, 12, 14, 17, 5, 95, 3, 5, 14, 0, 0, 19, 41, + 134, 13, 23, 0, 91, 23, 42, 55, 16, 28, 0, 4, 1 ], # oa - oz + [ 19, 1, 0, 0, 37, 0, 0, 4, 8, 0, 0, 15, 1, + 0, 27, 9, 0, 33, 14, 7, 6, 0, 0, 0, 0, 0 ], # pa - pz + [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0 ], # qa - qz + [ 83, 8, 16, 23, 169, 4, 8, 8, 77, 1, 10, 5, 26, + 16, 60, 4, 0, 24, 37, 55, 6, 11, 4, 0, 28, 0 ], # ra - rz + [ 65, 9, 17, 9, 73, 13, 1, 47, 75, 3, 0, 7, 11, + 12, 56, 17, 6, 9, 48, 116, 35, 1, 28, 0, 4, 0 ], # sa - sz + [ 57, 22, 3, 1, 76, 5, 2, 330, 126, 1, 0, 14, 10, + 6, 79, 7, 0, 49, 50, 56, 21, 2, 27, 0, 24, 0 ], # ta - tz + [ 11, 5, 9, 6, 9, 1, 6, 0, 9, 0, 1, 19, 5, + 31, 1, 15, 0, 47, 39, 31, 0, 3, 0, 0, 0, 0 ], # ua - uz + [ 7, 0, 0, 0, 72, 0, 0, 0, 28, 0, 0, 0, 0, + 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0 ], # va - vz + [ 36, 1, 1, 0, 38, 0, 0, 33, 36, 0, 0, 4, 1, + 8, 15, 0, 0, 0, 4, 2, 0, 0, 1, 0, 0, 0 ], # wa - wz + [ 1, 0, 2, 0, 0, 1, 0, 0, 3, 0, 0, 0, 0, + 0, 1, 5, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0 ], # xa - xz + [ 14, 5, 4, 2, 7, 12, 12, 6, 10, 0, 0, 3, 7, + 5, 17, 3, 0, 4, 16, 30, 0, 0, 5, 0, 0, 0 ], # ya - yz + [ 1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ] ]; # za - zz + + #We need to know the totals for each row + $row_sums = + [ map { my $sum = 0; map { $sum += $_ } @$_; $sum } @$frequency ]; + + + #Frequency with which a given letter starts a word. + $start_freq = + [ 1299, 425, 725, 271, 375, 470, 93, 223, 1009, 24, 20, 355, 379, + 319, 823, 618, 21, 317, 962, 1991, 271, 104, 516, 6, 16, 14 ]; + + $total_sum = 0; map { $total_sum += $_ } @$start_freq; + + + my $length = $min_length + int(rand($max_length-$min_length)); + + my $char = $self->GenerateRandomNextChar($total_sum, $start_freq); + my @word = ($char+$a); + for (2..$length) { + $char = $self->_GenerateRandomNextChar($row_sums->[$char], $frequency->[$char]); + push(@word, $char+$a); + } + + #Return the password + return pack("C*",@word); + +} +#A private helper function for RandomPassword +# Takes a row summary and a frequency chart for the next character to be searched +sub _GenerateRandomNextChar { + my $self = shift; + my($all, $freq) = @_; + my($pos, $i); + + for ($pos = int(rand($all)), $i=0; + $pos >= $freq->[$i]; + $pos -= $freq->[$i], $i++) {}; + + return($i); +} -=item SetMobilePhone VALUE +# }}} +# {{{ sub SetPassword -Set MobilePhone to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, MobilePhone will be stored as a varchar(30).) +=head2 SetPassword +Takes a string. Checks the string's length and sets this user's password +to that string. =cut +sub SetPassword { + my $self = shift; + my $password = shift; + + unless ($self->CurrentUserCanModify('Password')) { + return(0, 'Permission Denied'); + } + + if (! $password) { + return(0, "No password set"); + } + elsif (length($password) < $RT::MinimumPasswordLength) { + return(0,"Password too short"); + } + else { + my $salt = join '', ('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]; + return ( $self->SUPER::SetPassword(crypt($password, $salt)) ); + } + +} -=item PagerPhone - -Returns the current value of PagerPhone. -(In the database, PagerPhone is stored as varchar(30).) - - - -=item SetPagerPhone VALUE +# }}} +# {{{ sub IsPassword -Set PagerPhone to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, PagerPhone will be stored as a varchar(30).) +=head2 IsPassword +Returns true if the passed in value is this user's password. +Returns undef otherwise. =cut +sub IsPassword { + my $self = shift; + my $value = shift; + + #TODO there isn't any apparent way to legitimately ACL this + + # RT does not allow null passwords + if ((!defined ($value)) or ($value eq '')) { + return(undef); + } + if ($self->Disabled) { + $RT::Logger->info("Disabled user ".$self->Name." tried to log in"); + return(undef); + } + + if ( ($self->__Value('Password') eq '') || + ($self->__Value('Password') eq undef) ) { + return(undef); + } + if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))) { + return (1); + } + else { + return (undef); + } +} -=item Address1 - -Returns the current value of Address1. -(In the database, Address1 is stored as varchar(200).) - - - -=item SetAddress1 VALUE - - -Set Address1 to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Address1 will be stored as a varchar(200).) - - -=cut +# }}} +# {{{ sub SetDisabled -=item Address2 +=head2 Sub SetDisabled -Returns the current value of Address2. -(In the database, Address2 is stored as varchar(200).) +Toggles the user's disabled flag. +If this flag is +set, all password checks for this user will fail. All ACL checks for this +user will fail. The user will appear in no user listings. +=cut +# }}} -=item SetAddress2 VALUE +# {{{ ACL Related routines +# {{{ GrantQueueRight -Set Address2 to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Address2 will be stored as a varchar(200).) +=head2 GrantQueueRight +Grant a queue right to this user. Takes a paramhash of which the elements +RightAppliesTo and RightName are important. =cut +sub GrantQueueRight { + + my $self = shift; + my %args = ( RightScope => 'Queue', + RightName => undef, + RightAppliesTo => undef, + PrincipalType => 'User', + PrincipalId => $self->Id, + @_); + + #ACL check handled in ACE.pm + + require RT::ACE; + +# $RT::Logger->debug("$self ->GrantQueueRight right:". $args{'RightName'} . +# " applies to queue ".$args{'RightAppliesTo'}."\n"); + + my $ace = new RT::ACE($self->CurrentUser); + + return ($ace->Create(%args)); +} -=item City - -Returns the current value of City. -(In the database, City is stored as varchar(100).) - - - -=item SetCity VALUE +# }}} +# {{{ GrantSystemRight -Set City to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, City will be stored as a varchar(100).) +=head2 GrantSystemRight +Grant a system right to this user. +The only element that's important to set is RightName. =cut +sub GrantSystemRight { + + my $self = shift; + my %args = ( RightScope => 'System', + RightName => undef, + RightAppliesTo => 0, + PrincipalType => 'User', + PrincipalId => $self->Id, + @_); + + + #ACL check handled in ACE.pm + + require RT::ACE; + my $ace = new RT::ACE($self->CurrentUser); + + return ($ace->Create(%args)); +} -=item State - -Returns the current value of State. -(In the database, State is stored as varchar(100).) +# }}} +# {{{ sub HasQueueRight +=head2 HasQueueRight -=item SetState VALUE +Takes a paramhash which can contain +these items: + TicketObj => RT::Ticket or QueueObj => RT::Queue or Queue => integer + IsRequestor => undef, (for bootstrapping create) + Right => 'Right' -Set State to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, State will be stored as a varchar(100).) +Returns 1 if this user has the right specified in the paramhash. for the queue +passed in. +Returns undef if they don't =cut +sub HasQueueRight { + my $self = shift; + my %args = ( TicketObj => undef, + QueueObj => undef, + Queue => undef, + IsRequestor => undef, + Right => undef, + @_); + + my ($IsRequestor, $IsCc, $IsAdminCc, $IsOwner); + + if (defined $args{'Queue'}) { + $args{'QueueObj'} = new RT::Queue($self->CurrentUser); + $args{'QueueObj'}->Load($args{'Queue'}); + } + + if (defined $args{'TicketObj'}) { + $args{'QueueObj'} = $args{'TicketObj'}->QueueObj(); + } + + # {{{ Validate and load up the QueueId + unless ((defined $args{'QueueObj'}) and ($args{'QueueObj'}->Id)) { + require Carp; + $RT::Logger->debug(Carp::cluck ("$self->HasQueueRight Couldn't find a queue id")); + return undef; + } + + # }}} + + + # Figure out whether a user has the right we're asking about. + # first see if they have the right personally for the queue in question. + my $retval = $self->_HasRight(Scope => 'Queue', + AppliesTo => $args{'QueueObj'}->Id, + Right => $args{'Right'}, + IsOwner => $IsOwner); + + return ($retval) if (defined $retval); + + # then we see whether they have the right personally globally. + $retval = $self->HasSystemRight( $args{'Right'}); + + return ($retval) if (defined $retval); + + # now that we know they don't have the right personally, + + # {{{ Find out about whether the current user is a Requestor, Cc, AdminCc or Owner + + if (defined $args{'TicketObj'}) { + if ($args{'TicketObj'}->IsRequestor($self)) {#user is requestor + $IsRequestor = 1; + } + + if ($args{'TicketObj'}->IsCc($self)) { #If user is a cc + $IsCc = 1; + } + + if ($args{'TicketObj'}->IsAdminCc($self)) { #If user is an admin cc + $IsAdminCc = 1; + } + + if ($args{'TicketObj'}->IsOwner($self)) { #If user is an owner + $IsOwner = 1; + } + } + + if (defined $args{'QueueObj'}) { + if ($args{'QueueObj'}->IsCc($self)) { #If user is a cc + $IsCc = 1; + } + if ($args{'QueueObj'}->IsAdminCc($self)) { #If user is an admin cc + $IsAdminCc = 1; + } + + } + # }}} + + # then see whether they have the right for the queue as a member of a metagroup + + $retval = $self->_HasRight(Scope => 'Queue', + AppliesTo => $args{'QueueObj'}->Id, + Right => $args{'Right'}, + IsOwner => $IsOwner, + IsCc => $IsCc, + IsAdminCc => $IsAdminCc, + IsRequestor => $IsRequestor + ); + + return ($retval) if (defined $retval); + + # then we see whether they have the right globally as a member of a metagroup + $retval = $self->HasSystemRight( $args{'Right'}, + (IsOwner => $IsOwner, + IsCc => $IsCc, + IsAdminCc => $IsAdminCc, + IsRequestor => $IsRequestor + ) ); + + #If they haven't gotten it by now, they just lose. + return ($retval); + +} -=item Zip - -Returns the current value of Zip. -(In the database, Zip is stored as varchar(16).) - - - -=item SetZip VALUE +# }}} + +# {{{ sub HasSystemRight +=head2 HasSystemRight -Set Zip to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Zip will be stored as a varchar(16).) +takes an array of a single value and a paramhash. +The single argument is the right being passed in. +the param hash is some additional data. (IsCc, IsOwner, IsAdminCc and IsRequestor) +Returns 1 if this user has the listed 'right'. Returns undef if this user doesn't. =cut +sub HasSystemRight { + my $self = shift; + my $right = shift; + + my %args = ( IsOwner => undef, + IsCc => undef, + IsAdminCc => undef, + IsRequestor => undef, + @_); + + unless (defined $right) { + + $RT::Logger->debug("$self RT::User::HasSystemRight was passed in no right."); + return(undef); + } + return ( $self->_HasRight ( Scope => 'System', + AppliesTo => '0', + Right => $right, + IsOwner => $args{'IsOwner'}, + IsCc => $args{'IsCc'}, + IsAdminCc => $args{'IsAdminCc'}, + IsRequestor => $args{'IsRequestor'}, + + ) + ); + +} -=item Country - -Returns the current value of Country. -(In the database, Country is stored as varchar(50).) - - - -=item SetCountry VALUE - - -Set Country to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Country will be stored as a varchar(50).) - +# }}} -=cut +# {{{ sub _HasRight +=head2 sub _HasRight (Right => 'right', Scope => 'scope', AppliesTo => int, ExtendedPrincipals => SQL) -=item Timezone +_HasRight is a private helper method for checking a user's rights. It takes +several options: -Returns the current value of Timezone. -(In the database, Timezone is stored as varchar(50).) +=item Right is a textual right name +=item Scope is a textual scope name. (As of July these were Queue, Ticket and System +=item AppliesTo is the numerical Id of the object identified in the scope. For tickets, this is the queue #. for queues, this is the queue # -=item SetTimezone VALUE +=item ExtendedPrincipals is an SQL select clause which assumes that the only +table in play is ACL. It's used by HasQueueRight to pass in which +metaprincipals apply. Actually, it's probably obsolete. TODO: remove it. +Returns 1 if a matching ACE was found. -Set Timezone to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Timezone will be stored as a varchar(50).) - +Returns undef if no ACE was found. =cut -=item PGPKey - -Returns the current value of PGPKey. -(In the database, PGPKey is stored as text.) - - +sub _HasRight { + + my $self = shift; + my %args = ( Right => undef, + Scope => undef, + AppliesTo => undef, + IsRequestor => undef, + IsCc => undef, + IsAdminCc => undef, + IsOwner => undef, + ExtendedPrincipals => undef, + @_); + + if ($self->Disabled) { + $RT::Logger->debug ("Disabled User: ".$self->Name. + " failed access check for ".$args{'Right'}. + " to object ".$args{'Scope'}."/". + $args{'AppliesTo'}."\n"); + return (undef); + } + + if (!defined $args{'Right'}) { + $RT::Logger->debug("_HasRight called without a right\n"); + return(undef); + } + elsif (!defined $args{'Scope'}) { + $RT::Logger->debug("_HasRight called without a scope\n"); + return(undef); + } + elsif (!defined $args{'AppliesTo'}) { + $RT::Logger->debug("_HasRight called without an AppliesTo object\n"); + return(undef); + } + + #If we've cached a win or loss for this lookup say so + + #TODO Security +++ check to make sure this is complete and right + + #Construct a hashkey to cache decisions in + my ($hashkey); + { #it's ugly, but we need to turn off warning, cuz we're joining nulls. + local $^W=0; + $hashkey =$self->Id .":". join(':',%args); + } + + # $RT::Logger->debug($hashkey."\n"); + + #Anything older than 10 seconds needs to be rechecked + my $cache_timeout = (time - 10); + + + if ((defined $self->{'rights'}{"$hashkey"}) && + ($self->{'rights'}{"$hashkey"} == 1 ) && + (defined $self->{'rights'}{"$hashkey"}{'set'} ) && + ($self->{'rights'}{"$hashkey"}{'set'} > $cache_timeout)) { +# $RT::Logger->debug("Cached ACL win for ". +# $args{'Right'}.$args{'Scope'}. +# $args{'AppliesTo'}."\n"); + return ($self->{'rights'}{"$hashkey"}); + } + elsif ((defined $self->{'rights'}{"$hashkey"}) && + ($self->{'rights'}{"$hashkey"} == -1) && + (defined $self->{'rights'}{"$hashkey"}{'set'}) && + ($self->{'rights'}{"$hashkey"}{'set'} > $cache_timeout)) { + +# $RT::Logger->debug("Cached ACL loss decision for ". +# $args{'Right'}.$args{'Scope'}. +# $args{'AppliesTo'}."\n"); + + return(undef); + } + + + my $RightClause = "(RightName = '$args{'Right'}')"; + my $ScopeClause = "(RightScope = '$args{'Scope'}')"; + + #If an AppliesTo was passed in, we should pay attention to it. + #otherwise, none is needed + + $ScopeClause = "($ScopeClause AND (RightAppliesTo = $args{'AppliesTo'}))" + if ($args{'AppliesTo'}); + + + # The generic principals clause looks for users with my id + # and Rights that apply to _everyone_ + my $PrincipalsClause = "((PrincipalType = 'User') AND (PrincipalId = ".$self->Id."))"; + + + # If the user is the superuser, grant them the damn right ;) + my $SuperUserClause = + "(RightName = 'SuperUser') AND (RightScope = 'System') AND (RightAppliesTo = 0)"; + + # If we've been passed in an extended principals clause, we should lump it + # on to the existing principals clause. it'll make life easier + if ($args{'ExtendedPrincipals'}) { + $PrincipalsClause = "(($PrincipalsClause) OR ". + "($args{'ExtendedPrincipalsClause'}))"; + } + + my $GroupPrincipalsClause = "((ACL.PrincipalType = 'Group') ". + "AND (ACL.PrincipalId = Groups.Id) AND (GroupMembers.GroupId = Groups.Id) ". + " AND (GroupMembers.UserId = ".$self->Id."))"; + + + + + # {{{ A bunch of magic statements that make the metagroups listed + # work. basically, we if the user falls into the right group, + # we add the type of ACL check needed + my (@MetaPrincipalsSubClauses, $MetaPrincipalsClause); + + #The user is always part of the 'Everyone' Group + push (@MetaPrincipalsSubClauses, "((Groups.Name = 'Everyone') AND + (PrincipalType = 'Group') AND + (Groups.Id = PrincipalId))"); + + if ($args{'IsAdminCc'}) { + push (@MetaPrincipalsSubClauses, "((Groups.Name = 'AdminCc') AND + (PrincipalType = 'Group') AND + (Groups.Id = PrincipalId))"); + } + if ($args{'IsCc'}) { + push (@MetaPrincipalsSubClauses, " ((Groups.Name = 'Cc') AND + (PrincipalType = 'Group') AND + (Groups.Id = PrincipalId))"); + } + if ($args{'IsRequestor'}) { + push (@MetaPrincipalsSubClauses, " ((Groups.Name = 'Requestor') AND + (PrincipalType = 'Group') AND + (Groups.Id = PrincipalId))"); + } + if ($args{'IsOwner'}) { + + push (@MetaPrincipalsSubClauses, " ((Groups.Name = 'Owner') AND + (PrincipalType = 'Group') AND + (Groups.Id = PrincipalId))"); + } + + # }}} + + my ($GroupRightsQuery, $MetaGroupRightsQuery, $IndividualRightsQuery, $hitcount); + + # {{{ If there are any metaprincipals to be checked + if (@MetaPrincipalsSubClauses) { + #chop off the leading or + #TODO redo this with an array and a join + $MetaPrincipalsClause = join (" OR ", @MetaPrincipalsSubClauses); + + $MetaGroupRightsQuery = "SELECT COUNT(ACL.id) FROM ACL, Groups". + " WHERE " . + " ($ScopeClause) AND ($RightClause) AND ($MetaPrincipalsClause)"; + + # {{{ deal with checking if the user has a right as a member of a metagroup + +# $RT::Logger->debug("Now Trying $MetaGroupRightsQuery\n"); + $hitcount = $self->_Handle->FetchResult($MetaGroupRightsQuery); + + #if there's a match, the right is granted + if ($hitcount) { + $self->{'rights'}{"$hashkey"}{'set'} = time; + $self->{'rights'}{"$hashkey"} = 1; + return (1); + } + +# $RT::Logger->debug("No ACL matched MetaGroups query: $MetaGroupRightsQuery\n"); + + # }}} + + } + # }}} + + # {{{ deal with checking if the user has a right as a member of a group + # This query checks to se whether the user has the right as a member of a + # group + $GroupRightsQuery = "SELECT COUNT(ACL.id) FROM ACL, GroupMembers, Groups". + " WHERE " . + " (((($ScopeClause) AND ($RightClause)) OR ($SuperUserClause)) ". + " AND ($GroupPrincipalsClause))"; + + # $RT::Logger->debug("Now Trying $GroupRightsQuery\n"); + $hitcount = $self->_Handle->FetchResult($GroupRightsQuery); + + #if there's a match, the right is granted + if ($hitcount) { + $self->{'rights'}{"$hashkey"}{'set'} = time; + $self->{'rights'}{"$hashkey"} = 1; + return (1); + } + +# $RT::Logger->debug("No ACL matched $GroupRightsQuery\n"); + + # }}} + + # {{{ Check to see whether the user has a right as an individual + + # This query checks to see whether the current user has the right directly + $IndividualRightsQuery = "SELECT COUNT(ACL.id) FROM ACL WHERE ". + " ((($ScopeClause) AND ($RightClause)) OR ($SuperUserClause)) " . + " AND ($PrincipalsClause)"; + + + $hitcount = $self->_Handle->FetchResult($IndividualRightsQuery); + + if ($hitcount) { + $self->{'rights'}{"$hashkey"}{'set'} = time; + $self->{'rights'}{"$hashkey"} = 1; + return (1); + } + # }}} + + else { #If the user just doesn't have the right + +# $RT::Logger->debug("No ACL matched $IndividualRightsQuery\n"); + + #If nothing matched, return 0. + $self->{'rights'}{"$hashkey"}{'set'} = time; + $self->{'rights'}{"$hashkey"} = -1; + + + return (undef); + } +} -=item SetPGPKey VALUE +# }}} +# {{{ sub CurrentUserCanModify -Set PGPKey to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, PGPKey will be stored as a text.) +=head2 CurrentUserCanModify RIGHT +If the user has rights for this object, either because +he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an +admin right) 'ModifySelf', return 1. otherwise, return undef. =cut +sub CurrentUserCanModify { + my $self = shift; + my $right = shift; + + if ($self->CurrentUserHasRight('AdminUsers')) { + return (1); + } + #If the field is marked as an "administrators only" field, + # don\'t let the user touch it. + elsif ($self->_Accessible($right, 'admin')) { + return(undef); + } + + #If the current user is trying to modify themselves + elsif ( ($self->id == $self->CurrentUser->id) and + ($self->CurrentUserHasRight('ModifySelf'))) { + return(1); + } + + #If we don\'t have a good reason to grant them rights to modify + # by now, they lose + else { + return(undef); + } + +} -=item Creator +# }}} -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) +# {{{ sub CurrentUserHasRight +=head2 CurrentUserHasRight + + Takes a single argument. returns 1 if $Self->CurrentUser + has the requested right. returns undef otherwise =cut +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return ($self->CurrentUser->HasSystemRight($right)); +} -=item Created +# }}} -Returns the current value of Created. -(In the database, Created is stored as datetime.) +# {{{ sub _Set -=cut +sub _Set { + my $self = shift; + + my %args = (Field => undef, + Value => undef, + @_ + ); + # Nobody is allowed to futz with RT_System or Nobody unless they + # want to change an email address. For 2.2, neither should have an email address -=item LastUpdatedBy + if ($self->Privileged == 2) { + return (0, "Can not modify system users"); + } + unless ($self->CurrentUserCanModify($args{'Field'})) { + return (0, "Permission Denied"); + } -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) + + #Set the new value + my ($ret, $msg)=$self->SUPER::_Set(Field => $args{'Field'}, + Value=> $args{'Value'}); + + return ($ret, $msg); +} -=cut - +# }}} -=item LastUpdated +# {{{ sub _Value -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) +=head2 _Value +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check =cut +sub _Value { + + my $self = shift; + my $field = shift; + + #If the current user doesn't have ACLs, don't let em at it. + + my @PublicFields = qw( Name EmailAddress Organization Disabled + RealName NickName Gecos ExternalAuthId + AuthSystem ExternalContactInfoId + ContactInfoSystem ); + + #if the field is public, return it. + if ($self->_Accessible($field, 'public')) { + return($self->SUPER::_Value($field)); + + } + #If the user wants to see their own values, let them + elsif ($self->CurrentUser->Id == $self->Id) { + return($self->SUPER::_Value($field)); + } + #If the user has the admin users right, return the field + elsif ($self->CurrentUserHasRight('AdminUsers')) { + return($self->SUPER::_Value($field)); + } + else { + return(undef); + } + +} -sub _ClassAccessible { - { - - id => - {read => 1, type => 'int(11)', default => ''}, - Name => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Password => - {read => 1, write => 1, type => 'varchar(40)', default => ''}, - Comments => - {read => 1, write => 1, type => 'blob', default => ''}, - Signature => - {read => 1, write => 1, type => 'blob', default => ''}, - EmailAddress => - {read => 1, write => 1, type => 'varchar(120)', default => ''}, - FreeformContactInfo => - {read => 1, write => 1, type => 'blob', default => ''}, - Organization => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - RealName => - {read => 1, write => 1, type => 'varchar(120)', default => ''}, - NickName => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - Lang => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - EmailEncoding => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - WebEncoding => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - ExternalContactInfoId => - {read => 1, write => 1, type => 'varchar(100)', default => ''}, - ContactInfoSystem => - {read => 1, write => 1, type => 'varchar(30)', default => ''}, - ExternalAuthId => - {read => 1, write => 1, type => 'varchar(100)', default => ''}, - AuthSystem => - {read => 1, write => 1, type => 'varchar(30)', default => ''}, - Gecos => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - HomePhone => - {read => 1, write => 1, type => 'varchar(30)', default => ''}, - WorkPhone => - {read => 1, write => 1, type => 'varchar(30)', default => ''}, - MobilePhone => - {read => 1, write => 1, type => 'varchar(30)', default => ''}, - PagerPhone => - {read => 1, write => 1, type => 'varchar(30)', default => ''}, - Address1 => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - Address2 => - {read => 1, write => 1, type => 'varchar(200)', default => ''}, - City => - {read => 1, write => 1, type => 'varchar(100)', default => ''}, - State => - {read => 1, write => 1, type => 'varchar(100)', default => ''}, - Zip => - {read => 1, write => 1, type => 'varchar(16)', default => ''}, - Country => - {read => 1, write => 1, type => 'varchar(50)', default => ''}, - Timezone => - {read => 1, write => 1, type => 'varchar(50)', default => ''}, - PGPKey => - {read => 1, write => 1, type => 'text', default => ''}, - Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, - - } -}; - - - eval "require RT::User_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/User_Overlay.pm}) { - die $@; - }; - - eval "require RT::User_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/User_Vendor.pm}) { - die $@; - }; - - eval "require RT::User_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/User_Local.pm}) { - die $@; - }; - - - - -=head1 SEE ALSO - -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -RT::User_Overlay, RT::User_Vendor, RT::User_Local - -=cut - +# }}} +# }}} 1; + diff --git a/rt/lib/RT/Users.pm b/rt/lib/RT/Users.pm index d58f69653..f4a97268c 100755 --- a/rt/lib/RT/Users.pm +++ b/rt/lib/RT/Users.pm @@ -1,115 +1,281 @@ -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Users.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-1999 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL =head1 NAME - RT::Users -- Class Description - + RT::Users - Collection of RT::User objects + =head1 SYNOPSIS - use RT::Users + use RT::Users; + =head1 DESCRIPTION =head1 METHODS +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Users); + +=end testing + =cut package RT::Users; +use RT::EasySearch; +@ISA = qw(RT::EasySearch); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Users"; + $self->{'primary_key'} = "id"; + + # By default, order by name + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); + + return ($self->SUPER::_Init(@_)); + +} +# }}} + +# {{{ sub _DoSearch + +=head2 _DoSearch + + A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless +we're explicitly trying to see them. + +=cut + +sub _DoSearch { + my $self = shift; + + #unless we really want to find disabled rows, make sure we\'re only finding enabled ones. + unless($self->{'find_disabled_rows'}) { + $self->LimitToEnabled(); + } + + return($self->SUPER::_DoSearch(@_)); + +} + +# }}} + +# {{{ sub NewItem + +sub NewItem { + my $self = shift; -use RT::SearchBuilder; -use RT::User; + use RT::User; + my $item = new RT::User($self->CurrentUser); + return($item); +} +# }}} + +# {{{ LimitToEmail +=head2 LimitToEmail -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); +Takes one argument. an email address. limits the returned set to +that email address +=cut -sub _Init { +sub LimitToEmail { my $self = shift; - $self->{'table'} = 'Users'; - $self->{'primary_key'} = 'id'; + my $addr = shift; + $self->Limit(FIELD => 'EmailAddress', VALUE => "$addr"); +} + +# }}} + +# {{{ MemberOfGroup + +=head2 MemberOfGroup + +takes one argument, a group id number. Limits the returned set +to members of a given group + +=cut + +sub MemberOfGroup { + my $self = shift; + my $group = shift; + + return ("No group specified") if (!defined $group); + + my $groupalias = $self->NewAlias('GroupMembers'); + + $self->Join( ALIAS1 => 'main', FIELD1 => 'id', + ALIAS2 => "$groupalias", FIELD2 => 'Name'); + + $self->Limit (ALIAS => "$groupalias", + FIELD => 'GroupId', + VALUE => "$group", + OPERATOR => "=" + ); +} + +# }}} + +# {{{ LimitToPrivileged + +=head2 LimitToPrivileged + +Limits to users who can be made members of ACLs and groups +=cut - return ( $self->SUPER::_Init(@_) ); +sub LimitToPrivileged { + my $self = shift; + $self->Limit( FIELD => 'Privileged', + OPERATOR => '=', + VALUE => '1'); } +# }}} + + + +# {{{ LimitToSystem -=item NewItem +=head2 LimitToSystem -Returns an empty new RT::User item +Limits to users who can be granted rights, but who should +never have their rights modified by a user or be made members of groups. =cut -sub NewItem { +sub LimitToSystem { my $self = shift; - return(RT::User->new($self->CurrentUser)); + $self->Limit( FIELD => 'Privileged', + OPERATOR => '=', + VALUE => '2'); } - eval "require RT::Users_Overlay"; - if ($@ && $@ !~ qr{^Can't locate RT/Users_Overlay.pm}) { - die $@; - }; +# }}} + +# {{{ HasQueueRight + +=head2 HasQueueRight + +Takes a queue id as its first argument. Queue Id "0" is treated by RT as "applies to all queues" +Takes a specific right as an optional second argument + +Limits the returned set to users who have rights in the queue specified, personally. If the optional second argument is supplied, limits to users who have been explicitly granted that right. + + + +This should not be used as an ACL check, but only for obtaining lists of +users with explicit rights in a given queue. + +=cut + +sub HasQueueRight { + my $self = shift; + my $queue = shift; + my $right; + + $right = shift if (@_); + - eval "require RT::Users_Vendor"; - if ($@ && $@ !~ qr{^Can't locate RT/Users_Vendor.pm}) { - die $@; - }; + my $acl_alias = $self->NewAlias('ACL'); + $self->Join( ALIAS1 => 'main', FIELD1 => 'id', + ALIAS2 => $acl_alias, FIELD2 => 'PrincipalId'); + $self->Limit (ALIAS => $acl_alias, + FIELD => 'PrincipalType', + OPERATOR => '=', + VALUE => 'User'); - eval "require RT::Users_Local"; - if ($@ && $@ !~ qr{^Can't locate RT/Users_Local.pm}) { - die $@; - }; + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightAppliesTo', + OPERATOR => '=', + VALUE => "$queue"); + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightScope', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => 'Queue'); -=head1 SEE ALSO -This class allows "overlay" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightScope', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => 'Ticket'); -These overlay files can contain new subs or subs to replace existing subs in this module. -If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line + #TODO: is this being initialized properly if the right isn't there? + if (defined ($right)) { + + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightName', + OPERATOR => '=', + VALUE => "$right"); + + + }; - no warnings qw(redefine); -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +} + + + +# }}} + +# {{{ HasSystemRight -RT::Users_Overlay, RT::Users_Vendor, RT::Users_Local +=head2 HasSystemRight + +Takes one optional argument: + The name of a System level right. + +Limits the returned set to users who have been granted system rights, personally. If the optional argument is passed in, limits to users who have been granted the explicit right listed. Please see the note attached to LimitToQueueRights =cut +sub HasSystemRight { + my $self = shift; + my $right = shift if (@_); + my $acl_alias = $self->NewAlias('ACL'); + + + $self->Join( ALIAS1 => 'main', FIELD1 => 'id', + ALIAS2 => $acl_alias, FIELD2 => 'PrincipalId'); + $self->Limit (ALIAS => $acl_alias, + FIELD => 'PrincipalType', + OPERATOR => '=', + VALUE => 'User'); + + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightScope', + OPERATOR => '=', + VALUE => 'System'); + + + #TODO: is this being initialized properly if the right isn't there? + if (defined ($right)) { + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightName', + OPERATOR => '=', + VALUE => "$right"); + + } + + +} + +# }}} 1; + diff --git a/rt/lib/RT/Watcher.pm b/rt/lib/RT/Watcher.pm new file mode 100755 index 000000000..c7c6100cf --- /dev/null +++ b/rt/lib/RT/Watcher.pm @@ -0,0 +1,313 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Watcher.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2001 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Watcher - RT Watcher object + +=head1 SYNOPSIS + + use RT::Watcher; + + +=head1 DESCRIPTION + +This module should never be called directly by client code. it\'s an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Watcher); + +=end testing + +=cut + +package RT::Watcher; +use RT::Record; +@ISA= qw(RT::Record); + + +# {{{ sub _Init + +sub _Init { + my $self = shift; + + $self->{'table'} = "Watchers"; + return ($self->SUPER::_Init(@_)); + +} +# }}} + +# {{{ sub Create + +=head2 Create PARAMHASH + +Create a new watcher object with the following Attributes: + +Scope: Ticket or Queue +Value: Ticket or queue id +Type: Requestor, Cc or AdminCc. Requestor is not supported for a scope of \'Queue\' +Email: The email address of the watcher. If the email address maps to an RT User, this is resolved +to an Owner object instead. +Owner: The RT user id of the \'owner\' of this watcher object. + +=cut + +sub Create { + my $self = shift; + my %args = ( + Owner => undef, + Email => undef, + Value => undef, + Scope => undef, + Type => undef, + Quiet => 0, + @_ # get the real argumentlist + ); + + #Do we have someone this applies to? + unless (($args{'Owner'} =~ /^(\d+)$/) || ($args{'Email'} =~ /\@/)) { + return (0, "No user or email address specified"); + } + + #if we only have an email address, try to resolve it to an owner + if ($args{'Owner'} == 0) { + my $User = new RT::User($RT::SystemUser); + $User->LoadByEmail($args{'Email'}); + if ($User->id) { + $args{'Owner'} = $User->id; + delete $args{'Email'}; + } + } + + + if ($args{'Type'} eq "Requestor" and $args{'Owner'} == 0) { + # Requestors *MUST* have an account + + my $Address = RT::CanonicalizeAddress($args{'Email'}); + + my $NewUser = RT::User->new($RT::SystemUser); + my ($Val, $Message) = + $NewUser->Create(Name => $Address, + EmailAddress => $Address, + RealName => $Address, + Password => undef, + Privileged => 0, + Comments => 'Autocreated on ticket submission' + ); + return (0, "Could not create watcher for requestor") + unless $Val; + if ($NewUser->id) { + $args{'Owner'} = $NewUser->id; + delete $args{'Email'}; + } + } + + + + + #Make sure we\'ve got a valid type + #TODO --- move this to ValidateType + return (0, "Invalid Type") + unless ($args{'Type'} =~ /^(Requestor|Cc|AdminCc)$/i); + + my $id = $self->SUPER::Create(%args); + if ($id) { + return (1,"Interest noted"); + } + else { + return (0, "Error adding watcher"); + } +} +# }}} + +# {{{ sub Load + +=head2 Load ID + + Loads a watcher by the primary key of the watchers table ($Watcher->id) + +=cut + +sub Load { + my $self = shift; + my $identifier = shift; + + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + return (0, "That's not a numerical id"); + } +} + +# }}} + +# {{{ sub LoadByValue + +=head2 LoadByValue PARAMHASH + +LoadByValue takes a parameter hash with the following attributes: + + Email, Owner, Scope, Type, Value + +The same rules enforced at create are enforced by Load. + +Returns a tuple of (retval, msg). Retval is 1 on success and 0 on failure. +msg describes what happened in a human readable form. + +=cut + +sub LoadByValue { + my $self = shift; + my %args = ( Email => undef, + Owner => undef, + Scope => undef, + Type => undef, + Value => undef, + @_); + + #TODO: all this code is being copied from Create. that\'s silly + + #Do we have someone this applies to? + unless (($args{'Owner'} =~ /^(\d*)$/) || ($args{'Email'} =~ /\@/)) { + return (0, "No user or email address specified"); + } + + #if we only have an email address, try to resolve it to an owner + unless ($args{'Owner'}) { + my $User = new RT::User($RT::SystemUser); + $User->LoadByEmail($args{'Email'}); + if ($User->id > 0) { + $args{'Owner'} = $User->id; + delete $args{'Email'}; + } + } + + if ((defined ($args{'Type'})) and + ($args{'Type'} !~ /^(Requestor|Cc|AdminCc)$/i)) { + return (0, "Invalid Type"); + } + if ($args{'Owner'}) { + $self->LoadByCols( Type => $args{'Type'}, + Value => $args{'Value'}, + Owner => $args{'Owner'}, + Scope => $args{'Scope'}, + ); + } + else { + $self->LoadByCols( Type => $args{'Type'}, + Email => $args{'Email'}, + Value => $args{'Value'}, + Scope => $args{'Scope'}, + ); + } + unless ($self->Id) { + return(0, "Couldn\'t find that watcher"); + } + return (1, "Watcher loaded"); +} + +# }}} + +# {{{ sub OwnerObj + +=head2 OwnerObj + +Return an RT Owner Object for this Watcher, if we have one + +=cut + +sub OwnerObj { + my $self = shift; + if (!defined $self->{'OwnerObj'}) { + require RT::User; + $self->{'OwnerObj'} = RT::User->new($self->CurrentUser); + if ($self->Owner) { + $self->{'OwnerObj'}->Load($self->Owner); + } else { + return $RT::Nobody->UserObj; + } + } + return ($self->{'OwnerObj'}); +} +# }}} + +# {{{ sub Email + +=head2 Email + +This custom data accessor does the right thing and returns +the 'Email' attribute of this Watcher object. If that's undefined, +it returns the 'EmailAddress' attribute of its 'Owner' object, which is +an RT::User object. + +=cut + +sub Email { + my $self = shift; + + # IF Email is defined, return that. Otherwise, return the Owner's email address + if (defined($self->__Value('Email'))) { + return ($self->__Value('Email')); + } + elsif ($self->Owner) { + return ($self->OwnerObj->EmailAddress); + } + else { + return ("Data error"); + } +} +# }}} + +# {{{ sub IsUser + +=head2 IsUser + +Returns true if this watcher object is tied to a user object. (IE it +isn't sending to some other email address). +Otherwise, returns undef + +=cut + +sub IsUser { + my $self = shift; + # if this watcher has an email address glued onto it, + # return undef + + if (defined($self->__Value('Email'))) { + return undef; + } + else { + return 1; + } +} + +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Email => 'read/write', + Scope => 'read/write', + Value => 'read/write', + Type => 'read/write', + Quiet => 'read/write', + Owner => 'read/write', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} + +1; + diff --git a/rt/lib/RT/Watchers.pm b/rt/lib/RT/Watchers.pm new file mode 100755 index 000000000..c55adda3f --- /dev/null +++ b/rt/lib/RT/Watchers.pm @@ -0,0 +1,226 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Watchers.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Watchers - Collection of RT Watcher objects + +=head1 SYNOPSIS + + use RT::Watchers; + my $watchers = new RT::Watchers($CurrentUser); + while (my $watcher = $watchers->Next()) { + print $watcher->Id . "is a watcher"; + } + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Watchers); + +=end testing + +=cut + +package RT::Watchers; + +use strict; +use vars qw( @ISA ); + + +require RT::EasySearch; +require RT::Watcher; +@ISA= qw(RT::EasySearch); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "Watchers"; + $self->{'primary_key'} = "id"; + return($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub Limit + +=head2 Limit + + A wrapper around RT::EasySearch::Limit which sets +the default entry aggregator to 'AND' + +=cut + +sub Limit { + my $self = shift; + my %args = ( ENTRYAGGREGATOR => 'AND', + @_); + + $self->SUPER::Limit(%args); +} +# }}} + +# {{{ sub LimitToTicket + +=head2 LimitToTicket + +Takes a single arg which is a ticket id +Limits to watchers of that ticket + +=cut + +sub LimitToTicket { + my $self = shift; + my $ticket = shift; + $self->Limit( ENTRYAGGREGATOR => 'OR', + FIELD => 'Value', + VALUE => $ticket); + $self->Limit (ENTRYAGGREGATOR => 'AND', + FIELD => 'Scope', + VALUE => 'Ticket'); +} +# }}} + +# {{{ sub LimitToQueue + +=head2 LimitToQueue + +Takes a single arg, which is a queue id +Limits to watchers of that queue. + +=cut + +sub LimitToQueue { + my $self = shift; + my $queue = shift; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Value', + VALUE => $queue); + $self->Limit (ENTRYAGGREGATOR => 'AND', + FIELD => 'Scope', + VALUE => 'Queue'); +} +# }}} + +# {{{ sub LimitToType + +=head2 LimitToType + +Takes a single string as its argument. That string is a watcher type +which is one of 'Requestor', 'Cc' or 'AdminCc' +Limits to watchers of that type + +=cut + + +sub LimitToType { + my $self = shift; + my $type = shift; + $self->Limit(FIELD => 'Type', + VALUE => "$type"); +} +# }}} + +# {{{ sub LimitToRequestors + +=head2 LimitToRequestors + +Limits to watchers of type 'Requestor' + +=cut + +sub LimitToRequestors { + my $self = shift; + $self->LimitToType("Requestor"); +} +# }}} + +# {{{ sub LimitToCc + +=head2 LimitToCc + +Limits to watchers of type 'Cc' + +=cut + +sub LimitToCc { + my $self = shift; + $self->LimitToType("Cc"); +} +# }}} + +# {{{ sub LimitToAdminCc + +=head2 LimitToAdminCc + +Limits to watchers of type AdminCc + +=cut + +sub LimitToAdminCc { + my $self = shift; + $self->LimitToType("AdminCc"); +} +# }}} + +# {{{ sub Emails + +=head2 Emails + +# Return a (reference to a) list of emails + +=cut + +sub Emails { + my $self = shift; + my @list; # List is a list of watcher email addresses + + # $watcher is an RT::Watcher object + while (my $watcher=$self->Next()) { + push(@list, $watcher->Email); + } + return \@list; +} +# }}} + +# {{{ sub EmailsAsString + +=head2 EmailsAsString + +# Returns the RT::Watchers->Emails as a comma seperated string + +=cut + +sub EmailsAsString { + my $self = shift; + return(join(", ",@{$self->Emails})); +} +# }}} + +# {{{ sub NewItem + + + +sub NewItem { + my $self = shift; + + use RT::Watcher; + my $item = new RT::Watcher($self->CurrentUser); + return($item); +} +# }}} +1; + + + + |