diff options
Diffstat (limited to 'rt/lib/RT')
56 files changed, 7003 insertions, 14390 deletions
diff --git a/rt/lib/RT/ACE.pm b/rt/lib/RT/ACE.pm index d4681cf44..1501a125e 100755 --- a/rt/lib/RT/ACE.pm +++ b/rt/lib/RT/ACE.pm @@ -1,774 +1,304 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ACE.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::ACE - RT\'s ACE object +=head1 NAME -=head1 SYNOPSIS +RT::ACE - use RT::ACE; - my $ace = new RT::ACE($CurrentUser); +=head1 SYNOPSIS =head1 DESCRIPTION - =head1 METHODS -=begin testing - -ok(require RT::TestHarness); -ok(require RT::ACE); - -=end testing - =cut package RT::ACE; -use RT::Record; -@ISA= qw(RT::Record); - -use vars qw (%SCOPES - %QUEUERIGHTS - %SYSTEMRIGHTS - %LOWERCASERIGHTNAMES - ); - -%SCOPES = ( - System => 'System-level right', - Queue => 'Queue-level right' - ); - -# {{{ 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', +use RT::Record; - 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' - ); +use vars qw( @ISA ); +@ISA= qw( RT::Record ); +sub _Init { + my $self = shift; -# 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 - -%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', - ); - -# }}} - -# {{{ 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; + $self->Table('ACL'); + $self->SUPER::_Init(@_); } -# }}} - -# {{{ 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, +=item Create PARAMHASH -=cut +Create takes a hash of values and creates a row in the database: -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"); - -} + varchar(25) 'PrincipalType'. + int(11) 'PrincipalId'. + varchar(25) 'RightName'. + varchar(25) 'ObjectType'. + int(11) 'ObjectId'. + int(11) 'DelegatedBy'. + int(11) 'DelegatedFrom'. -# }}} - -# {{{ sub Create - -=head2 Create <PARAMS> +=cut -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 = ( 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'); - } -} - -# }}} - + 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'}, +); -# {{{ sub Delete - -=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'); - } } -# }}} -# {{{ sub _BootstrapRight -=head2 _BootstrapRight +=item id -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. +Returns the current value of id. +(In the database, id is stored as int(11).) -=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 - -=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); - } -} - -# }}} -# {{{ sub QueueRights +=item PrincipalType -=head2 QueueRights +Returns the current value of PrincipalType. +(In the database, PrincipalType is stored as varchar(25).) -Returns a hash of all the possible rights at the queue scope -=cut -sub QueueRights { - return (%QUEUERIGHTS); -} +=item SetPrincipalType VALUE -# }}} -# {{{ sub SystemRights +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 SystemRights - -Returns a hash of all the possible rights at the system scope =cut -sub SystemRights { - return (%SYSTEMRIGHTS); -} +=item PrincipalId -# }}} +Returns the current value of PrincipalId. +(In the database, PrincipalId is stored as int(11).) -# {{{ 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)); -} -# }}} -# {{{ sub AppliesToObj +=item SetPrincipalId VALUE -=head2 AppliesToObj -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. +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).) -=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."); -} - -# }}} - -# {{{ sub _Value - -sub _Value { - my $self = shift; - - unless ($self->CurrentUserHasRight('ShowACL')) { - return (undef); - } - return ($self->__Value(@_)); -} - -# }}} +=item RightName +Returns the current value of RightName. +(In the database, RightName is stored as 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'})); -} +=item SetRightName VALUE -# }}} -# {{{ sub CurrentUserHasSystemRight -=head2 CurrentUserHasSystemRight RIGHTNAME +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).) -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 ObjectType -# {{{ sub CurrentUserHasRight +Returns the current value of ObjectType. +(In the database, ObjectType is stored as varchar(25).) -=item CurrentUserHasRight RIGHT -Takes a rightname as a string. - -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 SetObjectType VALUE -# {{{ sub HasRight -=item HasRight +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).) -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; - } - - - -} -# }}} - -# }}} - -1; - -__DATA__ - -# {{{ POD - -=head1 Out of date docs -=head2 Table Structure +=item ObjectId -PrincipalType, PrincipalId, Right,Scope,AppliesTo +Returns the current value of ObjectId. +(In the database, ObjectId is stored as int(11).) -=head1 The docs are out of date. so you know. -=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 SetObjectId VALUE -=item Queue -=item System +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).) -=head1 Rights - -=head2 Scope: Queue - -=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> - - Name: Show - Principals: <user> <group> Owner Requestor Cc AdminCc - -Display Ticket History <queue> - - Name: ShowHistory - Principals: <user> <group> Owner Requestor Cc AdminCc - -Display Ticket Private Comments <queue> +=cut - Name: ShowComments - Principals: <user> <group> Owner Requestor Cc AdminCc -Reply to Ticket in <queue> +=item DelegatedBy - Name: Reply - Principals: <user> <group> Owner Requestor Cc AdminCc +Returns the current value of DelegatedBy. +(In the database, DelegatedBy is stored as int(11).) -Comment on Ticket in <queue> - Name: Comment - Principals: <user> <group> Owner Requestor Cc AdminCc -Modify Ticket in <queue> +=item SetDelegatedBy VALUE - Name: Modify - Principals: <user> <group> Owner Requestor Cc AdminCc -Delete Tickets in <queue> +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).) - Name: Delete - Principals: <user> <group> Owner Requestor Cc AdminCc +=cut -=head2 Queue Rights that apply to a whole queue -These rights can only be granted to "real people" +=item DelegatedFrom -List Tickets in <queue> +Returns the current value of DelegatedFrom. +(In the database, DelegatedFrom is stored as int(11).) - Name: ListQueue - Principals: <user> <group> -Know that <queue> exists - - Name: See - Principals: <user> <group> -Display queue settings +=item SetDelegatedFrom VALUE - Name: Explore - Principals: <user> <group> -Modify Queue Watchers for <queue> +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).) - Name: ModifyQueueWatchers - Principals: <user> <group> -Modify Queue Attributes for <queue> +=cut - Name: ModifyQueue - Principals: <user> <group> -Modify Queue ACL for queue <queue> - Name: ModifyACL - Principals: <user> <group> +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'}, + } +}; -=head2 Rights that apply to the System scope -=head2 SystemRights + eval "require RT::ACE_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/ACE_Overlay.pm}) { + die $@; + }; -Create Queue - - Name: CreateQueue - Principals: <user> <group> -Delete Queue - - Name: DeleteQueue - Principals: <user> <group> + eval "require RT::ACE_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/ACE_Vendor.pm}) { + die $@; + }; -Create Users - - Name: CreateUser - Principals: <user> <group> + eval "require RT::ACE_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/ACE_Local.pm}) { + die $@; + }; -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> +=head1 SEE ALSO -Modify Self - - Name: ModifySelf - Principals: <user> <group> +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. -Modify System ACL +These overlay files can contain new subs or subs to replace existing subs in this module. - Name: ModifyACL - Principals: <user> <group> +If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line -=head1 The Principal Side of the ACE + no warnings qw(redefine); -=head2 PrincipalTypes,PrincipalIds in our Neighborhood +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - User,<userid> - Group,<groupip> - Everyone,NULL +RT::ACE_Overlay, RT::ACE_Vendor, RT::ACE_Local =cut -# }}} + +1; diff --git a/rt/lib/RT/ACL.pm b/rt/lib/RT/ACL.pm index 444a4c2af..81f59c6d0 100755 --- a/rt/lib/RT/ACL.pm +++ b/rt/lib/RT/ACL.pm @@ -1,308 +1,115 @@ -# $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> +# 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; -=head1 NAME - RT::ACL - collection of RT ACE objects +=head1 NAME + RT::ACL -- Class Description + =head1 SYNOPSIS - use RT::ACL; -my $ACL = new RT::ACL($CurrentUser); + use RT::ACL =head1 DESCRIPTION =head1 METHODS -=begin testing - -ok(require RT::TestHarness); -ok(require RT::ACL); - -=end testing - =cut package RT::ACL; -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 - -Hand out the next ACE that was found - -=cut - -# {{{ sub Next -sub Next { - my $self = shift; - - 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); - } - -} -# }}} - - -=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) - - -=head2 LimitToQueue - -Takes a single queueid as its argument. +use RT::SearchBuilder; +use RT::ACE; -Limit the ACL to just a given queue when supplied with an integer queue id. +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -=cut -sub LimitToQueue { +sub _Init { my $self = shift; - 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 ); - -} - + $self->{'table'} = 'ACL'; + $self->{'primary_key'} = 'id'; -=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 ); + return ( $self->SUPER::_Init(@_) ); } -=head2 LimitPrincipalToType($type) -Takes a single argument, $type. -Limit the ACL to just a specific principal type +=item NewItem -$type is one of: - TicketOwner - TicketRequestor - TicketCc - TicketAdminCc - Everyone - User - Group +Returns an empty new RT::ACE item =cut -sub LimitPrincipalToType { - my $self=shift; - my $type=shift; - $self->Limit(ENTRYAGGREGATOR => 'OR', - FIELD => 'PrincipalType', - VALUE => $type ); +sub NewItem { + my $self = shift; + return(RT::ACE->new($self->CurrentUser)); } + eval "require RT::ACL_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/ACL_Overlay.pm}) { + die $@; + }; -=head2 LimitPrincipalToId + eval "require RT::ACL_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/ACL_Vendor.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; - } -} + eval "require RT::ACL_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/ACL_Local.pm}) { + die $@; + }; -#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); -} -#Build a hash of this ACL's entries. -sub _BuildHash { - my $self = shift; +=head1 SEE ALSO - while (my $entry = $self->Next) { - my $hashkey = $entry->RightScope . "-" . - $entry->RightAppliesTo . "-" . - $entry->RightName . "-" . - $entry->PrincipalId . "-" . - $entry->PrincipalType; +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->{'as_hash'}->{"$hashkey"} =1; +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); -# {{{ HasEntry +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. -=head2 HasEntry +RT::ACL_Overlay, RT::ACL_Vendor, RT::ACL_Local =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 624888e94..81f7bddfa 100755 --- a/rt/lib/RT/Action/Autoreply.pm +++ b/rt/lib/RT/Action/Autoreply.pm @@ -1,7 +1,31 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Autoreply.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ - +# 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 package RT::Action::Autoreply; require RT::Action::SendEmail; + +use strict; +use vars qw/@ISA/; @ISA = qw(RT::Action::SendEmail); @@ -17,7 +41,7 @@ Sets the recipients of this message to this ticket's Requestor. sub SetRecipients { my $self=shift; - push(@{$self->{'To'}}, @{$self->TicketObj->Requestors->Emails}); + push(@{$self->{'To'}}, $self->TicketObj->Requestors->MemberEmailAddresses); return(1); } @@ -39,6 +63,7 @@ sub SetReturnAddress { @_ ); + my $replyto; if ($args{'is_comment'}) { $replyto = $self->TicketObj->QueueObj->CommentAddress || $RT::CommentAddress; @@ -49,7 +74,9 @@ sub SetReturnAddress { } unless ($self->TemplateObj->MIMEObj->head->get('From')) { - my $friendly_name=$self->TicketObj->QueueObj->Name; + my $friendly_name = $self->TicketObj->QueueObj->Description || + $self->TicketObj->QueueObj->Name; + $friendly_name =~ s/"/\\"/g; $self->SetHeader('From', "\"$friendly_name\" <$replyto>"); } @@ -61,4 +88,9 @@ 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 ecfd4ab1a..007d299c7 100755 --- a/rt/lib/RT/Action/Generic.pm +++ b/rt/lib/RT/Action/Generic.pm @@ -1,7 +1,26 @@ -# $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 - +# 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 =head1 NAME RT::Action::Generic - a generic baseclass for RT Actions @@ -16,7 +35,6 @@ =begin testing -ok (require RT::TestHarness); ok (require RT::Action::Generic); =end testing @@ -25,6 +43,8 @@ ok (require RT::Action::Generic); package RT::Action::Generic; +use strict; + # {{{ sub new sub new { my $proto = shift; @@ -36,6 +56,13 @@ sub new { } # }}} +# {{{ sub new +sub loc { + my $self = shift; + return $self->{'ScripObj'}->loc(@_); +} +# }}} + # {{{ sub _Init sub _Init { my $self = shift; @@ -87,6 +114,13 @@ sub TemplateObj { } # }}} +# {{{ sub ScripObj +sub ScripObj { + my $self = shift; + return($self->{'ScripObj'}); +} +# }}} + # {{{ sub Type sub Type { my $self = shift; @@ -102,7 +136,7 @@ sub Type { # {{{ sub Commit sub Commit { my $self = shift; - return(0,"Commit Stubbed"); + return(0, $self->loc("Commit Stubbed")); } # }}} @@ -112,7 +146,7 @@ sub Commit { # {{{ sub Describe sub Describe { my $self = shift; - return ("No description for " . ref $self); + return $self->loc("No description for [_1]", ref $self); } # }}} @@ -122,7 +156,7 @@ sub Describe { # {{{ sub Prepare sub Prepare { my $self = shift; - return (0,"Prepare Stubbed"); + return (0, $self->loc("Prepare Stubbed")); } # }}} @@ -152,4 +186,10 @@ 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 6dca4fd41..1e4e4c073 100755 --- a/rt/lib/RT/Action/Notify.pm +++ b/rt/lib/RT/Action/Notify.pm @@ -1,7 +1,31 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Notify.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ - +# 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 package RT::Action::Notify; require RT::Action::SendEmail; + +use strict; +use vars qw/@ISA/; @ISA = qw(RT::Action::SendEmail); # {{{ sub SetRecipients @@ -9,14 +33,14 @@ require RT::Action::SendEmail; =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. +Explicitly B<does not> notify the creator of the transaction by default =cut sub SetRecipients { my $self = shift; - $arg = $self->Argument; + my $arg = $self->Argument; $arg =~ s/\bAll\b/Owner,Requestor,AdminCc,Cc/; @@ -24,14 +48,14 @@ sub SetRecipients { if ($arg =~ /\bOtherRecipients\b/) { - 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 ($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 ( $arg =~ /\bRequestor\b/ ) { - push ( @To, @{ $self->TicketObj->Requestors->Emails } ); + push ( @To, $self->TicketObj->Requestors->MemberEmailAddresses ); } @@ -40,12 +64,12 @@ sub SetRecipients { #If we have a To, make the Ccs, Ccs, otherwise, promote them to To if (@To) { - push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); - push ( @Cc, @{ $self->TicketObj->QueueObj->Cc->Emails } ); + push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); + push ( @Cc, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); } else { - push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); - push ( @To, @{ $self->TicketObj->QueueObj->Cc->Emails } ); + push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); + push ( @To, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); } } @@ -65,15 +89,16 @@ sub SetRecipients { } if ( $arg =~ /\bAdminCc\b/ ) { - push ( @Bcc, @{ $self->TicketObj->AdminCc->Emails } ); - push ( @Bcc, @{ $self->TicketObj->QueueObj->AdminCc->Emails } ); + push ( @Bcc, $self->TicketObj->AdminCc->MemberEmailAddresses ); + push ( @Bcc, $self->TicketObj->QueueObj->AdminCc->MemberEmailAddresses ); } if ($RT::UseFriendlyToLine) { unless (@To) { - push ( @PseudoTo, - "\"$arg of $RT::rtname Ticket #" - . $self->TicketObj->id . "\":;" ); + push ( + @PseudoTo, + sprintf($RT::FriendlyToLineFormat, $arg, $self->TicketObj->id), + ); } } @@ -81,14 +106,17 @@ 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. - - $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 ); + # 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 ); + } @{ $self->{'PseudoTo'} } = @PseudoTo; return (1); @@ -96,4 +124,9 @@ 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 c72bfff13..210e4ab15 100755 --- a/rt/lib/RT/Action/NotifyAsComment.pm +++ b/rt/lib/RT/Action/NotifyAsComment.pm @@ -1,7 +1,31 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/NotifyAsComment.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ - +# 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 package RT::Action::NotifyAsComment; require RT::Action::Notify; + +use strict; +use vars qw/@ISA/; @ISA = qw(RT::Action::Notify); @@ -21,5 +45,11 @@ 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 deleted file mode 100644 index b271e4709..000000000 --- a/rt/lib/RT/Action/OpenDependent.pm +++ /dev/null @@ -1,55 +0,0 @@ -# $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 00547ebe8..02ff3a58c 100644 --- a/rt/lib/RT/Action/ResolveMembers.pm +++ b/rt/lib/RT/Action/ResolveMembers.pm @@ -1,8 +1,34 @@ +# 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. @@ -12,7 +38,7 @@ require RT::Links; # {{{ sub Describe sub Describe { my $self = shift; - return (ref $self . " will resolve all members of a resolved group ticket."); + return $self->loc("[_1] will resolve all members of a resolved group ticket.", ref $self); } # }}} @@ -33,7 +59,7 @@ sub Commit { while (my $Link=$Links->Next()) { # Todo: Try to deal with remote URIs as well - next unless $Link->BaseIsLocal; + next unless $Link->BaseURI->IsLocal; my $base=RT::Ticket->new($self->TicketObj->CurrentUser); # Todo: Only work if Base is a plain ticket num: $base->Load($Link->Base); @@ -53,5 +79,10 @@ 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 e3abb1154..dac8fc8e7 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -1,20 +1,44 @@ -# $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> +# 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 # 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); -=head1 NAME +use RT::EmailParser; - 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 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. =head1 SYNOPSIS @@ -36,7 +60,6 @@ the comments for the SetRecipients sub). =begin testing -ok (require RT::TestHarness); ok (require RT::Action::SendEmail); =end testing @@ -54,158 +77,266 @@ 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->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'}}); - } - } + + 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'} } ); + } + } } - - # 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; - - $MIMEObj->make_singlepart; - - + $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'); + + #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->debug("$self: No recipients found. Not sending.\n"); - return(1); + 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); } # 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'}}) 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); + $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. -".$@ ); + } } else { - unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) { - $RT::Logger->crit("$self: Could not send mail for ". - $self->TransactionObj . "\n"); - return(0); + 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( @mailer_args ) ) { + $RT::Logger->crit($msgid. "Could not send mail." ); + 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->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(); + 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); - $self->SetRTSpecialHeaders(); - - return 1; - + return (1); } # }}} -# }}} - # {{{ Deal with message headers (Set* subs, designed for easy overriding) # {{{ sub SetRTSpecialHeaders -# This routine adds all the random headers that RT wants in a mail message -# that don't matter much to anybody else. +=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 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://bestpractical.com/rt/)"); - - $self->SetHeader('RT-Originator', $self->TransactionObj->CreatorObj->EmailAddress); - return(); - -} + $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( 'RT-Originator', + $self->TransactionObj->CreatorObj->EmailAddress ); + return (); +} # {{{ sub SetReferences @@ -218,105 +349,126 @@ sub SetRTSpecialHeaders { =cut sub SetReferences { - 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. + my $self = shift; - $self->SetHeader - ('In-Reply-To', "<rt-".$self->TicketObj->id(). - "\@".$RT::rtname.">"); + # 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 . ">" ); - # 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 -# 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. +=head2 SetMessageID -sub SetMessageID { - my $self = shift; +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. - # 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#" +=cut + +sub SetMessageID { + my $self = shift; - $self->SetHeader - ('Message-ID', "<rt-".$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-" + . $RT::VERSION ."-" + . $self->TicketObj->id() . "-" + . $self->TransactionObj->id() . "." + . rand(20) . "\@" + . $RT::Organization . ">" ) unless $self->TemplateObj->MIMEObj->head->get('Message-ID'); } - # }}} # }}} -# {{{ sub SetReturnAddress +# {{{ sub SetReturnAddress + +=head2 SetReturnAddress is_comment => BOOLEAN + +Calculate and set From and Reply-To headers based on the is_comment flag. + +=cut 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')) { - 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"); - } - + 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" ); + } + } # }}} # {{{ 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->add($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->replace( $field, $val ); + return $self->TemplateObj->MIMEObj->head->get($field); } # }}} @@ -331,21 +483,29 @@ 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 @@ -353,11 +513,12 @@ 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 @@ -367,23 +528,24 @@ 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" ); + } } # }}} @@ -399,70 +561,125 @@ the transaction's subject. =cut sub SetSubject { - my $self = shift; - unless ($self->TemplateObj->MIMEObj->head->get('Subject')) { - my $message=$self->TransactionObj->Message; - my $ticket=$self->TicketObj->Id; - + my $self = shift; 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; - chomp $subject; - $self->SetHeader('Subject',$subject); - + 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 ); + } - 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" ); + } } # }}} # }}} -__END__ +# {{{ + +=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; -# {{{ POD + 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 ); +} # }}} +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 deleted file mode 100755 index 91bb3c1cb..000000000 --- a/rt/lib/RT/Action/SendPasswordEmail.pm +++ /dev/null @@ -1,170 +0,0 @@ -# $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 deleted file mode 100644 index 09d3448a8..000000000 --- a/rt/lib/RT/Action/StallDependent.pm +++ /dev/null @@ -1,68 +0,0 @@ -# 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 916ac355e..2ed520162 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -1,423 +1,372 @@ -# $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 +# 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; + =head1 NAME - RT::Attachment -- an RT attachment object +RT::Attachment + =head1 SYNOPSIS - use RT::Attachment; +=head1 DESCRIPTION +=head1 METHODS -=head1 DESCRIPTION +=cut -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. +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 METHODS -=begin testing -ok (require RT::TestHarness); -ok (require RT::Attachment); +=item Create PARAMHASH -=end testing +Create takes a hash of values and creates a row in the database: + + 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'. =cut -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 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'}, +); + } -# }}} -# {{{ sub TransactionObj -=head2 TransactionObj -Returns the transaction object asscoiated with this attachment. +=item id + +Returns the current value of id. +(In the database, id is stored as int(11).) + =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 TransactionId + +Returns the current value of TransactionId. +(In the database, TransactionId is stored as int(11).) -# {{{ sub Create -=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.; +=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).) + =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 Parent + +Returns the current value of Parent. +(In the database, Parent is stored as int(11).) + -# {{{ sub Content +=item SetParent VALUE -=head2 Content -Returns the attachment's content. if it's base64 encoded, decode it -before returning it. +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).) + =cut -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 MessageId + +Returns the current value of MessageId. +(In the database, MessageId is stored as varchar(160).) -# }}} -# {{{ sub Children -=head2 Children +=item SetMessageId VALUE + + +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).) - 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 Subject -# {{{ UTILITIES +Returns the current value of Subject. +(In the database, Subject is stored as varchar(255).) -# {{{ sub Quote +=item SetSubject VALUE -sub Quote { - my $self=shift; - my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system) - @_); - my ($quoted_content, $body, $headers); - my $max=0; +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).) - # TODO: Handle Multipart/Mixed (eventually fix the link in the - # ShowHistory web template?) - if ($self->ContentType =~ m{^(text/plain|message)}i) { - $body=$self->Content; - # Do we need any preformatting (wrapping, that is) of the message? +=cut - # Remove quoted signature. - $body =~ s/\n-- \n(.*)$//s; - # What's the longest line like? - foreach (split (/\n/,$body)) { - $max=length if ( length > $max); - } +=item Filename - if ($max>76) { - require Text::Wrapper; - my $wrapper=new Text::Wrapper - ( - columns => 70, - body_start => ($max > 70*3 ? ' ' : ''), - par_start => '' - ); - $body=$wrapper->wrap($body); - } +Returns the current value of Filename. +(In the database, Filename is stored as varchar(255).) - $body =~ s/^/> /gm; - $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; +=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 + + +=item ContentType + +Returns the current value of ContentType. +(In the database, ContentType is stored as varchar(80).) + - return (\$body, $max); -} -# }}} -# {{{ sub NiceHeaders - pulls out only the most relevant headers +=item SetContentType VALUE -=head2 NiceHeaders -Returns the To, From, Cc, Date and Subject headers. +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).) -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; -} -# }}} -# {{{ sub Headers +=item ContentEncoding + +Returns the current value of ContentEncoding. +(In the database, ContentEncoding is stored as varchar(80).) + + -=head2 Headers +=item SetContentEncoding VALUE + + +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 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 Content + +Returns the current value of Content. +(In the database, Content is stored as longtext.) -# }}} -# {{{ sub GetHeader +=item SetContent VALUE -=head2 GetHeader ( 'Tag') -Returns the value of the header Tag as a string. This bypasses the weeding out -done in Headers() above. +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.) + =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; -} -# }}} -# {{{ sub _Value +=item Headers -=head2 _Value +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.) -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); - } - - -} +=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 _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 73cd350a4..177cdd094 100755 --- a/rt/lib/RT/Attachments.pm +++ b/rt/lib/RT/Attachments.pm @@ -1,99 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attachments.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::Attachments - a collection of RT::Attachment objects +=head1 NAME + RT::Attachments -- Class Description + =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 -=begin testing - -ok (require RT::TestHarness); -ok (require RT::Attachments); +package RT::Attachments; -=end testing +use RT::SearchBuilder; +use RT::Attachment; -=cut +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -package RT::Attachments; -use RT::EasySearch; +sub _Init { + my $self = shift; + $self->{'table'} = 'Attachments'; + $self->{'primary_key'} = 'id'; -@ISA= qw(RT::EasySearch); -# {{{ sub _Init -sub _Init { - my $self = shift; - - $self->{'table'} = "Attachments"; - $self->{'primary_key'} = "id"; - return ( $self->SUPER::_Init(@_)); + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub ContentType +=item NewItem -=head2 ContentType (VALUE => 'text/plain', ENTRYAGGREGATOR => 'OR', OPERATOR => '=' ) - -Limit result set to attachments of ContentType 'TYPE'... +Returns an empty new RT::Attachment item =cut +sub NewItem { + my $self = shift; + return(RT::Attachment->new($self->CurrentUser)); +} -sub ContentType { - my $self = shift; - my %args = ( VALUE => 'text/plain', - OPERATOR => '=', - ENTRYAGGREGATOR => 'OR', - @_); + eval "require RT::Attachments_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Attachments_Overlay.pm}) { + die $@; + }; - $self->Limit ( FIELD => 'ContentType', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - ENTRYAGGREGATOR => $args{'ENTRYAGGREGATOR'}); -} -# }}} + eval "require RT::Attachments_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Attachments_Vendor.pm}) { + die $@; + }; -# {{{ sub ChildrenOf + eval "require RT::Attachments_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Attachments_Local.pm}) { + die $@; + }; -=head2 ChildrenOf ID -Limit result set to children of Attachment ID -=cut +=head1 SEE ALSO -sub ChildrenOf { - my $self = shift; - my $attachment = shift; - $self->Limit ( FIELD => 'Parent', - VALUE => $attachment); -} -# }}} +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 NewItem -sub NewItem { - my $self = shift; +These overlay files can contain new subs or subs to replace existing subs in this module. - use RT::Attachment; - my $item = new RT::Attachment($self->CurrentUser); - return($item); -} -# }}} - 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. +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 83e5de6ce..4519fcf5a 100644 --- a/rt/lib/RT/Condition/AnyTransaction.pm +++ b/rt/lib/RT/Condition/AnyTransaction.pm @@ -1,10 +1,33 @@ -# $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 +# 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 + package RT::Condition::AnyTransaction; require RT::Condition::Generic; +use strict; +use vars qw/@ISA/; @ISA = qw(RT::Condition::Generic); @@ -19,5 +42,10 @@ 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 393f4b786..bd269315e 100755 --- a/rt/lib/RT/Condition/Generic.pm +++ b/rt/lib/RT/Condition/Generic.pm @@ -1,7 +1,26 @@ -# $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 - +# 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 =head1 NAME RT::Condition::Generic - ; @@ -29,7 +48,6 @@ =begin testing -ok (require RT::TestHarness); ok (require RT::Condition::Generic); =end testing @@ -39,6 +57,11 @@ 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; @@ -61,7 +84,6 @@ sub _Init { ApplicableTransTypes => undef, @_ ); - $self->{'Argument'} = $args{'Argument'}; $self->{'ScripObj'} = $args{'ScripObj'}; $self->{'TicketObj'} = $args{'TicketObj'}; @@ -100,6 +122,19 @@ 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 @@ -137,7 +172,7 @@ sub ApplicableTransTypes { # {{{ sub Describe sub Describe { my $self = shift; - return ("No description for " . ref $self); + return ($self->loc("No description for [_1]", ref $self)); } # }}} @@ -167,4 +202,10 @@ 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 deleted file mode 100644 index e69de29bb..000000000 --- a/rt/lib/RT/Condition/NewDependency.pm +++ /dev/null diff --git a/rt/lib/RT/Condition/StatusChange.pm b/rt/lib/RT/Condition/StatusChange.pm index 56419b2c7..8afabcda0 100644 --- a/rt/lib/RT/Condition/StatusChange.pm +++ b/rt/lib/RT/Condition/StatusChange.pm @@ -1,10 +1,34 @@ -# $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 +# 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 + + package RT::Condition::StatusChange; require RT::Condition::Generic; +use strict; +use vars qw/@ISA/; @ISA = qw(RT::Condition::Generic); @@ -26,5 +50,10 @@ 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 6997ddbac..4ca2f9891 100755 --- a/rt/lib/RT/CurrentUser.pm +++ b/rt/lib/RT/CurrentUser.pm @@ -1,7 +1,26 @@ -# $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 - +# 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 =head1 NAME RT::CurrentUser - an RT object representing the current user @@ -19,7 +38,6 @@ =begin testing -ok (require RT::TestHarness); ok (require RT::CurrentUser); =end testing @@ -28,9 +46,13 @@ ok (require RT::CurrentUser); package RT::CurrentUser; + use RT::Record; -@ISA= qw(RT::Record); +use RT::I18N; +use strict; +use vars qw/@ISA/; +@ISA= qw(RT::Record); # {{{ sub _Init @@ -48,7 +70,7 @@ sub _Init { $self->Load($Name); } - $self->_MyCurrentUser($self); + $self->CurrentUser($self); } # }}} @@ -56,7 +78,8 @@ sub _Init { # {{{ sub Create sub Create { - return (0, 'Permission Denied'); + my $self = shift; + return (0, $self->loc('Permission Denied')); } # }}} @@ -64,7 +87,8 @@ sub Create { # {{{ sub Delete sub Delete { - return (0, 'Permission Denied'); + my $self = shift; + return (0, $self->loc('Permission Denied')); } # }}} @@ -84,7 +108,7 @@ sub UserObj { use RT::User; $self->{'UserObj'} = RT::User->new($self); unless ($self->{'UserObj'}->Load($self->Id)) { - $RT::Logger->err("Couldn't load ".$self->Id. "from the users database.\n"); + $RT::Logger->err($self->loc("Couldn't load [_1] from the users database.\n", $self->Id)); } } @@ -92,6 +116,42 @@ 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; @@ -120,6 +180,8 @@ 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); @@ -225,46 +287,88 @@ sub Privileged { # }}} -# {{{ Convenient ACL methods -=head2 HasQueueRight +# {{{ sub HasRight -calls $self->UserObj->HasQueueRight with the arguments passed in +=head2 HasRight + +calls $self->UserObj->HasRight with the arguments passed in =cut -sub HasQueueRight { - my $self = shift; - return ($self->UserObj->HasQueueRight(@_)); +sub HasRight { + my $self = shift; + return ($self->UserObj->HasRight(@_)); } -=head2 HasSystemRight +# }}} -calls $self->UserObj->HasSystemRight with the arguments passed in +# {{{ Localization -=cut +=head2 LanguageHandle +Returns this current user's langauge handle. Should take a language +specification. but currently doesn't -sub HasSystemRight { - my $self = shift; - return ($self->UserObj->HasSystemRight(@_)); -} -# }}} +=begin testing -# {{{ sub HasRight +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"); -=head2 HasSystemRight +=end testing -calls $self->UserObj->HasRight with the arguments passed in +=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 HasRight { - my $self = shift; - return ($self->UserObj->HasRight(@_)); +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 }; + } + + return $handle->maketext(@_); } +sub loc_fuzzy { + my $self = shift; + return '' if $_[0] eq ''; + + # XXX: work around perl's deficiency when matching utf8 data + return $_[0] if Encode::is_utf8($_[0]); + my $result = $self->LanguageHandle->maketext_fuzzy(@_); + + return($result); +} # }}} +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 d56997174..355370ada 100644 --- a/rt/lib/RT/Date.pm +++ b/rt/lib/RT/Date.pm @@ -1,7 +1,26 @@ -#$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 - +# 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 =head1 NAME RT::Date - a simple Object Oriented date. @@ -28,7 +47,15 @@ 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; @@ -45,6 +72,7 @@ sub new { my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); + $self->CurrentUser(@_); $self->Unix(0); return $self; } @@ -61,91 +89,114 @@ 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 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->{'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->{'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'} =~ /^\d*$/) and ($args{'Value'} == 0)) { - $self->Unix(-1); - return($self->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'}); + if ( $args{'Format'} =~ /^unix$/i ) { + $self->Unix( $args{'Value'} ); } - - 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'} =~ /^(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'}"); + + } + } + 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'} =~ /^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() ); } # }}} @@ -232,47 +283,59 @@ 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 = 'ago' if ($duration < 0); + + my ( $negative, $s ); + + $negative = 1 if ( $duration < 0 ); $duration = abs($duration); - 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"; + 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 ); } - - return ("$s $string $negative"); } # }}} @@ -303,12 +366,64 @@ Returns the object\'s time as a string with the current timezone. sub AsString { my $self = shift; - return ("Not set") if ($self->Unix <= 0); + return ($self->loc("Not set")) if ($self->Unix <= 0); + + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($self->Unix); - return (scalar(localtime($self->Unix))); + 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)); } # }}} +# {{{ 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 @@ -425,12 +540,18 @@ 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 deleted file mode 100755 index bcbfa01b2..000000000 --- a/rt/lib/RT/EasySearch.pm +++ /dev/null @@ -1,115 +0,0 @@ -#$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 005601f5e..4dcef3f07 100755 --- a/rt/lib/RT/Group.pm +++ b/rt/lib/RT/Group.pm @@ -1,364 +1,258 @@ -# $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 -# +# 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; + + =head1 NAME - RT::Group - RT\'s group object +RT::Group -=head1 SYNOPSIS - use RT::Group; -my $group = new RT::Group($CurrentUser); +=head1 SYNOPSIS =head1 DESCRIPTION -An RT group object. +=head1 METHODS -=head1 AUTHOR +=cut -Jesse Vincent, jesse@fsck.com +package RT::Group; +use RT::Record; -=head1 SEE ALSO -RT +use vars qw( @ISA ); +@ISA= qw( RT::Record ); -=head1 METHODS +sub _Init { + my $self = shift; + $self->Table('Groups'); + $self->SUPER::_Init(@_); +} -=begin testing -ok (require RT::TestHarness); -ok (require RT::Group); -=end testing -=cut +=item Create PARAMHASH -package RT::Group; -use RT::Record; -use RT::GroupMember; -use RT::ACE; +Create takes a hash of values and creates a row in the database: -use vars qw|@ISA|; -@ISA= qw(RT::Record); + varchar(200) 'Name'. + varchar(255) 'Description'. + varchar(64) 'Domain'. + varchar(64) 'Type'. + varchar(64) 'Instance'. + +=cut -# {{{ sub _Init -sub _Init { - my $self = shift; - $self->{'table'} = "Groups"; - return ($self->SUPER::_Init(@_)); -} -# }}} -# {{{ sub _Accessible -sub _Accessible { + +sub Create { my $self = shift; - my %Cols = ( - Name => 'read/write', - Description => 'read/write', - Pseudo => 'read' - ); - return $self->SUPER::_Accessible(@_, %Cols); + 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 Load -=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 +=item id -=cut +Returns the current value of id. +(In the database, id is stored as int(11).) -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); - } -} -# }}} +=cut -# {{{ sub Create -=head2 Create +=item Name -Takes a paramhash with three named arguments: Name, Description and Pseudo. -Pseudo is used internally by RT for certain special ACL decisions. +Returns the current value of Name. +(In the database, Name is stored as varchar(200).) -=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 SetName VALUE -# {{{ sub Delete -=head2 Delete +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).) -Delete this object =cut -sub Delete { - my $self = shift; - - unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { - return (0, 'Permission Denied'); - } - - return($self->SUPER::Delete(@_)); -} -# }}} +=item Description -# {{{ MembersObj +Returns the current value of Description. +(In the database, Description is stored as varchar(255).) -=head2 MembersObj -Returns an RT::GroupMembers object of this group's members. + +=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 -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'}); - -} -# }}} +=item Domain + +Returns the current value of Domain. +(In the database, Domain is stored as varchar(64).) + -# {{{ AddMember -=head2 AddMember +=item SetDomain VALUE + + +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).) -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 Type + +Returns the current value of Type. +(In the database, Type is stored as varchar(64).) + + + +=item SetType VALUE -# {{{ HasMember -=head2 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).) -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; - #Try to cons up a member object using "LoadByCols" +=item Instance - my $member_obj = new RT::GroupMember($self->CurrentUser); - $member_obj->LoadByCols( UserId => $user_id, GroupId => $self->id); +Returns the current value of Instance. +(In the database, Instance is stored as varchar(64).) - #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 -=head2 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).) -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"); - } -} -# }}} -# {{{ ACL Related routines +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 => ''}, -# {{{ GrantQueueRight + } +}; -=head2 GrantQueueRight -Grant a queue right to this group. Takes a paramhash of which the elements -RightAppliesTo and RightName are important. + eval "require RT::Group_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Group_Overlay.pm}) { + die $@; + }; -=cut + eval "require RT::Group_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Group_Vendor.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)); -} + eval "require RT::Group_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Group_Local.pm}) { + die $@; + }; -# }}} -# {{{ GrantSystemRight -=head2 GrantSystemRight -Grant a system right to this group. -The only element that's important to set is RightName. +=head1 SEE ALSO -=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)); -} +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 _Set -sub _Set { - my $self = shift; +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { - return (0, 'Permission Denied'); - } +RT::Group_Overlay, RT::Group_Vendor, RT::Group_Local - return ($self->SUPER::_Set(@_)); +=cut -} -# }}} + +1; diff --git a/rt/lib/RT/GroupMember.pm b/rt/lib/RT/GroupMember.pm index 69de50b42..8de1a73fe 100755 --- a/rt/lib/RT/GroupMember.pm +++ b/rt/lib/RT/GroupMember.pm @@ -1,136 +1,189 @@ -# $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 +# 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; + =head1 NAME - RT::GroupMember - a member of an RT Group +RT::GroupMember -=head1 SYNOPSIS -RT::GroupMember should never be called directly. It should generally -only be accessed through the helper functions in RT::Group; +=head1 SYNOPSIS =head1 DESCRIPTION +=head1 METHODS +=cut +package RT::GroupMember; +use RT::Record; -=head1 METHODS +use vars qw( @ISA ); +@ISA= qw( RT::Record ); -=begin testing +sub _Init { + my $self = shift; -ok (require RT::TestHarness); -ok (require RT::GroupMember); + $self->Table('GroupMembers'); + $self->SUPER::_Init(@_); +} -=end testing -=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(@_)); -} -# }}} +=item Create PARAMHASH -# {{{ sub _Accessible -sub _Accessible { - my $self = shift; - my %Cols = ( - GroupId => 'read', - UserId => 'read' - ); +Create takes a hash of values and creates a row in the database: + + int(11) 'GroupId'. + int(11) 'MemberId'. + +=cut - return $self->SUPER::_Accessible(@_, %Cols); -} -# }}} -# {{{ sub Create -# a helper method for Add 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'})) + my %args = ( + GroupId => '0', + MemberId => '0', + + @_); + $self->SUPER::Create( + GroupId => $args{'GroupId'}, + MemberId => $args{'MemberId'}, +); + } -# }}} -# {{{ sub Add -=head2 Add -Takes a paramhash of UserId and GroupId. makes that user a memeber -of that group +=item id + +Returns the current value of id. +(In the database, id is stored as int(11).) + =cut -sub Add { - my $self = shift; - return ($self->Create(@_)); -} -# }}} -# {{{ sub Delete +=item GroupId + +Returns the current value of GroupId. +(In the database, GroupId is stored as int(11).) + + + +=item SetGroupId VALUE + -=head2 Delete +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).) -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(@_)); -} -# }}} +=item MemberId + +Returns the current value of MemberId. +(In the database, MemberId is stored as int(11).) + -# {{{ sub UserObj -=head2 UserObj +=item SetMemberId VALUE + + +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).) -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'}); -} -# {{{ sub _Set -sub _Set { - my $self = shift; - unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { - return (0, 'Permission Denied'); - } - return($self->SUPER::_Set(@_)); -} -# }}} + +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); + +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. + +RT::GroupMember_Overlay, RT::GroupMember_Vendor, RT::GroupMember_Local + +=cut + + +1; diff --git a/rt/lib/RT/GroupMembers.pm b/rt/lib/RT/GroupMembers.pm index a90a2a899..31cb9536f 100755 --- a/rt/lib/RT/GroupMembers.pm +++ b/rt/lib/RT/GroupMembers.pm @@ -1,73 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/GroupMembers.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::GroupMembers - a collection of RT::GroupMember objects +=head1 NAME + RT::GroupMembers -- Class Description + =head1 SYNOPSIS - use RT::GroupMembers; + use RT::GroupMembers =head1 DESCRIPTION =head1 METHODS - -=begin testing - -ok (require RT::TestHarness); -ok (require RT::GroupMembers); - -=end testing - =cut package RT::GroupMembers; -use RT::EasySearch; + +use RT::SearchBuilder; use RT::GroupMember; -@ISA= qw(RT::EasySearch); +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -# {{{ sub _Init -sub _Init { - my $self = shift; - - $self->{'table'} = "GroupMembers"; - $self->{'primary_key'} = "id"; - return ( $self->SUPER::_Init(@_) ); +sub _Init { + my $self = shift; + $self->{'table'} = 'GroupMembers'; + $self->{'primary_key'} = 'id'; + + + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub LimitToGroup -=head2 LimitToGroup +=item NewItem -Takes a group id as its only argument. Limits the current search to that -group object +Returns an empty new RT::GroupMember item =cut -sub LimitToGroup { +sub NewItem { my $self = shift; - my $group = shift; + return(RT::GroupMember->new($self->CurrentUser)); +} - return ($self->Limit( - VALUE => "$group", - FIELD => 'GroupId', - ENTRYAGGREGATOR => 'OR', - )); + eval "require RT::GroupMembers_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/GroupMembers_Overlay.pm}) { + die $@; + }; -} -# }}} + eval "require RT::GroupMembers_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/GroupMembers_Vendor.pm}) { + die $@; + }; -# {{{ sub NewItem + 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 { - 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 f44f1fdb3..29f12a5a0 100755 --- a/rt/lib/RT/Groups.pm +++ b/rt/lib/RT/Groups.pm @@ -1,100 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Groups.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::Groups - a collection of RT::Group objects +=head1 NAME + RT::Groups -- Class Description + =head1 SYNOPSIS - use RT::Groups; - my $groups = $RT::Groups->new($CurrentUser); - $groups->LimitToReal(); - while (my $group = $groups->Next()) { - print $group->Id ." is a group id\n"; - } + use RT::Groups =head1 DESCRIPTION =head1 METHODS - -=begin testing - -ok (require RT::TestHarness); -ok (require RT::Groups); - -=end testing - =cut package RT::Groups; -use RT::EasySearch; -use RT::Groups; -@ISA= qw(RT::EasySearch); +use RT::SearchBuilder; +use RT::Group; -# {{{ sub _Init +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -sub _Init { - my $self = shift; - $self->{'table'} = "Groups"; - $self->{'primary_key'} = "id"; - $self->OrderBy( ALIAS => 'main', - FIELD => 'Name', - ORDER => 'ASC'); +sub _Init { + my $self = shift; + $self->{'table'} = 'Groups'; + $self->{'primary_key'} = 'id'; - return ( $self->SUPER::_Init(@_)); + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ LimitToReal -=head2 LimitToReal +=item NewItem -Make this groups object return only "real" groups, which can be -granted rights and have members assigned to them +Returns an empty new RT::Group item =cut -sub LimitToReal { +sub NewItem { my $self = shift; + return(RT::Group->new($self->CurrentUser)); +} - return ($self->Limit( FIELD => 'Pseudo', - VALUE => '0', - OPERATOR => '=')); + eval "require RT::Groups_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Groups_Overlay.pm}) { + die $@; + }; -} -# }}} + eval "require RT::Groups_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Groups_Vendor.pm}) { + die $@; + }; -# {{{ sub LimitToPseudo + eval "require RT::Groups_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Groups_Local.pm}) { + die $@; + }; -=head2 LimitToPseudo -Make this groups object return only "pseudo" groups, which can be -granted rights but whose membership lists are determined dynamically. -=cut - - sub LimitToPseudo { - my $self = shift; - return ($self->Limit( FIELD => 'Pseudo', - VALUE => '1', - 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 NewItem -sub NewItem { - my $self = shift; - return (RT::Group->new($self->CurrentUser)); -} -# }}} +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 -1; + no warnings qw(redefine); + +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +RT::Groups_Overlay, RT::Groups_Vendor, RT::Groups_Local + +=cut + + +1; diff --git a/rt/lib/RT/Handle.pm b/rt/lib/RT/Handle.pm index 6b74f361b..5cdb65e5b 100644 --- a/rt/lib/RT/Handle.pm +++ b/rt/lib/RT/Handle.pm @@ -1,5 +1,26 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Handle.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ - +# 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 =head1 NAME RT::Handle - RT's database handle @@ -22,14 +43,16 @@ ok(require RT::Handle); package RT::Handle; -eval "use DBIx::SearchBuilder::Handle::$RT::DatabaseType; +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 @@ -38,16 +61,41 @@ sub Connect { my $self=shift; # Unless the database port is a positive integer, we really don't want to pass it. -$RT::DatabasePort = undef unless (defined $RT::DatabasePort && $RT::DatabasePort =~ /^(\d+)$/); -$self->SUPER::Connect(Host => $RT::DatabaseHost, - Database => $RT::DatabaseName, +$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, + Database => $RT::DatabaseName, 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 a3bf92d5f..ec0e877b4 100644 --- a/rt/lib/RT/Interface/CLI.pm +++ b/rt/lib/RT/Interface/CLI.pm @@ -1,9 +1,31 @@ -# $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> +# 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; +use RT; package RT::Interface::CLI; -use strict; BEGIN { @@ -11,14 +33,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 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker + $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\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 &LoadConfig &DBConnect - &GetCurrentUser &GetMessageContent &debug); + @EXPORT_OK = qw(&CleanEnv + &GetCurrentUser &GetMessageContent &debug &loc); } =head1 NAME @@ -27,25 +49,28 @@ BEGIN { =head1 SYNOPSIS - use lib "!!RT_LIB_PATH!!"; - use lib "!!RT_ETC_PATH!!"; + use lib "/path/to/rt/libraries/"; - use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect - GetCurrentUser GetMessageContent); + use RT::Interface::CLI qw(CleanEnv + GetCurrentUser GetMessageContent loc); #Clean out all the nasties from the environment CleanEnv(); - #Load etc/config.pm and drop privs - LoadConfig(); + #let's talk to RT' + use RT; - #Connect to the database and get RT::SystemUser and RT::Nobody loaded - DBConnect(); + #Load RT's config file + RT::LoadConfig(); + # 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 @@ -53,7 +78,6 @@ BEGIN { =begin testing -ok(require RT::TestHarness); ok(require RT::Interface::CLI); =end testing @@ -77,35 +101,10 @@ 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 @@ -115,15 +114,14 @@ sub DBConnect { 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 - $Gecos=(getpwuid($<))[0]; + my $Gecos= ($^O eq 'MSWin32') ? Win32::LoginName() : (getpwuid($<))[0]; #If the current user is 0, then RT will assume that the User object #is that of the currentuser. @@ -134,10 +132,29 @@ 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 @@ -221,4 +238,9 @@ 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 e95436091..7eec0502f 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -1,41 +1,58 @@ -# $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> - +# 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 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 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker + $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\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 - &LoadConfig - &DBConnect - &GetCurrentUser + @EXPORT_OK = qw( + &CreateUser &GetMessageContent &CheckForLoops &CheckForSuspiciousSender &CheckForAutoGenerated - &ParseMIMEEntityFromSTDIN - &ParseTicketId &MailError &ParseCcAddressesFromHead &ParseSenderAddressFromHead - &ParseErrorsToAddressFromHead - &ParseAddressFromHeader - + &ParseErrorsToAddressFromHead + &ParseAddressFromHeader + &Gateway); - &debug); } =head1 NAME @@ -47,28 +64,13 @@ BEGIN { use lib "!!RT_LIB_PATH!!"; use lib "!!RT_ETC_PATH!!"; - 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(); + use RT::Interface::Email qw(Gateway CreateUser); =head1 DESCRIPTION =begin testing -ok(require RT::TestHarness); ok(require RT::Interface::Email); =end testing @@ -79,71 +81,6 @@ 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 { @@ -207,82 +144,6 @@ 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 { @@ -313,8 +174,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; @@ -327,144 +188,66 @@ sub MailError { # }}} -# {{{ sub GetCurrentUser - -sub GetCurrentUser { - my $head = shift; - my $entity = shift; - my $ErrorsTo = shift; +# {{{ Create User - my %UserInfo = (); +sub CreateUser { + my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_; + my $NewUser = RT::User->new($RT::SystemUser); - #Suck the address of the sender out of the header - my ($Address, $Name) = ParseSenderAddressFromHead($head); - - #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'}; - } - - my $CurrentUser = RT::CurrentUser->new(); + # 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; - # 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); - } + my ($Val, $Message) = + $NewUser->Create(Name => ($Username || $Address), + EmailAddress => $Address, + RealName => $Name, + Password => undef, + Privileged => 0, + Comments => 'Autocreated on ticket submission' + ); - unless ($CurrentUser->Id) { - $CurrentUser->LoadByEmail($Address); - } - - #If we can't get it by email address, try by name. - unless ($CurrentUser->Id) { - $CurrentUser->LoadByName($Address); + 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' + ); + } } - - - 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' - ); - - } + + #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' + ); } - - return ($CurrentUser); - -} -# }}} + return $CurrentUser; +} +# }}} # {{{ ParseCcAddressesFromHead =head2 ParseCcAddressesFromHead HASHREF @@ -489,11 +272,11 @@ sub ParseCcAddressesFromHead { foreach my $AddrObj (@ToObjs, @CcObjs) { my $Address = $AddrObj->address; - $Address = RT::CanonicalizeAddress($Address); + $Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($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::IsRTAddress($Address)); + next if (RT::EmailParser::IsRTAddress(undef, $Address)); push (@Addresses, $Address); } @@ -568,8 +351,7 @@ sub ParseAddressFromHeader{ } my $Name = ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address); - - + #Lets take the from and load a user object. my $Address = $AddrObj->address; @@ -578,4 +360,289 @@ 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 6b5272848..5097f54a4 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -1,129 +1,214 @@ -## $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Web.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ - +# 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 ## 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 - 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'. + + +# {{{ sub NewApacheHandler + +=head2 NewApacheHandler + + Takes extra options to pass to HTML::Mason::ApacheHandler->new + Returns a new Mason::ApacheHandler object =cut -sub NewParser { - my %args = ( - allow_globals => undef, +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", @_ ); - my $parser = new HTML::Mason::Parser( - default_escape_flags => 'h', - allow_globals => $args{'allow_globals'} - ); - return ($parser); + $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); + + return ($ah); } # }}} -# {{{ sub NewInterp +# {{{ sub NewCGIHandler -=head2 NewInterp +=head2 NewCGIHandler - Takes a paremeter hash. Needs a param called 'parser' which is a reference - to an HTML::Mason::Parser. - returns a new Mason::Interp object + Returns a new Mason::CGIHandler object =cut -sub NewInterp { - my %params = ( +sub NewCGIHandler { + my %args = ( + @_ + ); + + my $handler = HTML::Mason::CGIHandler->new( comp_root => [ [ local => $RT::MasonLocalComponentRoot ], [ standard => $RT::MasonComponentRoot ] ], data_dir => "$RT::MasonDataDir", - @_ + default_escape_flags => 'h', + allow_globals => [qw(%session)] ); + - #We allow recursive autohandlers to allow for RT auth. + $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); - use HTML::Mason::Interp; - my $interp = new HTML::Mason::Interp(%params); -} + return ($handler); +} # }}} -# {{{ sub NewApacheHandler -=head2 NewApacheHandler +# {{{ EscapeUTF8 - Takes a Mason::Interp object - Returns a new Mason::ApacheHandler object +=head2 EscapeUTF8 SCALARREF + +does a css-busting but minimalist escaping of whatever html you're passing in. =cut -sub NewApacheHandler { - my $interp = shift; - my $ah = new HTML::Mason::ApacheHandler( interp => $interp ); - return ($ah); +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 NewMason11ApacheHandler +package HTML::Mason::Commands; +use strict; +use vars qw/$r $m %session/; -=head2 NewMason11ApacheHandler - Returns a new Mason::ApacheHandler object +# {{{ loc + +=head2 loc ARRAY + +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 =cut -sub NewMason11ApacheHandler { - my %args = ( default_escape_flags => 'h', - allow_globals => [%session], - comp_root => [ - [ local => $RT::MasonLocalComponentRoot ], - [ standard => $RT::MasonComponentRoot ] - ], - data_dir => "$RT::MasonDataDir", - args_method => 'CGI' - ); - my $ah = new HTML::Mason::ApacheHandler(%args); - return ($ah); +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(@_)); + } } # }}} +# {{{ 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'} ) { - SetContentType( $session{'ErrorDocumentType'} ); - $m->comp( $session{'ErrorDocument'}, Why => shift ); + if ($session{'ErrorDocument'} && + $session{'ErrorDocumentType'}) { + $r->content_type($session{'ErrorDocumentType'}); + $m->comp($session{'ErrorDocument'} , Why => shift); $m->abort; - } - else { - SetContentType('text/html'); - $m->comp( "/Elements/Error", Why => shift ); + } + else { + $m->comp("/Elements/Error" , Why => shift); $m->abort; } } @@ -135,6 +220,7 @@ sub Abort { =head2 CreateTicket ARGS Create a new ticket, using Mason's %ARGS. returns @results. + =cut sub CreateTicket { @@ -158,38 +244,45 @@ sub CreateTicket { my $starts = new RT::Date( $session{'CurrentUser'} ); $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} ); - my @Requestors = split ( /,/, $ARGS{'Requestors'} ); - my @Cc = split ( /,/, $ARGS{'Cc'} ); - my @AdminCc = split ( /,/, $ARGS{'AdminCc'} ); + my @Requestors = split ( /\s*,\s*/, $ARGS{'Requestors'} ); + my @Cc = split ( /\s*,\s*/, $ARGS{'Cc'} ); + my @AdminCc = split ( /\s*,\s*/, $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}, - TimeWorked => $ARGS{TimeWorked}, + Queue => $ARGS{'Queue'}, + Owner => $ARGS{'Owner'}, + InitialPriority => $ARGS{'InitialPriority'}, + FinalPriority => $ARGS{'FinalPriority'}, + TimeLeft => $ARGS{'TimeLeft'}, + TimeEstimated => $ARGS{'TimeEstimated'}, + 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 ); - - # we need to get any KeywordSelect-<integer> fields into %create_args.. - grep { $_ =~ /^KeywordSelect-/ &&{ $create_args{$_} = $ARGS{$_} } } %ARGS; - + foreach my $arg (%ARGS) { + if ($arg =~ /^CustomField-(\d+)(.*?)$/) { + next if ($arg =~ /-Magic$/); + $create_args{"CustomField-".$1} = $ARGS{"$arg"}; + } + } my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); unless ( $id && $Trans ) { Abort($ErrMsg); @@ -216,7 +309,7 @@ sub CreateTicket { } } - push ( @Actions, $ErrMsg ); + push ( @Actions, split("\n", $ErrMsg) ); unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) { Abort( "No permission to view newly created ticket #" . $Ticket->id . "." ); @@ -283,80 +376,38 @@ sub ProcessUpdateMessage { my $Message = MakeMIMEEntity( Subject => $args{ARGSRef}->{'UpdateSubject'}, Body => $args{ARGSRef}->{'UpdateContent'}, - AttachmentFieldName => 'UpdateAttachment' ); - ## Check whether this was a refresh or not. - - # Match Correspondence or Comments. - my $trans_flag = -2; - my $trans_type = undef; - my $orig_trans = $args{ARGSRef}->{'UpdateType'}; - if ( $orig_trans =~ /^(private|public)$/ ) { - $trans_type = "Comment"; - }elsif ( $orig_trans eq 'response' ) { - $trans_type = "Correspond"; - } - - # Do we have a transaction that we need to update on? session - if( defined( $trans_type ) ){ - $trans_flag = 0; - - # Prepare a checksum. - # See perldoc -f unpack for example of this. - my $this_checksum = unpack("%32C*", $Message->body_as_string ) % 65535; - - # The above *could* generate duplicate checksums. Crosscheck with - # the length. - my $this_length = length( $Message->body_as_string ); - - # Don't forget the ticket id. - my $this_id = $args{TicketObj}->id; - - # Check whether the previous transaction in the - # ticket is the same as the current transaction. - if( defined( $session{'prev_trans_type'} ) && defined( $session{'prev_trans_chksum'} ) && defined( $session{'prev_trans_length'} ) && defined( $session{'prev_trans_tickid'} ) ){ - if( $session{'prev_trans_type'} eq $orig_trans && $session{'prev_trans_chksum'} == $this_checksum && $session{'prev_trans_length'} == $this_length && $session{'prev_trans_tickid'} == $this_id ){ - # Its the same as the previous transaction for this user. - $trans_flag = -1; - } - } - - # Store them for next time. - $session{'prev_trans_type'} = $orig_trans; - $session{'prev_trans_chksum'} = $this_checksum; - $session{'prev_trans_length'} = $this_length; - $session{'prev_trans_tickid'} = $this_id; - - if( $trans_flag == -1 ){ - push ( @{ $args{'Actions'} }, -"This appears to be a duplicate of your previous update (please do not refresh this page)" ); - } - - - if ( $trans_type eq 'Comment' && $trans_flag >= 0 ) { - my ( $Transaction, $Description ) = $args{TicketObj}->Comment( - CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, - BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, - MIMEObj => $Message, - TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'} - ); - push ( @{ $args{Actions} }, $Description ); - } - elsif ( $trans_type eq 'Correspond' && $trans_flag >= 0 ) { - my ( $Transaction, $Description ) = $args{TicketObj}->Correspond( - CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, - BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, - MIMEObj => $Message, - TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'} - ); - push ( @{ $args{Actions} }, $Description ); - } - } + 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 ); + } else { push ( @{ $args{'Actions'} }, - "Update type was neither correspondence nor comment. Update not recorded" - ); + loc("Update type was neither correspondence nor comment."). + " ". + loc("Update not recorded.") + ); } } } @@ -382,61 +433,66 @@ 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::Entity->build( - Subject => $args{'Subject'} || "", - From => $args{'From'}, - Cc => $args{'Cc'}, - Data => [ $args{'Body'} ] - ); + 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 = CGIObject(); - if ( $cgi_object->param( $args{'AttachmentFieldName'} ) ) { + my $cgi_object = $m->cgi_object; - my $cgi_filehandle = - $cgi_object->upload( $args{'AttachmentFieldName'} ); + if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) { - use File::Temp qw(tempfile tempdir); - #foreach my $filehandle (@filenames) { - # my ( $fh, $temp_file ) = tempfile(); + use File::Temp qw(tempfile tempdir); - #$binmode $fh; #thank you, windows + #foreach my $filehandle (@filenames) { - # We're having trouble with tempfiles not getting created. Let's try it with - # a scalar instead + my ( $fh, $temp_file ) = tempfile(); - my ( $buffer, @file ); + binmode $fh; #thank you, windows + my ($buffer); + while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) { + print $fh $buffer; + } - while ( my $bytesread = read( $cgi_filehandle, $buffer, 4096 ) ) { - push ( @file, $buffer ); - } + my $uploadinfo = $cgi_object->uploadInfo($filehandle); - $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'} - ); + # Prefer the cached name first over CGI.pm stringification. + my $filename = $RT::Mason::CGI::Filename; + $filename = "$filehandle" unless defined($filename); + + $filename =~ s#^.*[\\/]##; + + $Message->attach( + Path => $temp_file, + Filename => $filename, + Type => $uploadinfo->{'Content-Type'}, + ); + close($fh); - #close($fh); - #unlink($temp_file); + # } - # } } + $Message->make_singlepart(); + RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8 + return ($Message); } @@ -485,6 +541,9 @@ sub ProcessSearchQuery { elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) { $session{'tickets'}->PrevPage; } + elsif ( $args{ARGS}->{'GotoPage'} > 0 ) { + $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 ); + } # }}} @@ -576,8 +635,12 @@ 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 => $args{ARGS}->{'ValueOfSubject'}, + VALUE => $val, OPERATOR => $args{ARGS}->{'SubjectOp'}, ); } @@ -585,40 +648,59 @@ sub ProcessSearchQuery { # }}} # {{{ Limit Dates if ( $args{ARGS}->{'ValueOfDate'} ne '' ) { - my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} ); $args{ARGS}->{'DateType'} =~ s/_Date$//; - $session{'tickets'}->LimitDate( - FIELD => $args{ARGS}->{'DateType'}, - VALUE => $date, - OPERATOR => $args{ARGS}->{'DateOp'}, - ); + 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'}, + ); + } } # }}} # {{{ Limit Content - if ( $args{ARGS}->{'ValueOfContent'} ne '' ) { - $session{'tickets'}->LimitContent( - VALUE => $args{ARGS}->{'ValueOfContent'}, - OPERATOR => $args{ARGS}->{'ContentOp'}, + 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'}, ); } # }}} - # {{{ Limit KeywordSelects - foreach my $KeywordSelectId ( - map { /^KeywordSelect(\d+)$/; $1 } - grep { /^KeywordSelect(\d+)$/; } keys %{ $args{ARGS} } - ) - { - my $form = $args{ARGS}->{"KeywordSelect$KeywordSelectId"}; - my $oper = $args{ARGS}->{"KeywordSelectOp$KeywordSelectId"}; - foreach my $KeywordId ( ref($form) ? @{$form} : ($form) ) { - next unless ($KeywordId); + # {{{ 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) ) { my $quote = 1; - if ( $KeywordId =~ /^null$/i ) { + if ($oper =~ /like/i) { + $value = "%".$value."%"; + } + if ( $value =~ /^null$/i ) { #Don't quote the string 'null' $quote = 0; @@ -627,17 +709,16 @@ sub ProcessSearchQuery { $oper = 'IS' if ( $oper eq '=' ); $oper = 'IS NOT' if ( $oper eq '!=' ); } - $session{'tickets'}->LimitKeyword( - KEYWORDSELECT => $KeywordSelectId, - OPERATOR => $oper, - QUOTEVALUE => $quote, - KEYWORD => $KeywordId - ); + $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id, + OPERATOR => $oper, + QUOTEVALUE => $quote, + VALUE => $value ); } } # }}} + } # }}} @@ -654,7 +735,7 @@ Returns an ISO date and time in GMT sub ParseDateToISO { my $date = shift; - my $date_obj = new RT::Date($CurrentUser); + my $date_obj = RT::Date->new($session{'CurrentUser'}); $date_obj->Set( Format => 'unknown', Value => $date @@ -680,172 +761,82 @@ 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); - next unless ($ACL); + 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}; - # 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 $principal = RT::Principal->new($session{'CurrentUser'}); + $principal->Load($principal_id); - # {{{ Create an object called Principal - # so we can do rights operations + my $obj; - 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"); - } + 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); - $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 ($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; } - 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); - - #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->GrantRight(Object => $obj, Right => $right); + push (@results, $msg); } - - # }}} } - } - - # }}} Add rights - - # {{{ remove any rights that have been deleted - - my @RevokeACE = - ref( $ARGS{"RevokeACE"} ) eq 'ARRAY' - ? @{ $ARGS{"RevokeACE"} } - : ( $ARGS{"RevokeACE"} ); - - foreach my $aceid (@RevokeACE) { - - my $right = new RT::ACE( $session{'CurrentUser'} ); - $right->Load($aceid); - next unless ( $right->id ); + 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; + } + my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right); + push (@results, $msg); + } - 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); -} + + } # }}} @@ -864,6 +855,7 @@ sub UpdateRecordObject { ARGSRef => undef, AttributesRef => undef, Object => undef, + AttributePrefix => undef, @_ ); @@ -872,17 +864,94 @@ 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; + } - foreach $attribute (@$attributes) { - if ( ( defined $ARGSRef->{"$attribute"} ) - and ( $ARGSRef->{"$attribute"} ne $object->$attribute() ) ) - { - $ARGSRef->{"$attribute"} =~ s/\r\n/\n/gs; + $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); +} - my $method = "Set$attribute"; - my ( $code, $msg ) = $object->$method( $ARGSRef->{"$attribute"} ); - push @results, "$attribute: $msg"; - } +# }}} + +# {{{ 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 + ); + + 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 ); } return (@results); } @@ -913,6 +982,7 @@ sub ProcessTicketBasics { Subject FinalPriority Priority + TimeEstimated TimeWorked TimeLeft Status @@ -934,7 +1004,7 @@ sub ProcessTicketBasics { ); # We special case owner changing, so we can use ForceOwnerChange - if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner ne $ARGSRef->{'Owner'} ) ) { + if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) { my ($ChownType); if ( $ARGSRef->{'ForceOwnerChange'} ) { $ChownType = "Force"; @@ -945,7 +1015,7 @@ sub ProcessTicketBasics { my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType ); - push ( @results, "$msg" ); + push ( @results, $msg ); } # }}} @@ -955,6 +1025,142 @@ 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 ); @@ -978,18 +1184,22 @@ sub ProcessTicketWatchers { foreach my $key ( keys %$ARGSRef ) { - # Delete deletable watchers - if ( ( $key =~ /^DelWatcher(\d*)$/ ) and ( $ARGSRef->{$key} ) ) { - my ( $code, $msg ) = $Ticket->DeleteWatcher($1); + # {{{ Delete deletable watchers + if ( ( $key =~ /^Ticket-DelWatcher-Type-(.*)-Principal-(\d+)$/ ) ) { + my ( $code, $msg ) = + $Ticket->DeleteWatcher(PrincipalId => $2, + Type => $1); push @results, $msg; } # Delete watchers in the simple style demanded by the bulk manipulator elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) { - my ( $code, $msg ) = $Ticket->DeleteWatcher( $ARGSRef->{$key}, $1 ); + my ( $code, $msg ) = $Ticket->DeleteWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 ); push @results, $msg; } + # }}} + # Add new wathchers by email address elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ ) and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) ) @@ -1014,12 +1224,11 @@ sub ProcessTicketWatchers { # Add new watchers by owner elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ ) - and ( $key =~ /^WatcherTypeUser(\d*)$/ ) ) - { + and ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) ) { #They're in this order because otherwise $1 gets clobbered :/ my ( $code, $msg ) = - $Ticket->AddWatcher( Type => $ARGSRef->{$key}, Owner => $1 ); + $Ticket->AddWatcher( Type => $ARGSRef->{$key}, PrincipalId => $1 ); push @results, $msg; } } @@ -1061,7 +1270,7 @@ sub ProcessTicketDates { ); #Run through each field in this list. update the value if apropriate - foreach $field (@date_fields) { + foreach my $field (@date_fields) { my ( $code, $msg ); my $DateObj = RT::Date->new( $session{'CurrentUser'} ); @@ -1098,11 +1307,9 @@ 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'}; @@ -1118,11 +1325,9 @@ 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; @@ -1133,26 +1338,23 @@ sub ProcessTicketLinks { my @linktypes = qw( DependsOn MemberOf RefersTo ); foreach my $linktype (@linktypes) { - - for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) - { - $luri =~ s/\s*$//; # Strip trailing whitespace - my ( $val, $msg ) = $Ticket->AddLink( - Target => $luri, - Type => $linktype - ); - push @results, $msg; + 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; + } } + 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 @@ -1167,121 +1369,9 @@ sub ProcessTicketLinks { # }}} -# {{{ 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); -} - -# }}} +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}); 1; diff --git a/rt/lib/RT/Keyword.pm b/rt/lib/RT/Keyword.pm deleted file mode 100644 index a41e0a585..000000000 --- a/rt/lib/RT/Keyword.pm +++ /dev/null @@ -1,446 +0,0 @@ -#$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 deleted file mode 100644 index 6865216fd..000000000 --- a/rt/lib/RT/KeywordSelect.pm +++ /dev/null @@ -1,452 +0,0 @@ -#$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 deleted file mode 100644 index c220b39f9..000000000 --- a/rt/lib/RT/KeywordSelects.pm +++ /dev/null @@ -1,143 +0,0 @@ -#$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 deleted file mode 100644 index a9ecda2bc..000000000 --- a/rt/lib/RT/Keywords.pm +++ /dev/null @@ -1,106 +0,0 @@ -#$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 885ffe3ed..962c378a8 100644 --- a/rt/lib/RT/Link.pm +++ b/rt/lib/RT/Link.pm @@ -1,373 +1,302 @@ -# $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 +# 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; + =head1 NAME - RT::Link - an RT Link object +RT::Link -=head1 SYNOPSIS - use RT::Link; +=head1 SYNOPSIS =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 -=begin testing +package RT::Link; +use RT::Record; -ok (require RT::TestHarness); -ok (require RT::Link); -=end testing +use vars qw( @ISA ); +@ISA= qw( RT::Record ); -=cut +sub _Init { + my $self = shift; -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(@_)); + $self->Table('Links'); + $self->SUPER::_Init(@_); } -# }}} -# {{{ sub Create -=head2 Create PARAMHASH -Create a new link object. Takes 'Base', 'Target' and 'Type'. -Returns undef on failure or a Link Id on success. + +=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'. =cut -sub Create { + + + +sub Create { my $self = shift; - 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); + 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'}, +); + } -# }}} - -# {{{ sub Load -=head2 Load - 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); +=item id + +Returns the current value of id. +(In the database, id is stored as int(11).) =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 -# {{{ sub TargetObj +Returns the current value of Base. +(In the database, Base is stored as varchar(240).) -=head2 TargetObj -=cut -sub TargetObj { - my $self = shift; - return $self->_TicketObj('base',$self->Target); -} -# }}} +=item SetBase VALUE + -# {{{ sub BaseObj +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).) -=head2 BaseObj =cut -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 Target -# Static methods: +Returns the current value of Target. +(In the database, Target is stored as varchar(240).) -# {{{ sub BaseIsLocal -=head2 BaseIsLocal -Returns true if the base of this link is a local ticket +=item SetTarget VALUE + + +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).) + =cut -sub BaseIsLocal { - my $self = shift; - return $self->_IsLocal($self->Base); -} -# }}} +=item Type -# {{{ sub TargetIsLocal +Returns the current value of Type. +(In the database, Type is stored as varchar(20).) -=head2 TargetIsLocal -Returns true if the target of this link is a local ticket + +=item SetType VALUE + + +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).) + =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 -=head2 _IsLocal URI +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).) -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).) + -# {{{ sub BaseAsHREF +=item SetLocalBase VALUE -=head2 BaseAsHREF -Returns an HTTP url to access the base of this link +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).) + =cut -sub BaseAsHREF { - my $self = shift; - return $self->AsHREF($self->Base); -} -# }}} -# {{{ sub TargetAsHREF +=item LastUpdatedBy -=head2 TargetAsHREF +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) -return an HTTP url to access the target of this link =cut -sub TargetAsHREF { - my $self = shift; - return $self->AsHREF($self->Target); -} -# }}} -# {{{ sub AsHREF - Converts Link URIs to HTTP URLs -=head2 URI +=item LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) -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"; - } - } -} -# }}} -# {{{ sub CanonicalizeURI +=item Creator + +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) -=head2 CanonicalizeURI -Takes a single argument: some form of ticket identifier. -Returns its canonicalized URI. +=cut + + +=item Created + +Returns the current value of Created. +(In the database, Created is stored as datetime.) -Bug: ticket aliases can't have :// in them. URIs must have :// in them. =cut -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 { + + +sub _ClassAccessible { + { - #If we couldn't find a ticket, return undef. - return( undef); - - } + 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 $@; + }; + + + + +=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 a8180caf0..7a1773af9 100644 --- a/rt/lib/RT/Links.pm +++ b/rt/lib/RT/Links.pm @@ -1,90 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Links.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::Links - A collection of Link objects +=head1 NAME + RT::Links -- Class Description + =head1 SYNOPSIS - use RT::Links; - my $links = new RT::Links($CurrentUser); + use RT::Links =head1 DESCRIPTION =head1 METHODS - -=begin testing - -ok (require RT::TestHarness); -ok (require RT::Links); - -=end testing - =cut package RT::Links; -use RT::EasySearch; + +use RT::SearchBuilder; use RT::Link; -@ISA= qw(RT::EasySearch); +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -# {{{ sub _Init -sub _Init { - my $self = shift; - - $self->{'table'} = "Links"; - $self->{'primary_key'} = "id"; +sub _Init { + my $self = shift; + $self->{'table'} = 'Links'; + $self->{'primary_key'} = 'id'; - return ( $self->SUPER::_Init(@_)); -} -# }}} -# {{{ 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); + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub NewItem -sub NewItem { + +=item NewItem + +Returns an empty new RT::Link item + +=cut + +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 deleted file mode 100644 index 287d41fab..000000000 --- a/rt/lib/RT/ObjectKeyword.pm +++ /dev/null @@ -1,192 +0,0 @@ -#$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 deleted file mode 100644 index 5df996e37..000000000 --- a/rt/lib/RT/ObjectKeywords.pm +++ /dev/null @@ -1,234 +0,0 @@ -#$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 1656903b3..b362c9f0d 100755 --- a/rt/lib/RT/Queue.pm +++ b/rt/lib/RT/Queue.pm @@ -1,944 +1,371 @@ -# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Queue.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; + =head1 NAME - RT::Queue - an RT Queue object +RT::Queue -=head1 SYNOPSIS - use RT::Queue; +=head1 SYNOPSIS =head1 DESCRIPTION - =head1 METHODS -=begin testing -use RT::TestHarness; - -use RT::Queue; - -=end testing - =cut - - package RT::Queue; -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)); -} - -# }}} +use RT::Record; -# {{{ sub Create -=head2 Create +use vars qw( @ISA ); +@ISA= qw( RT::Record ); -Create takes the name of the new queue -If you pass the ACL check, it creates the queue and returns its queue id. +sub _Init { + my $self = shift; -=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"); + $self->Table('Queues'); + $self->SUPER::_Init(@_); } -# }}} -# {{{ sub Delete -sub Delete { - my $self = shift; - return (0, 'Deleting this object would break referential integrity'); -} -# }}} -# {{{ sub SetDisabled +=item Create PARAMHASH -=head2 SetDisabled +Create takes a hash of values and creates a row in the database: -Takes a boolean. -1 will cause this queue to no longer be avaialble for tickets. -0 will re-enable this queue + varchar(200) 'Name'. + varchar(255) 'Description'. + varchar(120) 'CorrespondAddress'. + varchar(120) 'CommentAddress'. + int(11) 'InitialPriority'. + int(11) 'FinalPriority'. + int(11) 'DefaultDueIn'. + smallint(6) 'Disabled'. =cut -# }}} -# {{{ sub Load -=head2 Load -Takes either a numerical id or a textual Name and loads the specified queue. - -=cut - -sub Load { +sub Create { my $self = shift; - - my $identifier = shift; - if (!$identifier) { - return (undef); - } - - if ($identifier !~ /\D/) { - $self->SUPER::LoadById($identifier); - } - else { - $self->LoadByCol("Name", $identifier); - } - - return ($self->Id); + my %args = ( + Name => '', + Description => '', + CorrespondAddress => '', + CommentAddress => '', + InitialPriority => '0', + FinalPriority => '0', + DefaultDueIn => '0', + Disabled => '0', + @_); + $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 -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. +=item id -=cut +Returns the current value of id. +(In the database, id is stored as int(11).) -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; - - my $templates = RT::Templates->new($self->CurrentUser); +=item Name - if ($self->CurrentUserHasRight('ShowTemplate')) { - $templates->LimitToQueue($self->id); - } - - return ($templates); -} - -# }}} +Returns the current value of Name. +(In the database, Name is stored as varchar(200).) -# {{{ Dealing with watchers -# {{{ sub Watchers -=head2 Watchers +=item SetName VALUE -Watchers returns a Watchers object preloaded with this queue\'s watchers. -=cut +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).) -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 -=head2 AdminCcAsString +=item Description -Takes nothing. returns a string: All Ticket/Queue AdminCcs. +Returns the current value of Description. +(In the database, Description is stored as varchar(255).) -=cut -sub AdminCcAsString { - my $self=shift; - - return($self->AdminCc->EmailsAsString()); - } +=item SetDescription VALUE -# }}} -# {{{ sub CcAsString +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 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 -=cut +=item CorrespondAddress -sub Cc { - my $self = shift; - my $cc = $self->Watchers(); - if ($self->CurrentUserHasRight('SeeQueue')) { - $cc->LimitToCc(); - } - return ($cc); -} +Returns the current value of CorrespondAddress. +(In the database, CorrespondAddress is stored as varchar(120).) -# 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 -=head2 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).) -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 -# {{{ 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); - } - -} +Returns the current value of CommentAddress. +(In the database, CommentAddress is stored as varchar(120).) -# }}} -# {{{ sub IsCc -=head2 IsCc +=item SetCommentAddress VALUE -Takes a string. Returns true if the string is a Cc watcher of the current queue -=item Bugs +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).) -Should also be able to handle an RT::User object =cut -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 +=item InitialPriority -=item Bugs +Returns the current value of InitialPriority. +(In the database, InitialPriority is stored as int(11).) -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 -=head2 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).) -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 -# {{{ sub AddCc +Returns the current value of FinalPriority. +(In the database, FinalPriority is stored as int(11).) -=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 -=cut +=item SetFinalPriority VALUE -sub AddCc { - my $self = shift; - return ($self->AddWatcher( Type => 'Cc', @_)); -} -# }}} +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 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] -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. +=item DefaultDueIn +Returns the current value of DefaultDueIn. +(In the database, DefaultDueIn is stored as int(11).) -=cut -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 +=item SetDefaultDueIn VALUE -=head2 DeleteCc EMAIL -Takes an email address. It calls DeleteWatcher with a preset -type of 'Cc' +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).) =cut -sub DeleteCc { - my $self = shift; - my $id = shift; - return ($self->DeleteWatcher ($id, 'Cc')) -} - -# }}} -# {{{ sub DeleteAdminCc +=item Creator -=head2 DeleteAdminCc EMAIL - -Takes an email address. It calls DeleteWatcher with a preset -type of 'AdminCc' +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) =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 -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 +=item LastUpdatedBy -=head2 KeywordSelect([NAME]) +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) -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 -# {{{ sub KeywordSelects +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) -=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 - use RT::KeywordSelects; - my $KeywordSelects = new RT::KeywordSelects($self->CurrentUser); +Returns the current value of Disabled. +(In the database, Disabled is stored as smallint(6).) - if ($self->CurrentUserHasRight('SeeQueue')) { - $KeywordSelects->LimitToQueue($self->id); - $KeywordSelects->IncludeGlobals(); - } - return ($KeywordSelects); -} -# }}} -# }}} -# {{{ ACCESS CONTROL +=item SetDisabled VALUE -# {{{ sub ACL -=head2 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).) -#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 _Value +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 { - my $self = shift; + } +}; - unless ($self->CurrentUserHasRight('SeeQueue')) { - return (undef); - } - return ($self->__Value(@_)); -} + eval "require RT::Queue_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Queue_Overlay.pm}) { + die $@; + }; -# }}} + eval "require RT::Queue_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Queue_Vendor.pm}) { + die $@; + }; -# {{{ sub CurrentUserHasRight + eval "require RT::Queue_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Queue_Local.pm}) { + die $@; + }; -=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 -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; +=head1 SEE ALSO - return ($self->HasRight( Principal=> $self->CurrentUser, - Right => "$right")); +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 HasRight + no warnings qw(redefine); -=head2 HasRight +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. -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. +RT::Queue_Overlay, RT::Queue_Vendor, RT::Queue_Local =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 ab58d8d6d..60aec9086 100755 --- a/rt/lib/RT/Queues.pm +++ b/rt/lib/RT/Queues.pm @@ -1,123 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Queues.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::Queues - a collection of RT::Queue objects +=head1 NAME + RT::Queues -- Class Description + =head1 SYNOPSIS - use RT::Queues; + use RT::Queues =head1 DESCRIPTION =head1 METHODS - -=begin testing - -ok (require RT::TestHarness); -ok (require RT::Queues); - -=end testing - =cut package RT::Queues; -use RT::EasySearch; -@ISA= qw(RT::EasySearch); +use RT::SearchBuilder; +use RT::Queue; -# {{{ sub _Init -sub _Init { - my $self = shift; - $self->{'table'} = "Queues"; - $self->{'primary_key'} = "id"; +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); - # By default, order by name - $self->OrderBy( ALIAS => 'main', - FIELD => 'Name', - ORDER => 'ASC'); - return ($self->SUPER::_Init(@_)); +sub _Init { + my $self = shift; + $self->{'table'} = 'Queues'; + $self->{'primary_key'} = 'id'; + + + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub _DoSearch -=head2 _DoSearch +=item NewItem - A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless -we're explicitly trying to see them. +Returns an empty new RT::Queue item =cut -sub _DoSearch { +sub NewItem { 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(@_)); - + return(RT::Queue->new($self->CurrentUser)); } -# }}} - + eval "require RT::Queues_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Queues_Overlay.pm}) { + die $@; + }; -# {{{ sub Limit -sub Limit { - my $self = shift; - my %args = ( ENTRYAGGREGATOR => 'AND', - @_); - $self->SUPER::Limit(%args); -} -# }}} + eval "require RT::Queues_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Queues_Vendor.pm}) { + die $@; + }; -# {{{ sub NewItem -sub NewItem { - my $self = shift; - my $item; + eval "require RT::Queues_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Queues_Local.pm}) { + die $@; + }; - use RT::Queue; - $item = new RT::Queue($self->CurrentUser); - return($item); -} -# }}} -# {{{ sub Next -=head2 Next -Returns the next queue that this user can see. +=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::Queues_Overlay, RT::Queues_Vendor, RT::Queues_Local =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; +1; diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index 5340f7de4..6962221ea 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -1,5 +1,26 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Record.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ - +# 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 =head1 NAME RT::Record - Base class for RT record objects @@ -20,20 +41,31 @@ ok (require RT::Record); =cut - package RT::Record; -use DBIx::SearchBuilder::Record::Cachable; use RT::Date; use RT::User; -@ISA= qw(DBIx::SearchBuilder::Record::Cachable); +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'); + +} # {{{ sub _Init -sub _Init { - my $self = shift; - $self->_MyCurrentUser(@_); - +sub _Init { + my $self = shift; + $self->CurrentUser(@_); + } # }}} @@ -48,68 +80,108 @@ The primary keys for RT classes is 'id' sub _PrimaryKeys { my $self = shift; - return(['id']); + return ( ['id'] ); } # }}} -# {{{ sub _MyCurrentUser - -sub _MyCurrentUser { +# {{{ sub _Handle +sub _Handle { my $self = shift; - - $self->CurrentUser(@_); - if(!defined($self->CurrentUser)) { - use Carp; - Carp::cluck(); - $RT::Logger->err("$self was created without a CurrentUser\n"); - return(0); - } + return ($RT::Handle); } # }}} -# {{{ sub _Handle -sub _Handle { - my $self = shift; - return($RT::Handle); -} -# }}} - # {{{ sub Create -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); +=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); + + + + if (wantarray) { + return ( $id, $self->loc('Object created') ); + } + else { + return ($id); } - - return($id); - + } # }}} - # {{{ sub LoadByCols =head2 LoadByCols @@ -125,28 +197,33 @@ 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$' || $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); + 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; } + $self->SUPER::LoadByCols(%hash); } # }}} - # {{{ Datehandling # There is room for optimizations in most of those subs: @@ -154,10 +231,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; } @@ -166,12 +243,11 @@ 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; } @@ -182,9 +258,10 @@ sub CreatedObj { # TODO: This should be deprecated # sub AgeAsString { - my $self=shift; - return($self->CreatedObj->AgeAsString()); + my $self = shift; + return ( $self->CreatedObj->AgeAsString() ); } + # }}} # {{{ LastUpdatedAsString @@ -192,12 +269,13 @@ 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"; } } @@ -209,8 +287,9 @@ sub LastUpdatedAsString { # sub CreatedAsString { my $self = shift; - return ($self->CreatedObj->AsString()); + return ( $self->CreatedObj->AsString() ); } + # }}} # {{{ LongSinceUpdateAsString @@ -218,42 +297,47 @@ 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 the user is trying to modify the record - if ((!defined ($args{'Field'})) || (!defined ($args{'Value'}))) { - $args{'Value'} = 0; - } + if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) { + $args{'Value'} = 0; + } - $self->_SetLastUpdated(); - $self->SUPER::_Set(Field => $args{'Field'}, - Value => $args{'Value'}, - IsSQL => $args{'IsSQL'}); - - + $self->_SetLastUpdated(); + my ( $val, $msg ) = $self->SUPER::_Set( + Field => $args{'Field'}, + Value => $args{'Value'}, + IsSQL => $args{'IsSQL'} + ); } + # }}} # {{{ sub _SetLastUpdated @@ -268,16 +352,20 @@ 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 + ); } } @@ -291,15 +379,16 @@ 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 @@ -311,35 +400,56 @@ 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 -=head2 CurrentUser +require Encode::compat if $] < 5.007001; +require Encode; -If called with an argument, sets the current user to that user object. -This will affect ACL decisions, etc. -Returns the current user +sub __Value { + my $self = shift; + my $field = shift; + my %args = ( decode_utf8 => 1, + @_ ); -=cut + 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; +} -sub CurrentUser { - my $self = shift; +# Set up defaults for DBIx::SearchBuilder::Record::Cachable - if (@_) { - $self->{'user'} = shift; +sub _CacheConfig { + { + 'cache_p' => 1, + 'fast_update_p' => 1, + 'cache_for_sec' => 30, } - 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 aef011ca3..a69dde04e 100755 --- a/rt/lib/RT/Scrip.pm +++ b/rt/lib/RT/Scrip.pm @@ -1,372 +1,500 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Scrip.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; + =head1 NAME - RT::Scrip - an RT Scrip object +RT::Scrip -=head1 SYNOPSIS - use RT::Scrip; +=head1 SYNOPSIS =head1 DESCRIPTION - =head1 METHODS -=begin testing +=cut -ok (require RT::TestHarness); -ok (require RT::Scrip); +package RT::Scrip; +use RT::Record; +use RT::Queue; +use RT::Template; +use RT::ScripCondition; +use RT::ScripAction; -=end testing -=cut +use vars qw( @ISA ); +@ISA= qw( RT::Record ); -package RT::Scrip; -use RT::Record; -@ISA= qw(RT::Record); +sub _Init { + my $self = shift; -# {{{ sub _Init -sub _Init { - my $self = shift; - $self->{'table'} = "Scrips"; - return ($self->SUPER::_Init(@_)); + $self->Table('Scrips'); + $self->SUPER::_Init(@_); } -# }}} -# {{{ 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)); -} -# }}} -# {{{ sub Create -=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 Create PARAMHASH -Returns (retval, msg); -retval is 0 for failure or scrip id. msg is a textual description of what happened. +Create takes a hash of values and creates a row in the database: + + 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'. =cut -sub Create { + + + +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'); + 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'}, +); + } -# }}} -# {{{ sub Delete -=head2 Delete +=item id + +Returns the current value of id. +(In the database, id is stored as int(11).) -Delete this object =cut -sub Delete { - my $self = shift; - - unless ($self->CurrentUserHasRight('ModifyScrips')) { - return (0, 'Permission Denied'); - } - - return ($self->SUPER::Delete(@_)); -} -# }}} -# {{{ sub QueueObj +=item Description + +Returns the current value of Description. +(In the database, Description is stored as varchar(255).) + -=head2 QueueObj -Retuns an RT::Queue object with this Scrip\'s queue +=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 -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 ScripCondition + +Returns the current value of ScripCondition. +(In the database, ScripCondition is stored as int(11).) + -# {{{ sub ActionObj +=item SetScripCondition VALUE -=head2 ActionObj -Retuns an RT::Action object with this Scrip\'s Action +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 -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 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); } -# }}} +=item ScripAction + +Returns the current value of ScripAction. +(In the database, ScripAction is stored as int(11).) + + + +=item SetScripAction VALUE -# {{{ sub TemplateObj -=head2 TemplateObj +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).) -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 ScripActionObj -# {{{ sub Prepare -=head2 Prepare +Returns the ScripAction Object which has the id returned by ScripAction -Calls the action object's prepare method =cut -sub Prepare { - my $self = shift; - $self->ActionObj->Prepare(@_); +sub ScripActionObj { + my $self = shift; + my $ScripAction = RT::ScripAction->new($self->CurrentUser); + $ScripAction->Load($self->__Value('ScripAction')); + return($ScripAction); } -# }}} +=item ConditionRules + +Returns the current value of ConditionRules. +(In the database, ConditionRules is stored as text.) + -# {{{ sub Commit -=head2 Commit -Calls the action object's commit method +=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.) + =cut -sub Commit { - my $self = shift; - $self->ActionObj->Commit(@_); -} -# }}} +=item ActionRules -# {{{ sub ConditionObj +Returns the current value of ActionRules. +(In the database, ActionRules is stored as text.) -=head2 ConditionObj -Retuns an RT::ScripCondition object with this Scrip's IsApplicable + +=item SetActionRules VALUE + + +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.) + =cut -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 CustomIsApplicableCode + +Returns the current value of CustomIsApplicableCode. +(In the database, CustomIsApplicableCode is stored as text.) + + + +=item SetCustomIsApplicableCode VALUE -# {{{ sub IsApplicable -=head2 IsApplicable +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.) -Calls the Condition object\'s IsApplicable method =cut -sub IsApplicable { - my $self = shift; - return ($self->ConditionObj->IsApplicable(@_)); -} -# }}} +=item CustomPrepareCode -# {{{ sub DESTROY -sub DESTROY { - my $self = shift; - $self->{'ActionObj'} = undef; -} -# }}} +Returns the current value of CustomPrepareCode. +(In the database, CustomPrepareCode is stored as text.) -# {{{ ACL related methods -# {{{ 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(@_); -} +=item SetCustomPrepareCode VALUE -# }}} -# {{{ 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(@_); -} -# }}} +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.) + + +=cut + + +=item CustomCommitCode + +Returns the current value of CustomCommitCode. +(In the database, CustomCommitCode is stored as text.) + -# {{{ sub CurrentUserHasRight -=head2 CurrentUserHasRight +=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.) -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 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).) + + +=cut + + +=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 + +Returns the Queue Object which has the id returned by Queue + + +=cut + +sub QueueObj { + my $self = shift; + my $Queue = RT::Queue->new($self->CurrentUser); + $Queue->Load($self->__Value('Queue')); + return($Queue); } -# }}} +=item Template + +Returns the current value of Template. +(In the database, Template is stored as int(11).) + + + +=item SetTemplate VALUE -# {{{ sub HasRight -=head2 HasRight +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).) -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'}) ); - } + +=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); } -# }}} -# }}} +=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 + + +=item LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=item LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) + + +=cut -1; +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; diff --git a/rt/lib/RT/ScripAction.pm b/rt/lib/RT/ScripAction.pm index 471ad9191..26824df5d 100755 --- a/rt/lib/RT/ScripAction.pm +++ b/rt/lib/RT/ScripAction.pm @@ -1,200 +1,279 @@ -# 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 $ +# 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; + =head1 NAME - RT::ScripAction - RT Action object +RT::ScripAction + =head1 SYNOPSIS - use RT::ScripAction; +=head1 DESCRIPTION +=head1 METHODS + +=cut + +package RT::ScripAction; +use RT::Record; -=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. +use vars qw( @ISA ); +@ISA= qw( RT::Record ); +sub _Init { + my $self = shift; -=begin testing + $self->Table('ScripActions'); + $self->SUPER::_Init(@_); +} -ok (require RT::TestHarness); -ok (require RT::ScripAction); -=end testing -=head1 METHODS + + +=item Create PARAMHASH + +Create takes a hash of values and creates a row in the database: + + varchar(200) 'Name'. + varchar(255) 'Description'. + varchar(60) 'ExecModule'. + varchar(255) 'Argument'. =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 _Accessible -sub _Accessible { + + +sub Create { my $self = shift; - 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)); + my %args = ( + Name => '', + Description => '', + ExecModule => '', + Argument => '', + + @_); + $self->SUPER::Create( + Name => $args{'Name'}, + Description => $args{'Description'}, + ExecModule => $args{'ExecModule'}, + Argument => $args{'Argument'}, +); + } -# }}} -# {{{ sub Create -=head2 Create - - Takes a hash. Creates a new Action entry. - should be better documented. + + +=item id + +Returns the current value of id. +(In the database, id is stored as int(11).) + + =cut -sub Create { - my $self = shift; - #TODO check these args and do smart things. - return($self->SUPER::Create(@_)); -} -# }}} -# {{{ sub Delete -sub Delete { - my $self = shift; - - return (0, "ScripAction->Delete not implemented"); -} -# }}} +=item Name + +Returns the current value of Name. +(In the database, Name is stored as varchar(200).) -# {{{ 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'); -} -# }}} -# {{{ sub LoadAction -=head2 LoadAction HASH +=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).) - 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, - ); -} -# }}} -# {{{ sub TemplateObj +=item Description + +Returns the current value of Description. +(In the database, Description is stored as varchar(255).) + + -=head2 TemplateObj +=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).) -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 +=item ExecModule -# {{{ sub Prepare +Returns the current value of ExecModule. +(In the database, ExecModule is stored as varchar(60).) -sub Prepare { - my $self = shift; - return ($self->{'Action'}->Prepare()); - -} -# }}} -# {{{ sub Commit -sub Commit { - my $self = shift; - return($self->{'Action'}->Commit()); - - -} -# }}} -# {{{ sub Describe -sub Describe { - my $self = shift; - return ($self->{'Action'}->Describe()); - -} -# }}} +=item SetExecModule VALUE -# {{{ sub DESTROY -sub DESTROY { - my $self=shift; - $self->{'Action'} = undef; - $self->{'TemplateObj'} = undef; -} -# }}} +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).) -1; +=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 + + +=item LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=item LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) + + +=cut + + + +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. + +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::ScripAction_Overlay, RT::ScripAction_Vendor, RT::ScripAction_Local + +=cut + + +1; diff --git a/rt/lib/RT/ScripActions.pm b/rt/lib/RT/ScripActions.pm index ec6141559..614ff374f 100755 --- a/rt/lib/RT/ScripActions.pm +++ b/rt/lib/RT/ScripActions.pm @@ -1,70 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripActions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::ScripActions - Collection of Action objects +=head1 NAME + RT::ScripActions -- Class Description + =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::EasySearch; + +use RT::SearchBuilder; use RT::ScripAction; -@ISA= qw(RT::EasySearch); +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -# {{{ sub _Init -sub _Init { - my $self = shift; - $self->{'table'} = "ScripActions"; - $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'); - + +sub _Init { + my $self = shift; + $self->{'table'} = 'ScripActions'; + $self->{'primary_key'} = 'id'; + + + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub NewItem -sub NewItem { - my $self = shift; - return(RT::ScripAction->new($self->CurrentUser)); +=item NewItem + +Returns an empty new RT::ScripAction item + +=cut + +sub NewItem { + my $self = shift; + return(RT::ScripAction->new($self->CurrentUser)); } -# }}} + eval "require RT::ScripActions_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/ScripActions_Overlay.pm}) { + die $@; + }; -1; + 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 253502bd4..fe0aa2d5a 100755 --- a/rt/lib/RT/ScripCondition.pm +++ b/rt/lib/RT/ScripCondition.pm @@ -1,192 +1,302 @@ -# 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 $ +# 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; + =head1 NAME - RT::ScripCondition - RT scrip conditional +RT::ScripCondition + =head1 SYNOPSIS - use RT::ScripCondition; +=head1 DESCRIPTION +=head1 METHODS -=head1 DESCRIPTION +=cut -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. +package RT::ScripCondition; +use RT::Record; -=begin testing +use vars qw( @ISA ); +@ISA= qw( RT::Record ); -ok (require RT::TestHarness); -ok (require RT::ScripCondition); +sub _Init { + my $self = shift; -=end testing + $self->Table('ScripConditions'); + $self->SUPER::_Init(@_); +} -=head1 METHODS + + + + +=item Create PARAMHASH + +Create takes a hash of values and creates a row in the database: + + varchar(200) 'Name'. + varchar(255) 'Description'. + varchar(60) 'ExecModule'. + varchar(255) 'Argument'. + varchar(60) 'ApplicableTransTypes'. =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 _Accessible -sub _Accessible { + + +sub Create { my $self = shift; - 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)); + 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'}, +); + } -# }}} -# {{{ sub Create -=head2 Create - - Takes a hash. Creates a new Condition entry. - should be better documented. + +=item id + +Returns the current value of id. +(In the database, id is stored as int(11).) + =cut -sub Create { - my $self = shift; - return($self->SUPER::Create(@_)); -} -# }}} -# {{{ sub Delete +=item Name -=head2 Delete +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).) -No API available for deleting things just yet. =cut -sub Delete { - my $self = shift; - return(0,'Unimplemented'); -} -# }}} -# {{{ sub Load +=item Description -=head2 Load IDENTIFIER +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).) -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)); - } -} -# }}} -# {{{ sub LoadCondition +=item ExecModule + +Returns the current value of ExecModule. +(In the database, ExecModule is stored as varchar(60).) + + + +=item SetExecModule VALUE + -=head2 LoadCondition HASH +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).) -takes a hash which has the following elements: TransactionObj and TicketObj. -Loads the Condition module in question. =cut -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, - ); -} -# }}} +=item Argument + +Returns the current value of Argument. +(In the database, Argument is stored as varchar(255).) -# {{{ The following methods call the Condition object -# {{{ sub Describe +=item SetArgument VALUE -=head2 Describe -Helper method to call the condition module\'s Describe method. +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 -sub Describe { - my $self = shift; - return ($self->{'Condition'}->Describe()); - -} -# }}} -# {{{ sub IsApplicable +=item ApplicableTransTypes -=head2 IsApplicable +Returns the current value of ApplicableTransTypes. +(In the database, ApplicableTransTypes is stored as varchar(60).) + + + +=item SetApplicableTransTypes VALUE + + +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).) -Helper method to call the condition module\'s IsApplicable method. =cut -sub IsApplicable { - my $self = shift; - return ($self->{'Condition'}->IsApplicable()); - -} -# }}} -# }}} +=item Creator -# {{{ sub DESTROY -sub DESTROY { - my $self=shift; - $self->{'Condition'} = undef; -} -# }}} +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) -1; +=cut + + +=item Created + +Returns the current value of Created. +(In the database, Created is stored as datetime.) + + +=cut + + +=item LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=item LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) +=cut + + + +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. + +RT::ScripCondition_Overlay, RT::ScripCondition_Vendor, RT::ScripCondition_Local + +=cut + + +1; diff --git a/rt/lib/RT/ScripConditions.pm b/rt/lib/RT/ScripConditions.pm index 236e6718d..34f788d9c 100755 --- a/rt/lib/RT/ScripConditions.pm +++ b/rt/lib/RT/ScripConditions.pm @@ -1,69 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripConditions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::ScripConditions - Collection of Action objects +=head1 NAME + RT::ScripConditions -- Class Description + =head1 SYNOPSIS - use RT::ScripConditions; - + use RT::ScripConditions =head1 DESCRIPTION - -=begin testing - -ok (require RT::TestHarness); -ok (require RT::ScripConditions); - -=end testing - =head1 METHODS =cut package RT::ScripConditions; -use RT::EasySearch; + +use RT::SearchBuilder; 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'); - + +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); + + +sub _Init { + my $self = shift; + $self->{'table'} = 'ScripConditions'; + $self->{'primary_key'} = 'id'; + + + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub NewItem -sub NewItem { - my $self = shift; - return(RT::ScripCondition->new($self->CurrentUser)); + +=item NewItem + +Returns an empty new RT::ScripCondition item + +=cut + +sub NewItem { + my $self = shift; + return(RT::ScripCondition->new($self->CurrentUser)); } -# }}} + eval "require RT::ScripConditions_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/ScripConditions_Overlay.pm}) { + die $@; + }; -1; + 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 + + +1; diff --git a/rt/lib/RT/Scrips.pm b/rt/lib/RT/Scrips.pm index 90be847d8..a39443136 100755 --- a/rt/lib/RT/Scrips.pm +++ b/rt/lib/RT/Scrips.pm @@ -1,127 +1,115 @@ -# 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 $ +# 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; -=head1 NAME - RT::Scrips - a collection of RT Scrip objects +=head1 NAME + RT::Scrips -- Class Description + =head1 SYNOPSIS - use RT::Scrips; + use RT::Scrips =head1 DESCRIPTION =head1 METHODS +=cut -=begin testing +package RT::Scrips; -ok (require RT::TestHarness); -ok (require RT::Scrips); +use RT::SearchBuilder; +use RT::Scrip; -=end testing +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -=cut -package RT::Scrips; -use RT::EasySearch; -use RT::Scrip; -@ISA= qw(RT::EasySearch); +sub _Init { + my $self = shift; + $self->{'table'} = 'Scrips'; + $self->{'primary_key'} = 'id'; -# {{{ sub _Init -sub _Init { - my $self = shift; - $self->{'table'} = "Scrips"; - $self->{'primary_key'} = "id"; - return ( $self->SUPER::_Init(@_)); + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub LimitToQueue -=head2 LimitToQueue +=item NewItem -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 +Returns an empty new RT::Scrip item =cut -sub LimitToQueue { - my $self = shift; - my $queue = shift; - - $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Queue', - VALUE => "$queue") - if defined $queue; - +sub NewItem { + my $self = shift; + return(RT::Scrip->new($self->CurrentUser)); } -# }}} -# {{{ sub LimitToGlobal + eval "require RT::Scrips_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Scrips_Overlay.pm}) { + die $@; + }; -=head2 LimitToGlobal + eval "require RT::Scrips_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Scrips_Vendor.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 + eval "require RT::Scrips_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Scrips_Local.pm}) { + die $@; + }; -=cut -sub LimitToGlobal { - my $self = shift; - - $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Queue', - VALUE => 0); - -} -# }}} -# {{{ sub NewItem -sub NewItem { - my $self = shift; - - return(new RT::Scrip($self->CurrentUser)); -} -# }}} +=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. -# {{{ sub Next +If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line -=head2 Next + no warnings qw(redefine); -Returns the next scrip that this user can see. +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. + +RT::Scrips_Overlay, RT::Scrips_Vendor, RT::Scrips_Local =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; +1; diff --git a/rt/lib/RT/Template.pm b/rt/lib/RT/Template.pm index 3ef96c7df..f73ea3ed6 100755 --- a/rt/lib/RT/Template.pm +++ b/rt/lib/RT/Template.pm @@ -1,395 +1,363 @@ -# $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 +# 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; + =head1 NAME - RT::Template - RT's template object +RT::Template + =head1 SYNOPSIS - use RT::Template; +=head1 DESCRIPTION +=head1 METHODS -=head1 DESCRIPTION +=cut +package RT::Template; +use RT::Record; +use RT::Queue; -=head1 METHODS -=begin testing +use vars qw( @ISA ); +@ISA= qw( RT::Record ); + +sub _Init { + my $self = shift; + + $self->Table('Templates'); + $self->SUPER::_Init(@_); +} + + + + + +=item Create PARAMHASH -ok(require RT::TestHarness); -ok(require RT::Template); +Create takes a hash of values and creates a row in the database: -=end testing + int(11) 'Queue'. + varchar(200) 'Name'. + varchar(255) 'Description'. + varchar(16) 'Type'. + varchar(16) 'Language'. + int(11) 'TranslationOf'. + blob 'Content'. =cut -package RT::Template; -use RT::Record; -use MIME::Entity; -use MIME::Parser; -@ISA = qw(RT::Record); -# {{{ sub _Init -sub _Init { +sub Create { my $self = shift; - $self->{'table'} = "Templates"; - return ( $self->SUPER::_Init(@_) ); + 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'}, +); + } -# }}} -# {{{ sub _Accessible -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 id -# }}} +Returns the current value of id. +(In the database, id is stored as int(11).) -# {{{ sub _Set -sub _Set { - my $self = shift; +=cut - # 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 Queue + +Returns the current value of Queue. +(In the database, Queue is stored as int(11).) -# }}} -# {{{ sub _Value -=head2 _Value +=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).) -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; +=item QueueObj - #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) ); +Returns the Queue Object which has the id returned by Queue + +=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).) + + -# {{{ sub Load +=item SetName VALUE -=head2 Load <identifer> -Load a template, either by number or by name +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 Load { - my $self = shift; - my $identifier = shift; - if ( !$identifier ) { - return (undef); - } +=item Description + +Returns the current value of Description. +(In the database, Description is stored as varchar(255).) - if ( $identifier !~ /\D/ ) { - $self->SUPER::LoadById($identifier); - } - else { - $self->LoadByCol( 'Name', $identifier ); - } -} -# }}} +=item SetDescription VALUE -# {{{ sub LoadGlobalTemplate -=head2 LoadGlobalTemplate NAME +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).) -Load the global tempalte with the name NAME =cut -sub LoadGlobalTemplate { - my $self = shift; - my $id = shift; - return ( $self->LoadQueueTemplate( Queue => 0, Name => $id ) ); -} +=item Type -# }}} +Returns the current value of Type. +(In the database, Type is stored as varchar(16).) -# {{{ sub LoadQueueTemplate -=head2 LoadQueueTemplate (Queue => QUEUEID, Name => NAME) -Loads the Queue template named NAME for Queue QUEUE. +=item SetType VALUE + + +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).) + =cut -sub LoadQueueTemplate { - my $self = shift; - my %args = ( - Queue => undef, - Name => undef - ); - return ( $self->LoadByCols( Name => $args{'Name'}, Queue => {'Queue'} ) ); +=item Language -} +Returns the current value of Language. +(In the database, Language is stored as varchar(16).) -# }}} -# {{{ sub Create -=head2 Create +=item SetLanguage VALUE -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. -Returns the Template's id # if the create was successful. Returns undef for -unknown database failure. +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).) =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 -=head2 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).) -Delete this template. =cut -sub Delete { - my $self = shift; - unless ( $self->CurrentUserHasRight('ModifyTemplate') ) { - return ( 0, 'Permission Denied' ); - } +=item Content - return ( $self->SUPER::Delete(@_) ); -} +Returns the current value of Content. +(In the database, Content is stored as blob.) -# }}} -# {{{ sub MIMEObj -sub MIMEObj { - my $self = shift; - return ( $self->{'MIMEObj'} ); -} -# }}} +=item SetContent VALUE -# {{{ sub Parse -=item 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.) - 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; - #We're passing in whatever we were passed. it's destined for _ParseContent - my $content = $self->_ParseContent(@_); +=item LastUpdated - #Lets build our mime Entity +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) - my $parser = MIME::Parser->new(); - - # Do work on the parsed template in memory, rather than on disk - $parser->output_to_core(1); - ### Should we forgive normally-fatal errors? - $parser->ignore_errors(1); - $self->{'MIMEObj'} = eval { $parser->parse_data($content) }; - $error = ( $@ || $parser->last_error ); +=cut - if ($error) { - $RT::Logger->error("$error"); - return ( 0, $error ); - } - # Unfold all headers - $self->{'MIMEObj'}->head->unfold(); +=item LastUpdatedBy - return ( 1, "Template parsed" ); - +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) -} -# }}} +=cut -# {{{ sub _ParseContent -# Perform Template substitutions on the template +=item Creator -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); -} +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) -# }}} -# {{{ sub QueueObj +=cut -=head2 QueueObj -Takes nothing. returns this ticket's queue object +=item Created + +Returns the current value of Created. +(In the database, Created is stored as datetime.) + =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 CurrentUserHasQueueRight +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 $@; + }; -=head2 CurrentUserHasQueueRight -Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args. + + +=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::Template_Overlay, RT::Template_Vendor, RT::Template_Local =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 b5b483c96..37db84086 100755 --- a/rt/lib/RT/Templates.pm +++ b/rt/lib/RT/Templates.pm @@ -1,122 +1,115 @@ -# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Templates.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::Templates - a collection of RT Template objects +=head1 NAME + RT::Templates -- Class Description + =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; -# {{{ sub _Init +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -=head2 _Init - - Returns RT::Templates specific init info like table and primary key names - -=cut sub _Init { - my $self = shift; - $self->{'table'} = "Templates"; - $self->{'primary_key'} = "id"; - return ($self->SUPER::_Init(@_)); + $self->{'table'} = 'Templates'; + $self->{'primary_key'} = 'id'; + + + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ LimitToNotInQueue -=head2 LimitToNotInQueue +=item NewItem -Takes a queue id # and limits the returned set of templates to those which -aren't that queue's templates. +Returns an empty new RT::Template item =cut -sub LimitToNotInQueue { +sub NewItem { my $self = shift; - my $queue_id = shift; - $self->Limit(FIELD => 'Queue', - VALUE => "$queue_id", - OPERATOR => '!=' - ); + return(RT::Template->new($self->CurrentUser)); } -# }}} -# {{{ LimitToGlobal + eval "require RT::Templates_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Templates_Overlay.pm}) { + die $@; + }; -=head2 LimitToGlobal + eval "require RT::Templates_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Templates_Vendor.pm}) { + die $@; + }; -Takes no arguments. Limits the returned set to "Global" templates -which can be used with any queue. + eval "require RT::Templates_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Templates_Local.pm}) { + die $@; + }; -=cut -sub LimitToGlobal { - my $self = shift; - my $queue_id = shift; - $self->Limit(FIELD => 'Queue', - VALUE => "0", - OPERATOR => '=' - ); -} -# }}} -# {{{ LimitToQueue -=head2 LimitToQueue +=head1 SEE ALSO -Takes a queue id # and limits the returned set of templates to that queue's -templates +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. -sub LimitToQueue { - my $self = shift; - my $queue_id = shift; - $self->Limit(FIELD => 'Queue', - VALUE => "$queue_id", - OPERATOR => '=' - ); -} -# }}} +If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line -# {{{ sub NewItem + no warnings qw(redefine); -=head2 NewItem +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. -Returns a new empty Template object +RT::Templates_Overlay, RT::Templates_Vendor, RT::Templates_Local =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 deleted file mode 100644 index 160e9e636..000000000 --- a/rt/lib/RT/TestHarness.pm +++ /dev/null @@ -1,14 +0,0 @@ -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 f7275e4e3..2f075a20c 100755 --- a/rt/lib/RT/Ticket.pm +++ b/rt/lib/RT/Ticket.pm @@ -1,3004 +1,662 @@ -# $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 +# 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 !! # -=head1 NAME +use strict; - RT::Ticket - RT ticket object -=head1 SYNOPSIS +=head1 NAME - use RT::Ticket; - my $ticket = new RT::Ticket($CurrentUser); - $ticket->Load($ticket_id); +RT::Ticket -=head1 DESCRIPTION -This module lets you manipulate RT\'s ticket object. +=head1 SYNOPSIS +=head1 DESCRIPTION =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; - - -@ISA= qw(RT::Record); - -=begin testing -use RT::TestHarness; - -ok(require RT::Ticket, "Loading the RT::Ticket library"); - -=end testing - -=cut - -# {{{ sub _Init +use vars qw( @ISA ); +@ISA= qw( RT::Record ); 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. - -=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); - -} - -# }}} + my $self = shift; -# {{{ 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); - } + $self->Table('Tickets'); + $self->SUPER::_Init(@_); } -# }}} - -# {{{ 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 = ( - 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"); - } - - - 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. +=item Create PARAMHASH -Arguments are identical to Create(), with the addition of - Id - Ticket Id +Create takes a hash of values and creates a row in the database: -Returns: TICKETID + 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'. =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.'); -} -# }}} - -# {{{ Routines dealing with watchers. - -# {{{ 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)); -} - - -#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 - -=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', @_)); -} - -# }}} - -# {{{ sub AddCc - -=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 - -AddAdminCc takes what AddWatcher does, except it presets -the "Type" parameter to \'AdminCc\' - -=cut - -sub AddAdminCc { - my $self = shift; - return ($self->AddWatcher ( Type => 'AdminCc', @_)); -} - -# }}} - -# }}} - -# {{{ sub DeleteWatcher - -=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 -sub DeleteWatcher { +sub Create { 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"); -} - -# {{{ sub DeleteRequestor - -=head2 DeleteRequestor EMAIL + 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', -Takes an email address. It calls DeleteWatcher with a preset -type of 'Requestor' - - -=cut + @_); + $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'}, +); -sub DeleteRequestor { - my $self = shift; - my $id = shift; - return ($self->DeleteWatcher ($id, 'Requestor')) } -# }}} - -# {{{ sub DeleteCc - -=head2 DeleteCc EMAIL - -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')) -} - -# }}} - -# {{{ 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 +=item id -Watchers returns a Watchers object preloaded with this ticket\'s watchers. +Returns the current value of id. +(In the database, id is stored as int(11).) -# 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); - -} - -# }}} -# {{{ a set of [foo]AsString subs that will return the various sorts of watchers for a ticket/queue as a comma delineated string +=item EffectiveId -=head2 RequestorsAsString +Returns the current value of EffectiveId. +(In the database, EffectiveId is stored as int(11).) - B<Returns> String: All Ticket Requestor email addresses as a string. -=cut -sub RequestorsAsString { - my $self=shift; +=item SetEffectiveId VALUE - unless ($self->CurrentUserHasRight('ShowTicket')) { - return undef; - } - - return ($self->Requestors->EmailsAsString() ); -} -=head2 WatchersAsString +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).) -B<Returns> String: All Ticket Watchers email addresses as a string =cut -sub WatchersAsString { - my $self=shift; - - unless ($self->CurrentUserHasRight('ShowTicket')) { - return (0, "Permission Denied"); - } - - return ($self->Watchers->EmailsAsString()); - -} -=head2 AdminCcAsString +=item Queue -returns String: All Ticket AdminCc email addresses as a string +Returns the current value of Queue. +(In the database, Queue is stored as int(11).) -=cut -sub AdminCcAsString { - my $self=shift; +=item SetQueue VALUE - unless ($self->CurrentUserHasRight('ShowTicket')) { - return undef; - } - - return ($self->AdminCc->EmailsAsString()); - -} -=head2 CcAsString +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).) -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()); - -} - -# }}} - -# {{{ Routines that return RT::Watchers objects of Requestors, Ccs and AdminCcs -# {{{ sub Requestors +=item QueueObj -=head2 Requestors +Returns the Queue Object which has the id returned by Queue -Takes nothing. -Returns this ticket's Requestors as an RT::Watchers object - -=cut - -sub Requestors { - my $self = shift; - - my $requestors = $self->Watchers(); - if ($self->CurrentUserHasRight('ShowTicket')) { - $requestors->LimitToRequestors(); - } - - return($requestors); - -} - -# }}} - -# {{{ 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); - -} - -# }}} - -# {{{ sub AdminCc - -=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); -} - -# }}} - -# }}} - -# {{{ IsWatcher,IsRequestor,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 ticket watcher. Returns undef otherwise - -=cut - -sub IsWatcher { - my $self = shift; - - 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); - } - -} -# }}} - -# {{{ 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. - - -=cut - -sub IsRequestor { - my $self = shift; - my $person = shift; - - return ($self->IsWatcher(Type => 'Requestor', Id => $person)); - -}; - -# }}} - -# {{{ 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 - -=head2 IsAdminCc - -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 )); - -} - -# }}} - -# {{{ sub IsOwner - -=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); - } -} - - -# }}} - -# }}} - -# }}} - -# {{{ Routines dealing with queues - -# {{{ 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 - -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())); - -} - -# }}} - -# {{{ 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); + my $self = shift; + my $Queue = RT::Queue->new($self->CurrentUser); + $Queue->Load($self->__Value('Queue')); + return($Queue); } +=item Type -# }}} +Returns the current value of Type. +(In the database, Type is stored as varchar(16).) -# }}} -# {{{ Date printing routines -# {{{ sub DueObj - -=head2 DueObj - - Returns an RT::Date object containing this ticket's due date - -=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; -} -# }}} +=item SetType VALUE -# {{{ sub DueAsString -=head2 DueAsString +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).) -Returns this ticket's due date as a human readable string =cut -sub DueAsString { - my $self = shift; - return $self->DueObj->AsString(); -} - -# }}} -# {{{ sub GraceTimeAsString +=item IssueStatement -=head2 GraceTimeAsString +Returns the current value of IssueStatement. +(In the database, IssueStatement 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 SetIssueStatement VALUE -# {{{ sub ResolvedObj -=head2 ResolvedObj +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).) - Returns an RT::Date object of this ticket's 'resolved' time. =cut -sub ResolvedObj { - my $self = shift; - my $time = new RT::Date($self->CurrentUser); - $time->Set(Format => 'sql', Value => $self->Resolved); - return $time; -} -# }}} +=item Resolution -# {{{ sub SetStarted +Returns the current value of Resolution. +(In the database, Resolution is stored as int(11).) -=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" -=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)); - -} +=item SetResolution VALUE -# }}} -# {{{ sub StartedObj +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).) -=head2 StartedObj - - Returns an RT::Date object which contains this ticket's -'Started' time. =cut -sub StartedObj { - my $self = shift; - - my $time = new RT::Date($self->CurrentUser); - $time->Set(Format => 'sql', Value => $self->Started); - return $time; -} -# }}} +=item Owner -# {{{ sub StartsObj +Returns the current value of Owner. +(In the database, Owner is stored as int(11).) -=head2 StartsObj - Returns an RT::Date object which contains this ticket's -'Starts' time. -=cut - -sub StartsObj { - my $self = shift; - - my $time = new RT::Date($self->CurrentUser); - $time->Set(Format => 'sql', Value => $self->Starts); - return $time; -} -# }}} +=item SetOwner VALUE -# {{{ sub ToldObj -=head2 ToldObj +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).) - Returns an RT::Date object which contains this ticket's -'Told' time. =cut -sub ToldObj { - my $self = shift; - - my $time = new RT::Date($self->CurrentUser); - $time->Set(Format => 'sql', Value => $self->Told); - return $time; -} +=item Subject -# }}} +Returns the current value of Subject. +(In the database, Subject is stored as varchar(200).) -# {{{ sub LongSinceToldAsString -# TODO this should be deprecated +=item SetSubject VALUE -sub LongSinceToldAsString { - my $self = shift; - - if ($self->Told) { - return $self->ToldObj->AgeAsString(); - } else { - return "Never"; - } -} -# }}} - -# {{{ sub ToldAsString -=head2 ToldAsString +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).) -A convenience method that returns ToldObj->AsString - -TODO: This should be deprecated =cut -sub ToldAsString { - my $self = shift; - if ($self->Told) { - return $self->ToldObj->AsString(); - } - else { - return("Never"); - } -} -# }}} - -# {{{ sub TimeWorkedAsString +=item InitialPriority -=head2 TimeWorkedAsString +Returns the current value of InitialPriority. +(In the database, InitialPriority is stored as int(11).) -Returns the amount of time worked on this ticket as a Text String -=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)); -} +=item SetInitialPriority VALUE -# }}} +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).) -# }}} - -# {{{ 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"); -} - -# }}} -# {{{ sub Correspond +=item FinalPriority -=head2 Correspond +Returns the current value of FinalPriority. +(In the database, FinalPriority is stored as int(11).) -Correspond on this ticket. -Takes a hashref with the following attributes: - - -MIMEObj, TimeTaken, CcMessageTo, BccMessageTo - -=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"); -} -# }}} -# }}} +=item SetFinalPriority VALUE -# {{{ Routines dealing with Links and Relations between tickets -# {{{ Link Collections +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 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 Priority -=head2 MemberOf +Returns the current value of Priority. +(In the database, Priority is stored as int(11).) - 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 SetPriority VALUE -# {{{ RefersTo -=head2 RefersTo +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).) - 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')); -} - -# }}} -# {{{ ReferredToBy +=item TimeEstimated -=head2 ReferredToBy +Returns the current value of TimeEstimated. +(In the database, TimeEstimated is stored as int(11).) - This returns an RT::Links object which shows all references for which this ticket is a target -=cut -sub ReferredToBy { - my $self = shift; - return ($self->_Links('Target', 'RefersTo')); -} +=item SetTimeEstimated VALUE -# }}} -# {{{ DependedOnBy +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 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')); -} - -# }}} - -# {{{ DependsOn - -=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')); -} - -# }}} - -# {{{ sub _Links - -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 +=item TimeWorked -=head2 DeleteLink +Returns the current value of TimeWorked. +(In the database, TimeWorked is stored as int(11).) -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"); - } -} +=item SetTimeWorked VALUE -# }}} -# {{{ sub AddLink - -=head2 AddLink - -Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket. +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).) =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 +=item Status -=head2 URI +Returns the current value of Status. +(In the database, Status is stored as varchar(10).) -Returns this ticket's URI -=cut -sub URI { - my $self = shift; - return $RT::TicketBaseURI.$self->id; -} +=item SetStatus VALUE -# }}} -# {{{ sub MergeInto +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 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 TimeLeft -=head2 AddKeyword +Returns the current value of TimeLeft. +(In the database, TimeLeft is stored as int(11).) -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 +=item SetTimeLeft VALUE -sub AddKeyword { - my $self = shift; - #ACL check - unless ($self->CurrentUserHasRight('ModifyTicket')) { - return (0, 'Permission Denied'); - } - - return($self->_AddKeyword(@_)); - -} +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).) -# 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. =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 Told -# }}} +Returns the current value of Told. +(In the database, Told is stored as datetime.) -# {{{ Routines dealing with ownership -# {{{ sub OwnerObj -=head2 OwnerObj +=item SetTold VALUE -Takes nothing and returns an RT::User object of -this ticket's owner -=cut +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 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); -} +=item Starts -# }}} +Returns the current value of Starts. +(In the database, Starts is stored as datetime.) -# {{{ 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); - -} -# }}} +=item SetStarts VALUE -# {{{ sub Take -=head2 Take +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.) -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')); -} -# }}} +=item Started -# {{{ sub Untake +Returns the current value of Started. +(In the database, Started is stored as datetime.) -=head2 Untake -Convenience method to set the owner to 'nobody' if the current user is the owner. -=cut +=item SetStarted VALUE -sub Untake { - my $self = shift; - return($self->SetOwner($RT::Nobody->UserObj->Id, 'Untake')); -} -# }}} - -# {{{ sub Steal -=head2 Steal +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.) -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 +=item Due -# {{{ sub ValidateStatus +Returns the current value of Due. +(In the database, Due is stored as datetime.) -=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; +=item SetDue VALUE - #Make sure the status passed in is valid - unless ($self->QueueObj->IsValidStatus($status)) { - return (undef); - } - - return (1); -} +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.) -# }}} +=cut -# {{{ sub SetStatus -=head2 SetStatus STATUS +=item Resolved -Set this ticket\'s status. STATUS can be one of: new, open, stalled, resolved or dead. +Returns the current value of Resolved. +(In the database, Resolved is stored as datetime.) -=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')); -} -# }}} +=item SetResolved VALUE -# {{{ sub Kill -=head2 Kill +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.) -Takes no arguments. Marks this ticket for garbage collection =cut -sub Kill { - my $self = shift; - return ($self->SetStatus('dead')); - # TODO: garbage collection -} - -# }}} -# {{{ sub Stall +=item LastUpdatedBy -=head2 Stall +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) -Sets this ticket's status to stalled =cut -sub Stall { - my $self = shift; - return ($self->SetStatus('stalled')); -} - -# }}} -# {{{ sub Open +=item LastUpdated -=head2 Open +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) -Sets this ticket\'s status to Open =cut -sub Open { - my $self = shift; - return ($self->SetStatus('open')); -} - -# }}} -# {{{ sub Resolve +=item Creator -=head2 Resolve +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) -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 +=item Created -=head2 SetTold ISO [TIMETAKEN] +Returns the current value of Created. +(In the database, Created is stored as datetime.) -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 +=item Disabled -Updates the told without a transaction or acl check. Useful when we're sending replies. +Returns the current value of Disabled. +(In the database, Disabled is stored as smallint(6).) -=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)); -} -# }}} +=item SetDisabled VALUE -# {{{ sub Transactions -=head2 Transactions +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).) - 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 { { - 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); - } -} - -# }}} - -# {{{ sub _Value - -=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->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)); - -} - -# }}} - -# {{{ sub _UpdateTimeTaken - -=head2 _UpdateTimeTaken - -This routine will increment the timeworked counter. it should -only be called from _NewTransaction - -=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); -} + + 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'}, + + } +}; -# }}} -# }}} + eval "require RT::Ticket_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Ticket_Overlay.pm}) { + die $@; + }; -# {{{ Routines dealing with ACCESS CONTROL + eval "require RT::Ticket_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Ticket_Vendor.pm}) { + die $@; + }; -# {{{ sub CurrentUserHasRight + eval "require RT::Ticket_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Ticket_Local.pm}) { + die $@; + }; -=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")); +=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. -# {{{ sub HasRight +If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line -=head2 HasRight + no warnings qw(redefine); - 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 +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - Returns 1 if the principal has the right. Returns undef if not. +RT::Ticket_Overlay, RT::Ticket_Vendor, RT::Ticket_Local =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 dd91126c4..b6b349144 100755 --- a/rt/lib/RT/Tickets.pm +++ b/rt/lib/RT/Tickets.pm @@ -1,1789 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Tickets.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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 !! +# -=head1 NAME +use strict; - RT::Tickets - A collection of Ticket objects +=head1 NAME + RT::Tickets -- Class Description + =head1 SYNOPSIS - use RT::Tickets; - my $tickets = new RT::Tickets($CurrentUser); + use RT::Tickets =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::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', - ); - -} - -# }}} - -# {{{ LimitDependedOnBy - -sub LimitDependedOnBy { - my $self = shift; - my $ticket_id = shift; - $self->LimitLinkedFrom ( BASE => "$ticket_id", - TYPE => 'DependsOn', - ); - -} - -# }}} - - -# {{{ 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 - -=head2 LimitDate (FIELD => 'DateField', 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 -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 LimitDate { - my $self = shift; - 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); - -} - -# }}} - - - - -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', @_); - -} -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); - -} - -# }}} - -# }}} - -# {{{ sub LimitKeyword - -=head2 LimitKeyword - -Takes a paramhash of key/value pairs with the following keys: - -=over 4 - -=item KEYWORDSELECT - KeywordSelect id - -=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 +use RT::SearchBuilder; +use RT::Ticket; -Takes a restriction field and returns a list of values this field is restricted -to. +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -=cut -sub RestrictionValues { +sub _Init { 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 + $self->{'table'} = 'Tickets'; + $self->{'primary_key'} = 'id'; -=head2 ClearRestrictions -Removes all restrictions irretrievably - -=cut - -sub ClearRestrictions { - my $self = shift; - delete $self->{'TicketRestrictions'}; - $self->{'looking_at_effective_id'} = 0; - $self->{'RecalcTicketLimits'} =1; + return ( $self->SUPER::_Init(@_) ); } -# }}} - -# {{{ sub DeleteRestriction -=head2 DeleteRestriction +=item NewItem -Takes the row Id of a restriction (From DescribeRestrictions' output, for example. -Removes that restriction from the session's limits. +Returns an empty new RT::Ticket item =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 { +sub NewItem { 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; + return(RT::Ticket->new($self->CurrentUser)); } -# }}} - -# }}} - -# {{{ Deal with displaying rows of the listing + eval "require RT::Tickets_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Tickets_Overlay.pm}) { + die $@; + }; -# -# 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. -# + 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 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 +=head1 SEE ALSO -Format strings are made up of a chain of Elements delimited with vertical pipes (|). -Elements of a Format string +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. -FormatString: Element[::FormatString] +If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line -Element: AttributeName[;HREF=<URL>][;TITLE=<TITLE>] + no warnings qw(redefine); -AttributeName Id | Subject | Status | Owner | Priority | InitialPriority | TimeWorked | TimeLeft | - - Keywords[;SELECT=<KeywordSelect>] | - - <Created|Starts|Started|Contacted|Due|Resolved>Date<AsString|AsISO|AsAge> +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. +RT::Tickets_Overlay, RT::Tickets_Vendor, RT::Tickets_Local =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 ee1f069b2..ca491a6c7 100755 --- a/rt/lib/RT/Transaction.pm +++ b/rt/lib/RT/Transaction.pm @@ -1,783 +1,364 @@ -# $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 +# 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; + =head1 NAME - RT::Transaction - RT\'s transaction object +RT::Transaction + =head1 SYNOPSIS - use RT::Transaction; +=head1 DESCRIPTION +=head1 METHODS -=head1 DESCRIPTION +=cut +package RT::Transaction; +use RT::Record; +use RT::Ticket; -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. +use vars qw( @ISA ); +@ISA= qw( RT::Record ); + +sub _Init { + my $self = shift; + + $self->Table('Transactions'); + $self->SUPER::_Init(@_); +} -=head1 METHODS -=begin testing -ok(require RT::TestHarness); -ok(require RT::Transaction); -=end testing + +=item Create PARAMHASH + +Create takes a hash of values and creates a row in the database: + + int(11) 'EffectiveTicket'. + int(11) 'Ticket'. + int(11) 'TimeTaken'. + varchar(20) 'Type'. + varchar(40) 'Field'. + varchar(255) 'OldValue'. + varchar(255) 'NewValue'. + varchar(100) 'Data'. =cut -package RT::Transaction; -use RT::Record; -@ISA= qw(RT::Record); - -use RT::Attachments; -# {{{ sub _Init -sub _Init { + +sub Create { my $self = shift; - $self->{'table'} = "Transactions"; - return ($self->SUPER::_Init(@_)); + 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'}, +); } -# }}} -# {{{ sub Create -=head2 Create -Create a new transaction. +=item id -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. +Returns the current value of id. +(In the database, id is stored as int(11).) -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 -# {{{ sub Delete +Returns the current value of EffectiveTicket. +(In the database, EffectiveTicket is stored as int(11).) -sub Delete { - my $self = shift; - return (0, 'Deleting this object could break referential integrity'); -} -# }}} -# {{{ Routines dealing with Attachments +=item SetEffectiveTicket VALUE -# {{{ sub Message -=head2 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).) - Returns the RT::Attachments Object which contains the "top-level" object - attachment for this transaction =cut -sub Message { - 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'}); -} -# }}} +=item Ticket + +Returns the current value of Ticket. +(In the database, Ticket is stored as int(11).) + -# {{{ sub Content -=head2 Content PARAMHASH +=item SetTicket VALUE -If this transaction has attached mime objects, returns the first text/ part. -Otherwise, returns undef. -Takes a paramhash. If the $args{'Quote'} parameter is set, wraps this message -at $args{'Wrap'}. $args{'Wrap'} defaults to 70. +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).) =cut -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); -} -# }}} -# {{{ sub Subject +=item TicketObj + +Returns the Ticket Object which has the id returned by Ticket -=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); - } +sub TicketObj { + my $self = shift; + my $Ticket = RT::Ticket->new($self->CurrentUser); + $Ticket->Load($self->__Value('Ticket')); + return($Ticket); } -# }}} -# {{{ sub Attachments +=item TimeTaken + +Returns the current value of TimeTaken. +(In the database, TimeTaken is stored as int(11).) + -=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. +=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).) + =cut -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 Type -# }}} +Returns the current value of Type. +(In the database, Type is stored as varchar(20).) -# {{{ sub _Attach -=head2 _Attach -A private method used to attach a mime object to this transaction. +=item SetType VALUE + + +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).) + =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 Field -# }}} +Returns the current value of Field. +(In the database, Field is stored as varchar(40).) -# {{{ Routines dealing with Transaction Attributes -# {{{ sub TicketObj -=head2 TicketObj +=item SetField VALUE + + +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).) -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'}; -} -# }}} -# {{{ sub Description +=item OldValue + +Returns the current value of OldValue. +(In the database, OldValue is stored as varchar(255).) + + + +=item SetOldValue VALUE + -=head2 Description +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).) -Returns a text string which describes this transaction =cut -sub Description { - my $self = shift; +=item NewValue + +Returns the current value of NewValue. +(In the database, NewValue is stored as varchar(255).) - #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); -} -# }}} -# {{{ sub BriefDescription +=item SetNewValue VALUE -=head2 BriefDescription -Returns a text string which briefly describes this transaction +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).) + =cut -sub BriefDescription { - my $self = shift; +=item Data - #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); - - } -} +Returns the current value of Data. +(In the database, Data is stored as varchar(100).) -# }}} -# {{{ Utility methods -# {{{ sub IsInbound +=item SetData VALUE -=head2 IsInbound -Returns true if the creator of the transaction is a requestor of the ticket. -Returns false otherwise +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).) -=cut -sub IsInbound { - my $self=shift; - return ($self->TicketObj->IsRequestor($self->CreatorObj)); -} +=cut -# }}} - -# }}} - -# {{{ 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); -} -# }}} +=item Creator -# }}} +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) -# {{{ sub _Set -sub _Set { - my $self = shift; - return(0, 'Transactions are immutable'); -} +=cut -# }}} -# {{{ sub _Value +=item Created -=head2 _Value +Returns the current value of Created. +(In the database, Created is stored as datetime.) -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')) { - 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)); - -} -# }}} +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 => ''}, -# {{{ sub CurrentUserHasRight + } +}; -=head2 CurrentUserHasRight RIGHT -Calls $self->CurrentUser->HasQueueRight for the right passed in here. -passed in here. + eval "require RT::Transaction_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Transaction_Overlay.pm}) { + die $@; + }; -=cut + eval "require RT::Transaction_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Transaction_Vendor.pm}) { + die $@; + }; -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - return ($self->CurrentUser->HasQueueRight(Right => "$right", - TicketObj => $self->TicketObj)); -} + eval "require RT::Transaction_Local"; + if ($@ && $@ !~ qr{^Can't locate RT/Transaction_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::Transaction_Overlay, RT::Transaction_Vendor, RT::Transaction_Local + +=cut -# }}} 1; diff --git a/rt/lib/RT/Transactions.pm b/rt/lib/RT/Transactions.pm index 2ae98f286..23a475ac6 100755 --- a/rt/lib/RT/Transactions.pm +++ b/rt/lib/RT/Transactions.pm @@ -1,78 +1,115 @@ -#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Transactions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# 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; -=head1 NAME - RT::Transactions - a collection of RT Transaction objects +=head1 NAME + RT::Transactions -- Class Description + =head1 SYNOPSIS - use RT::Transactions; - + use RT::Transactions =head1 DESCRIPTION =head1 METHODS -=begin testing - -ok (require RT::TestHarness); -ok (require RT::Transactions); - -=end testing - =cut package RT::Transactions; -use RT::EasySearch; -@ISA= qw(RT::EasySearch); +use RT::SearchBuilder; use RT::Transaction; -# {{{ 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(@_)); +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); + + +sub _Init { + my $self = shift; + $self->{'table'} = 'Transactions'; + $self->{'primary_key'} = 'id'; + + + return ( $self->SUPER::_Init(@_) ); } -# }}} -# {{{ sub NewItem -sub NewItem { + +=item NewItem + +Returns an empty new RT::Transaction item + +=cut + +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 -LimitDate - -Type TRANSTYPE -Field STRING -OldValue OLDVAL -NewValue NEWVAL -Data DATA -TimeTaken -Actor USEROBJ/USERID -ContentMatches STRING +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 =cut 1; - diff --git a/rt/lib/RT/User.pm b/rt/lib/RT/User.pm index 4e8554030..cbc10f5b4 100755 --- a/rt/lib/RT/User.pm +++ b/rt/lib/RT/User.pm @@ -1,1222 +1,854 @@ -# $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 +# 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; + =head1 NAME - RT::User - RT User object +RT::User -=head1 SYNOPSIS - use RT::User; +=head1 SYNOPSIS =head1 DESCRIPTION - =head1 METHODS -=begin testing +=cut + +package RT::User; +use RT::Record; + + +use vars qw( @ISA ); +@ISA= qw( RT::Record ); + +sub _Init { + my $self = shift; + + $self->Table('Users'); + $self->SUPER::_Init(@_); +} -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 _Init -sub _Init { + +sub Create { my $self = shift; - $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)); + 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'}, +); + } -# }}} -# {{{ sub Create -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 id -# }}} +Returns the current value of id. +(In the database, id is stored as int(11).) -# {{{ sub _BootstrapCreate -#create a user without validating _any_ data. +=cut -#To be used only on database init. -sub _BootstrapCreate { - my $self = shift; - my %args = (@_); +=item Name - $args{'Password'} = "*NO-PASSWORD*"; - my $id = $self->SUPER::Create(%args); - - #If the create failed. - return (0, 'Could not create user') - unless ($id); +Returns the current value of Name. +(In the database, Name is stored as varchar(200).) - return ($id, 'User created'); -} -# }}} -# {{{ sub Delete +=item SetName VALUE -sub Delete { - my $self = shift; - - return(0, 'Deleting this object would violate referential integrity'); - -} -# }}} +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).) -# {{{ sub Load -=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. +=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 -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 Comments + +Returns the current value of Comments. +(In the database, Comments is stored as blob.) -# {{{ sub LoadByEmail -=head2 LoadByEmail +=item SetComments VALUE -Tries to load this user object from the database by the user's email address. + +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 -sub LoadByEmail { - my $self=shift; - my $address = shift; - # Never load an empty address as an email address. - unless ($address) { - return(undef); - } +=item Signature - $address = RT::CanonicalizeAddress($address); - #$RT::Logger->debug("Trying to load an email address: $address\n"); - return $self->LoadByCol("EmailAddress", $address); -} -# }}} +Returns the current value of Signature. +(In the database, Signature is stored as blob.) -# {{{ sub ValidateEmailAddress -=head2 ValidateEmailAddress ADDRESS +=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.) -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; - # if the email address is null, it's always valid - return (1) if(!$Value || $Value eq ""); +=item EmailAddress - my $TempUser = RT::User->new($RT::SystemUser); - $TempUser->LoadByEmail($Value); +Returns the current value of EmailAddress. +(In the database, EmailAddress is stored as varchar(120).) - 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); - } -} -# }}} +=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.) -# {{{ sub SetRandomPassword +=item SetFreeformContactInfo VALUE -=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. +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 -sub SetRandomPassword { - my $self = shift; +=item Organization - unless ($self->CurrentUserCanModify('Password')) { - return (0, "Permission Denied"); - } - - my $pass = $self->GenerateRandomPassword(6,8); +Returns the current value of Organization. +(In the database, Organization is stored as varchar(200).) - # 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 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).) -# {{{ sub ResetPassword -=head2 ResetPassword +=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).) -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 -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 NickName -# }}} +Returns the current value of NickName. +(In the database, NickName is stored as varchar(16).) -# {{{ sub GenerateRandomPassword -=head2 GenerateRandomPassword MIN_LEN and MAX_LEN -Returns a random password between MIN_LEN and MAX_LEN characters long. +=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 -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); - -} +=item Lang + +Returns the current value of Lang. +(In the database, Lang is stored as varchar(16).) -#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); -} -# }}} -# {{{ sub SetPassword +=item SetLang VALUE -=head2 SetPassword -Takes a string. Checks the string's length and sets this user's password -to that string. +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 -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 EmailEncoding + +Returns the current value of EmailEncoding. +(In the database, EmailEncoding is stored as varchar(16).) -# {{{ sub IsPassword -=head2 IsPassword -Returns true if the passed in value is this user's password. -Returns undef otherwise. +=item SetEmailEncoding VALUE + + +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).) + =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 WebEncoding + +Returns the current value of WebEncoding. +(In the database, WebEncoding is stored as varchar(16).) -# {{{ sub SetDisabled -=head2 Sub SetDisabled -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. +=item SetWebEncoding VALUE -=cut -# }}} +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).) -# {{{ ACL Related routines -# {{{ GrantQueueRight +=cut + -=head2 GrantQueueRight +=item ExternalContactInfoId + +Returns the current value of ExternalContactInfoId. +(In the database, ExternalContactInfoId is stored as varchar(100).) + + + +=item SetExternalContactInfoId VALUE + + +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).) -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 ContactInfoSystem + +Returns the current value of ContactInfoSystem. +(In the database, ContactInfoSystem is stored as varchar(30).) + + -# {{{ GrantSystemRight +=item SetContactInfoSystem VALUE -=head2 GrantSystemRight -Grant a system right to this user. -The only element that's important to set is RightName. +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).) + =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 ExternalAuthId + +Returns the current value of ExternalAuthId. +(In the database, ExternalAuthId is stored as varchar(100).) -# {{{ sub HasQueueRight -=head2 HasQueueRight -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' +=item SetExternalAuthId VALUE -Returns 1 if this user has the right specified in the paramhash. for the queue -passed in. +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).) -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); - -} -# }}} - -# {{{ sub HasSystemRight +=item AuthSystem + +Returns the current value of AuthSystem. +(In the database, AuthSystem is stored as varchar(30).) + -=head2 HasSystemRight -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) +=item SetAuthSystem VALUE + + +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).) -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 Gecos + +Returns the current value of Gecos. +(In the database, Gecos is stored as varchar(16).) + + -# {{{ sub _HasRight +=item SetGecos VALUE -=head2 sub _HasRight (Right => 'right', Scope => 'scope', AppliesTo => int, ExtendedPrincipals => SQL) -_HasRight is a private helper method for checking a user's rights. It takes -several options: +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 + -=item Right is a textual right name +=item HomePhone -=item Scope is a textual scope name. (As of July these were Queue, Ticket and System +Returns the current value of HomePhone. +(In the database, HomePhone is stored as varchar(30).) -=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 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. +=item SetHomePhone VALUE + + +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).) -Returns undef if no ACE was found. =cut -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 WorkPhone + +Returns the current value of WorkPhone. +(In the database, WorkPhone is stored as varchar(30).) + + -# }}} +=item SetWorkPhone VALUE -# {{{ sub CurrentUserCanModify -=head2 CurrentUserCanModify RIGHT +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).) -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 MobilePhone + +Returns the current value of MobilePhone. +(In the database, MobilePhone is stored as varchar(30).) + -# {{{ sub CurrentUserHasRight -=head2 CurrentUserHasRight - - Takes a single argument. returns 1 if $Self->CurrentUser - has the requested right. returns undef otherwise +=item SetMobilePhone VALUE + + +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).) + =cut -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - return ($self->CurrentUser->HasSystemRight($right)); -} -# }}} +=item PagerPhone +Returns the current value of PagerPhone. +(In the database, PagerPhone is stored as varchar(30).) -# {{{ sub _Set -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 SetPagerPhone VALUE - if ($self->Privileged == 2) { - return (0, "Can not modify system users"); - } - unless ($self->CurrentUserCanModify($args{'Field'})) { - return (0, "Permission Denied"); - } +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).) + + +=cut + + +=item Address1 + +Returns the current value of Address1. +(In the database, Address1 is stored as varchar(200).) - - #Set the new value - my ($ret, $msg)=$self->SUPER::_Set(Field => $args{'Field'}, - Value=> $args{'Value'}); - - return ($ret, $msg); -} -# }}} -# {{{ sub _Value +=item SetAddress1 VALUE -=head2 _Value -Takes the name of a table column. -Returns its value as a string, if the user passes an ACL check +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 _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); - } - -} +=item Address2 + +Returns the current value of Address2. +(In the database, Address2 is stored as varchar(200).) + + + +=item SetAddress2 VALUE + + +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).) + + +=cut + + +=item City + +Returns the current value of City. +(In the database, City is stored as varchar(100).) + + + +=item SetCity VALUE + + +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).) + + +=cut + + +=item State + +Returns the current value of State. +(In the database, State is stored as varchar(100).) + + + +=item SetState VALUE + + +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).) + + +=cut + + +=item Zip + +Returns the current value of Zip. +(In the database, Zip is stored as varchar(16).) + + + +=item SetZip VALUE + + +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).) + + +=cut + + +=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 + + +=item Timezone + +Returns the current value of Timezone. +(In the database, Timezone is stored as varchar(50).) + + + +=item SetTimezone VALUE + + +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).) + + +=cut + + +=item PGPKey + +Returns the current value of PGPKey. +(In the database, PGPKey is stored as text.) + + + +=item SetPGPKey VALUE + + +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.) + + +=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 + + +=item LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=item LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) + + +=cut + + + +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 f4a97268c..d58f69653 100755 --- a/rt/lib/RT/Users.pm +++ b/rt/lib/RT/Users.pm @@ -1,281 +1,115 @@ +# 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 - Collection of RT::User objects - + RT::Users -- Class Description + =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::User; - my $item = new RT::User($self->CurrentUser); - return($item); -} -# }}} - -# {{{ LimitToEmail -=head2 LimitToEmail +use RT::SearchBuilder; +use RT::User; -Takes one argument. an email address. limits the returned set to -that email address +use vars qw( @ISA ); +@ISA= qw(RT::SearchBuilder); -=cut -sub LimitToEmail { +sub _Init { my $self = shift; - 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 + $self->{'table'} = 'Users'; + $self->{'primary_key'} = 'id'; -=cut -sub LimitToPrivileged { - my $self = shift; - $self->Limit( FIELD => 'Privileged', - OPERATOR => '=', - VALUE => '1'); + return ( $self->SUPER::_Init(@_) ); } -# }}} - - - -# {{{ LimitToSystem -=head2 LimitToSystem +=item NewItem -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. +Returns an empty new RT::User item =cut -sub LimitToSystem { +sub NewItem { my $self = shift; - $self->Limit( FIELD => 'Privileged', - OPERATOR => '=', - VALUE => '2'); + return(RT::User->new($self->CurrentUser)); } -# }}} - -# {{{ 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_Overlay"; + if ($@ && $@ !~ qr{^Can't locate RT/Users_Overlay.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_Vendor"; + if ($@ && $@ !~ qr{^Can't locate RT/Users_Vendor.pm}) { + die $@; + }; + 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 - $self->Limit(ALIAS => $acl_alias, - FIELD => 'RightScope', - OPERATOR => '=', - ENTRYAGGREGATOR => 'OR', - VALUE => 'Ticket'); +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. - #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"); - - - }; +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); -} - - - -# }}} - -# {{{ HasSystemRight +so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. -=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 +RT::Users_Overlay, RT::Users_Vendor, RT::Users_Local =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 deleted file mode 100755 index c7c6100cf..000000000 --- a/rt/lib/RT/Watcher.pm +++ /dev/null @@ -1,313 +0,0 @@ -# $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 deleted file mode 100755 index c55adda3f..000000000 --- a/rt/lib/RT/Watchers.pm +++ /dev/null @@ -1,226 +0,0 @@ -# $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; - - - - |