diff options
Diffstat (limited to 'rt/lib')
61 files changed, 19646 insertions, 0 deletions
diff --git a/rt/lib/MANIFEST b/rt/lib/MANIFEST new file mode 100644 index 000000000..cda386be5 --- /dev/null +++ b/rt/lib/MANIFEST @@ -0,0 +1,57 @@ +MANIFEST +MANIFEST.SKIP +Makefile.PL +RT.pm +test.pl +RT/ACE.pm +RT/ACL.pm +RT/Action/Generic.pm +RT/Action/NotifyAsComment.pm +RT/Action/OpenDependent.pm +RT/Action/SendEmail.pm +RT/Action/StallDependent.pm +RT/Action/Notify.pm +RT/Action/ResolveMembers.pm +RT/Attachment.pm +RT/Attachments.pm +RT/Condition/AnyTransaction.pm +RT/Condition/Generic.pm +RT/Condition/NewDependency.pm +RT/CurrentUser.pm +RT/Date.pm +RT/EasySearch.pm +RT/Group.pm +RT/GroupMember.pm +RT/GroupMembers.pm +RT/Groups.pm +RT/Handle.pm +RT/Interface/CLI.pm +RT/Interface/Email.pm +RT/Interface/Web.pm +RT/Keyword.pm +RT/Keywords.pm +RT/KeywordSelect.pm +RT/KeywordSelects.pm +RT/Link.pm +RT/Links.pm +RT/ObjectKeyword.pm +RT/ObjectKeywords.pm +RT/Queue.pm +RT/Queues.pm +RT/Record.pm +RT/Scrip.pm +RT/Scrips.pm +RT/ScripAction.pm +RT/ScripActions.pm +RT/ScripCondition.pm +RT/ScripConditions.pm +RT/Template.pm +RT/Templates.pm +RT/Ticket.pm +RT/Tickets.pm +RT/Transaction.pm +RT/Transactions.pm +RT/User.pm +RT/Users.pm +RT/Watcher.pm +RT/Watchers.pm diff --git a/rt/lib/MANIFEST.SKIP b/rt/lib/MANIFEST.SKIP new file mode 100644 index 000000000..ae335e78a --- /dev/null +++ b/rt/lib/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/rt/lib/Makefile.PL b/rt/lib/Makefile.PL new file mode 100644 index 000000000..c0e1af28c --- /dev/null +++ b/rt/lib/Makefile.PL @@ -0,0 +1,49 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'RT', + 'VERSION_FROM' => 'RT.pm', # finds $VERSION + 'PREREQ_PM' => { + 'DBI' => 1.16, + 'DBIx::SearchBuilder' => '0.48', + 'Date::Parse' => 0, + 'Date::Format' => 0, + 'MIME::Entity' => 5.108, + 'Mail::Mailer' => '1.20', + 'Log::Dispatch' => 1.6, + 'HTML::Entities' => 0, + 'Text::Wrapper' => 0, + 'Text::Template' => 0, + 'Getopt::Long' => 2.24, + }, +); + + { + package MY; + sub top_targets { + my($self) = @_; + my $out = "POD2TEST_EXE = pod2test\n"; + + $out .= $self->SUPER::top_targets(@_); + # $out =~ s/^(pure_all\b.*)/$1 testifypods/m; + + $out .= "\n\ntestifypods : \n"; + + my @pods = (keys %{$self->{MAN1PODS}}, + keys %{$self->{MAN3PODS}}); + + foreach my $pod (@pods) { + (my $test = $pod) =~ s/\.(pm|pod)$//; + $test =~ s/^lib\W//; + $test =~ s/\W/-/; + $test =~ s/\//__/g; + $test = "autogen-$test.t"; + $out .= "\t$self->{NOECHO}\$(POD2TEST_EXE) ". + "$pod t/$test \n"; + } + + return $out; + } + } + diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm new file mode 100644 index 000000000..1cfc428ee --- /dev/null +++ b/rt/lib/RT.pm @@ -0,0 +1,155 @@ +package RT; +use RT::Handle; +use RT::CurrentUser; +use strict; + +use vars qw($VERSION $SystemUser $Nobody $Handle $Logger); + +$VERSION = '!!RT_VERSION!!'; + +=head1 NAME + + RT - Request Tracker + +=head1 SYNOPSIS + + A fully featured request tracker package + + +=head1 DESCRIPTION + + +=cut + +sub Init { + #Get a database connection + $Handle = new RT::Handle($RT::DatabaseType); + $Handle->Connect(); + + + #RT's system user is a genuine database user. its id lives here + $SystemUser = new RT::CurrentUser(); + $SystemUser->LoadByName('RT_System'); + + #RT's "nobody user" is a genuine database user. its ID lives here. + $Nobody = new RT::CurrentUser(); + $Nobody->LoadByName('Nobody'); + + InitLogging(); +} + +=head2 InitLogging + +Create the RT::Logger object. + +=cut +sub InitLogging { + + # We have to set the record seperator ($, man perlvar) + # or Log::Dispatch starts getting + # really pissy, as some other module we use unsets it. + + $, = ''; + use Log::Dispatch 1.6; + use Log::Dispatch::File; + use Log::Dispatch::Screen; + + $Logger=Log::Dispatch->new(); + + if ($RT::LogToFile) { + my $filename = $RT::LogToFileNamed || "$RT::LogDir/rt.log"; + + $Logger->add(Log::Dispatch::File->new + ( name=>'rtlog', + min_level=> $RT::LogToFile, + filename=> $filename, + mode=>'append', + callbacks => sub {my %p=@_; return "[".gmtime(time)."] [".$p{level}."]: $p{message}\n"} + + )); + } + if ($RT::LogToScreen) { + $Logger->add(Log::Dispatch::Screen->new + ( name => 'screen', + min_level => $RT::LogToScreen, + stderr => 1 + )); + } +# {{{ Signal handlers + +## This is the default handling of warnings and die'ings in the code +## (including other used modules - maybe except for errors catched by +## Mason). It will log all problems through the standard logging +## mechanism (see above). + +$SIG{__WARN__} = sub {$RT::Logger->warning($_[0])}; + +#When we call die, trap it and log->crit with the value of the die. + +$SIG{__DIE__} = sub { + unless ($^S || !defined $^S ) { + $RT::Logger->crit("$_[0]"); + exit(-1); + } + else { + #Get out of here if we're in an eval + die $_[0]; + } +}; + +# }}} + +} + +# }}} + + +sub SystemUser { + return($SystemUser); +} + +sub Nobody { + return ($Nobody); +} + + +=head2 DropSetGIDPermissions + +Drops setgid permissions. + +=cut + +sub DropSetGIDPermissions { + # Now that we got the config read in, we have the database + # password and don't need to be setgid + # make the effective group the real group + $) = $(; +} + + +=head1 NAME + +RT - Request Tracker + +=head1 SYNOPSIS + +=head1 BUGS + +=head1 SEE ALSO + + +=begin testing + +ok (require RT::TestHarness); + +ok ($RT::Nobody->Name() eq 'Nobody', "Nobody is nobody"); +ok ($RT::Nobody->Name() ne 'root', "Nobody isn't named root"); +ok ($RT::SystemUser->Name() eq 'RT_System', "The system user is RT_System"); +ok ($RT::SystemUser->Name() ne 'noname', "The system user isn't noname"); + + +=end testing + +=cut + +1; diff --git a/rt/lib/RT/ACE.pm b/rt/lib/RT/ACE.pm new file mode 100755 index 000000000..d4681cf44 --- /dev/null +++ b/rt/lib/RT/ACE.pm @@ -0,0 +1,774 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ACE.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::ACE - RT\'s ACE object + +=head1 SYNOPSIS + + use RT::ACE; + my $ace = new RT::ACE($CurrentUser); + + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::ACE); + +=end testing + +=cut + +package RT::ACE; +use RT::Record; +@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', + + 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' + + ); + + +# 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; +} + +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ACL"; + return($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub LoadByValues + +=head2 LoadByValues PARAMHASH + +Load an ACE by specifying a paramhash with the following fields: + + PrincipalId => undef, + PrincipalType => undef, + RightName => undef, + RightScope => undef, + RightAppliesTo => undef, + +=cut + +sub LoadByValues { + my $self = shift; + my %args = (PrincipalId => undef, + PrincipalType => undef, + RightName => undef, + RightScope => undef, + RightAppliesTo => undef, + @_); + + $self->LoadByCols (PrincipalId => $args{'PrincipalId'}, + PrincipalType => $args{'PrincipalType'}, + RightName => $args{'RightName'}, + RightScope => $args{'RightScope'}, + RightAppliesTo => $args{'RightAppliesTo'} + ); + + #If we couldn't load it. + unless ($self->Id) { + return (0, "ACE not found"); + } + # if we could + return ($self->Id, "ACE Loaded"); + +} + +# }}} + +# {{{ sub Create + +=head2 Create <PARAMS> + +PARAMS is a parameter hash with the following elements: + + PrincipalType => "Queue"|"User" + PrincipalId => an intentifier you can use to ->Load a user or group + RightName => the name of a right. in any case + RightScope => "System" | "Queue" + RightAppliesTo => a queue id or undef + +=cut + +sub Create { + my $self = shift; + my %args = ( 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'); + } +} + +# }}} + + +# {{{ 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 + +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. + +=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 + +=head2 QueueRights + +Returns a hash of all the possible rights at the queue scope + +=cut + +sub QueueRights { + return (%QUEUERIGHTS); +} + +# }}} + +# {{{ sub SystemRights + +=head2 SystemRights + +Returns a hash of all the possible rights at the system scope + +=cut + +sub SystemRights { + return (%SYSTEMRIGHTS); +} + + +# }}} + +# {{{ 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 + +=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. + +=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(@_)); +} + +# }}} + + +# {{{ sub CurrentUserHasQueueRight + +=head2 CurrentUserHasQueueRight ( Queue => QUEUEID, Right => RIGHTNANAME ) + +Check to see whether the current user has the specified right for the specified queue. + +=cut + +sub CurrentUserHasQueueRight { + my $self = shift; + my %args = (Queue => undef, + Right => undef, + @_ + ); + return ($self->HasRight( Right => $args{'Right'}, + Principal => $self->CurrentUser->UserObj, + Queue => $args{'Queue'})); +} + +# }}} + +# {{{ sub CurrentUserHasSystemRight +=head2 CurrentUserHasSystemRight RIGHTNAME + +Check to see whether the current user has the specified right for the 'system' scope. + +=cut + +sub CurrentUserHasSystemRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Right => $right, + Principal => $self->CurrentUser->UserObj, + System => 1 + )); +} + + +# }}} + +# {{{ sub CurrentUserHasRight + +=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, + )); +} + +# }}} + +# {{{ sub HasRight + +=item HasRight + +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to KeywordSelects + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + Queue => undef, + System => undef, + @_ ); + + #If we're explicitly specifying a queue, as we need to do on create + if (defined $args{'Queue'}) { + return ($args{'Principal'}->HasQueueRight(Right => $args{'Right'}, + Queue => $args{'Queue'})); + } + #else if we're specifying to check a system right + elsif ((defined $args{'System'}) and (defined $args{'Right'})) { + return( $args{'Principal'}->HasSystemRight( $args{'Right'} )); + } + + elsif ($self->__Value('RightScope') eq 'System') { + return $args{'Principal'}->HasSystemRight($args{'Right'}); + } + elsif ($self->__Value('RightScope') eq 'Queue') { + return $args{'Principal'}->HasQueueRight( Queue => $self->__Value('RightAppliesTo'), + Right => $args{'Right'} ); + } + else { + $RT::Logger->warning("$self: Trying to check an acl for a scope we ". + "don't understand:" . $self->__Value('RightScope') ."\n"); + return undef; + } + + + +} +# }}} + +# }}} + +1; + +__DATA__ + +# {{{ POD + +=head1 Out of date docs + +=head2 Table Structure + +PrincipalType, PrincipalId, Right,Scope,AppliesTo + +=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 Queue +=item System + + +=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> + + Name: ShowComments + Principals: <user> <group> Owner Requestor Cc AdminCc + +Reply to Ticket in <queue> + + Name: Reply + Principals: <user> <group> Owner Requestor Cc AdminCc + +Comment on Ticket in <queue> + + Name: Comment + Principals: <user> <group> Owner Requestor Cc AdminCc + +Modify Ticket in <queue> + + Name: Modify + Principals: <user> <group> Owner Requestor Cc AdminCc + +Delete Tickets in <queue> + + Name: Delete + Principals: <user> <group> Owner Requestor Cc AdminCc + + +=head2 Queue Rights that apply to a whole queue + +These rights can only be granted to "real people" + +List Tickets in <queue> + + Name: ListQueue + Principals: <user> <group> + +Know that <queue> exists + + Name: See + Principals: <user> <group> + +Display queue settings + + Name: Explore + Principals: <user> <group> + +Modify Queue Watchers for <queue> + + Name: ModifyQueueWatchers + Principals: <user> <group> + +Modify Queue Attributes for <queue> + + Name: ModifyQueue + Principals: <user> <group> + +Modify Queue ACL for queue <queue> + + Name: ModifyACL + Principals: <user> <group> + + +=head2 Rights that apply to the System scope + +=head2 SystemRights + +Create Queue + + Name: CreateQueue + Principals: <user> <group> +Delete Queue + + Name: DeleteQueue + Principals: <user> <group> + +Create Users + + Name: CreateUser + Principals: <user> <group> + +Delete Users + + Name: DeleteUser + Principals: <user> <group> + +Modify Users + + Name: ModifyUser + Principals: <user> <group> + +Modify Self + Name: ModifySelf + Principals: <user> <group> + +Browse Users + + Name: BrowseUsers (NOT IMPLEMENTED in 2.0) + Principals: <user> <group> + +Modify Self + + Name: ModifySelf + Principals: <user> <group> + +Modify System ACL + + Name: ModifyACL + Principals: <user> <group> + +=head1 The Principal Side of the ACE + +=head2 PrincipalTypes,PrincipalIds in our Neighborhood + + User,<userid> + Group,<groupip> + Everyone,NULL + +=cut + +# }}} diff --git a/rt/lib/RT/ACL.pm b/rt/lib/RT/ACL.pm new file mode 100755 index 000000000..444a4c2af --- /dev/null +++ b/rt/lib/RT/ACL.pm @@ -0,0 +1,308 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ACL.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Distributed under the terms of the GNU GPL +# Copyright (c) 2000 Jesse Vincent <jesse@fsck.com> + +=head1 NAME + + RT::ACL - collection of RT ACE objects + +=head1 SYNOPSIS + + use RT::ACL; +my $ACL = new RT::ACL($CurrentUser); + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::ACL); + +=end testing + +=cut + +package RT::ACL; +use RT::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. + +Limit the ACL to just a given queue when supplied with an integer queue id. + +=cut + +sub LimitToQueue { + 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 ); + +} + + +=head2 LimitPrincipalToGroup + +Takes a single group as its only argument. +Limit the ACL to just a specific group. + +=cut + +sub LimitPrincipalToGroup { + my $self = shift; + my $group = shift; + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalType', + VALUE => 'Group' ); + + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalId', + VALUE => $group ); + +} + +=head2 LimitPrincipalToType($type) + +Takes a single argument, $type. +Limit the ACL to just a specific principal type + +$type is one of: + TicketOwner + TicketRequestor + TicketCc + TicketAdminCc + Everyone + User + Group + +=cut + +sub LimitPrincipalToType { + my $self=shift; + my $type=shift; + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalType', + VALUE => $type ); +} + + +=head2 LimitPrincipalToId + +Takes a single argument, the numeric Id of the principal to limit this ACL to. Repeated calls to this +function will broaden the scope of the search to include all principals listed. + +=cut + +sub LimitPrincipalToId { + my $self = shift; + my $id = shift; + + if ($id =~ /^\d+$/) { + $self->Limit(ENTRYAGGREGATOR => 'OR', + FIELD => 'PrincipalId', + VALUE => $id ); + } + else { + $RT::Logger->warn($self."->LimitPrincipalToId called with '$id' as an id"); + return undef; + } +} + + +#wrap around _DoSearch so that we can build the hash of returned +#values +sub _DoSearch { + my $self = shift; + # $RT::Logger->debug("Now in ".$self."->_DoSearch"); + my $return = $self->SUPER::_DoSearch(@_); + # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return\n"); + $self->_BuildHash(); + return ($return); +} + + +#Build a hash of this ACL's entries. +sub _BuildHash { + my $self = shift; + + while (my $entry = $self->Next) { + my $hashkey = $entry->RightScope . "-" . + $entry->RightAppliesTo . "-" . + $entry->RightName . "-" . + $entry->PrincipalId . "-" . + $entry->PrincipalType; + + $self->{'as_hash'}->{"$hashkey"} =1; + + } +} + + +# {{{ HasEntry + +=head2 HasEntry + +=cut + +sub HasEntry { + + my $self = shift; + my %args = ( RightScope => undef, + RightAppliesTo => undef, + RightName => undef, + PrincipalId => undef, + PrincipalType => undef, + @_ ); + + #if we haven't done the search yet, do it now. + $self->_DoSearch(); + + if ($self->{'as_hash'}->{ $args{'RightScope'} . "-" . + $args{'RightAppliesTo'} . "-" . + $args{'RightName'} . "-" . + $args{'PrincipalId'} . "-" . + $args{'PrincipalType'} + } == 1) { + return(1); + } + else { + return(undef); + } +} + +# }}} +1; diff --git a/rt/lib/RT/Action/Autoreply.pm b/rt/lib/RT/Action/Autoreply.pm new file mode 100755 index 000000000..624888e94 --- /dev/null +++ b/rt/lib/RT/Action/Autoreply.pm @@ -0,0 +1,64 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Autoreply.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::Action::Autoreply; +require RT::Action::SendEmail; +@ISA = qw(RT::Action::SendEmail); + + +# {{{ sub SetRecipients + +=head2 SetRecipients + +Sets the recipients of this message to this ticket's Requestor. + +=cut + + +sub SetRecipients { + my $self=shift; + + push(@{$self->{'To'}}, @{$self->TicketObj->Requestors->Emails}); + + return(1); +} + +# }}} + + +# {{{ sub SetReturnAddress + +=head2 SetReturnAddress + +Set this message\'s return address to the apropriate queue address + +=cut + +sub SetReturnAddress { + my $self = shift; + my %args = ( is_comment => 0, + @_ + ); + + 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->TicketObj->QueueObj->Name; + $self->SetHeader('From', "\"$friendly_name\" <$replyto>"); + } + + unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) { + $self->SetHeader('Reply-To', "$replyto"); + } + +} + +# }}} + +1; diff --git a/rt/lib/RT/Action/Generic.pm b/rt/lib/RT/Action/Generic.pm new file mode 100755 index 000000000..ecfd4ab1a --- /dev/null +++ b/rt/lib/RT/Action/Generic.pm @@ -0,0 +1,155 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Generic.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Action::Generic - a generic baseclass for RT Actions + +=head1 SYNOPSIS + + use RT::Action::Generic; + +=head1 DESCRIPTION + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Action::Generic); + +=end testing + +=cut + +package RT::Action::Generic; + +# {{{ sub new +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + $self->_Init(@_); + return $self; +} +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + my %args = ( TransactionObj => undef, + TicketObj => undef, + ScripObj => undef, + TemplateObj => undef, + Argument => undef, + Type => undef, + @_ ); + + + $self->{'Argument'} = $args{'Argument'}; + $self->{'ScripObj'} = $args{'ScripObj'}; + $self->{'TicketObj'} = $args{'TicketObj'}; + $self->{'TransactionObj'} = $args{'TransactionObj'}; + $self->{'TemplateObj'} = $args{'TemplateObj'}; + $self->{'Type'} = $args{'Type'}; +} +# }}} + +# Access Scripwide data + +# {{{ sub Argument +sub Argument { + my $self = shift; + return($self->{'Argument'}); +} +# }}} + +# {{{ sub TicketObj +sub TicketObj { + my $self = shift; + return($self->{'TicketObj'}); +} +# }}} + +# {{{ sub TransactionObj +sub TransactionObj { + my $self = shift; + return($self->{'TransactionObj'}); +} +# }}} + +# {{{ sub TemplateObj +sub TemplateObj { + my $self = shift; + return($self->{'TemplateObj'}); +} +# }}} + +# {{{ sub Type +sub Type { + my $self = shift; + return($self->{'Type'}); +} +# }}} + + +# Scrip methods + +#Do what we need to do and send it out. + +# {{{ sub Commit +sub Commit { + my $self = shift; + return(0,"Commit Stubbed"); +} +# }}} + + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return ("No description for " . ref $self); +} +# }}} + + +#Parse the templates, get things ready to go. + +# {{{ sub Prepare +sub Prepare { + my $self = shift; + return (0,"Prepare Stubbed"); +} +# }}} + + +#If this rule applies to this transaction, return true. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + return(undef); +} +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self = shift; + + # We need to clean up all the references that might maybe get + # oddly circular + $self->{'TemplateObj'} =undef + $self->{'TicketObj'} = undef; + $self->{'TransactionObj'} = undef; + $self->{'ScripObj'} = undef; + + + +} + +# }}} +1; diff --git a/rt/lib/RT/Action/Notify.pm b/rt/lib/RT/Action/Notify.pm new file mode 100755 index 000000000..6dca4fd41 --- /dev/null +++ b/rt/lib/RT/Action/Notify.pm @@ -0,0 +1,99 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Notify.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::Action::Notify; +require RT::Action::SendEmail; +@ISA = qw(RT::Action::SendEmail); + +# {{{ sub SetRecipients + +=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. + +=cut + +sub SetRecipients { + my $self = shift; + + $arg = $self->Argument; + + $arg =~ s/\bAll\b/Owner,Requestor,AdminCc,Cc/; + + my ( @To, @PseudoTo, @Cc, @Bcc ); + + + 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 ( $arg =~ /\bRequestor\b/ ) { + push ( @To, @{ $self->TicketObj->Requestors->Emails } ); + } + + + + if ( $arg =~ /\bCc\b/ ) { + + #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 } ); + } + else { + push ( @Cc, @{ $self->TicketObj->Cc->Emails } ); + push ( @To, @{ $self->TicketObj->QueueObj->Cc->Emails } ); + } + } + + if ( ( $arg =~ /\bOwner\b/ ) + && ( $self->TicketObj->OwnerObj->id != $RT::Nobody->id ) ) + { + + # If we're not sending to Ccs or requestors, + # then the Owner can be the To. + if (@To) { + push ( @Bcc, $self->TicketObj->OwnerObj->EmailAddress ); + } + else { + push ( @To, $self->TicketObj->OwnerObj->EmailAddress ); + } + + } + + if ( $arg =~ /\bAdminCc\b/ ) { + push ( @Bcc, @{ $self->TicketObj->AdminCc->Emails } ); + push ( @Bcc, @{ $self->TicketObj->QueueObj->AdminCc->Emails } ); + } + + if ($RT::UseFriendlyToLine) { + unless (@To) { + push ( @PseudoTo, + "\"$arg of $RT::rtname Ticket #" + . $self->TicketObj->id . "\":;" ); + } + } + + my $creator = $self->TransactionObj->CreatorObj->EmailAddress(); + + #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 ); + @{ $self->{'PseudoTo'} } = @PseudoTo; + return (1); + +} + +# }}} + +1; diff --git a/rt/lib/RT/Action/NotifyAsComment.pm b/rt/lib/RT/Action/NotifyAsComment.pm new file mode 100755 index 000000000..c72bfff13 --- /dev/null +++ b/rt/lib/RT/Action/NotifyAsComment.pm @@ -0,0 +1,25 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/NotifyAsComment.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::Action::NotifyAsComment; +require RT::Action::Notify; +@ISA = qw(RT::Action::Notify); + + +=head2 SetReturnAddress + +Tell SendEmail that this message should come out as a comment. +Calls SUPER::SetReturnAddress. + +=cut + +sub SetReturnAddress { + my $self = shift; + + # Tell RT::Action::SendEmail that this should come + # from the relevant comment email address. + $self->{'comment'} = 1; + + return($self->SUPER::SetReturnAddress(is_comment => 1)); +} +1; + diff --git a/rt/lib/RT/Action/OpenDependent.pm b/rt/lib/RT/Action/OpenDependent.pm new file mode 100644 index 000000000..b271e4709 --- /dev/null +++ b/rt/lib/RT/Action/OpenDependent.pm @@ -0,0 +1,55 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Attic/OpenDependent.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# This Action will open the BASE if a dependent is resolved. + +package RT::Action::OpenDependent; +require RT::Action::Generic; +require RT::Links; +@ISA=qw(RT::Action::Generic); + +#Do what we need to do and send it out. + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return (ref $self . " will stall a [local] BASE if it's open and a dependency link is created."); +} +# }}} + + +# {{{ sub Prepare +sub Prepare { + # nothing to prepare + return 1; +} +# }}} + +sub Commit { + my $self = shift; + + my $Links=RT::Links->new($RT::SystemUser); + $Links->Limit(FIELD => 'Type', VALUE => 'DependsOn'); + $Links->Limit(FIELD => 'Target', VALUE => $self->TicketObj->id); + + while (my $Link=$Links->Next()) { + next unless $Link->BaseIsLocal; + my $base=RT::Ticket->new($self->TicketObj->CurrentUser); + # Todo: Only work if Base is a plain ticket num: + $base->Load($Link->Base); + $base->Open if $base->Status eq 'stalled'; + } +} + + +# Applicability checked in Commit. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + 1; + return 1; +} +# }}} + +1; diff --git a/rt/lib/RT/Action/ResolveMembers.pm b/rt/lib/RT/Action/ResolveMembers.pm new file mode 100644 index 000000000..00547ebe8 --- /dev/null +++ b/rt/lib/RT/Action/ResolveMembers.pm @@ -0,0 +1,57 @@ +# This Action will resolve all members of a resolved group ticket + +package RT::Action::ResolveMembers; +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 resolve all members of a resolved group ticket."); +} +# }}} + + +# {{{ 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 => 'MemberOf'); + $Links->Limit(FIELD => 'Target', VALUE => $self->TicketObj->id); + + while (my $Link=$Links->Next()) { + # Todo: Try to deal with remote URIs as well + 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); + # I'm afraid this might be a major bottleneck if ResolveGroupTicket is on. + $base->Resolve; + } +} + + +# Applicability checked in Commit. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + 1; + return 1; +} +# }}} + +1; + diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm new file mode 100755 index 000000000..e3abb1154 --- /dev/null +++ b/rt/lib/RT/Action/SendEmail.pm @@ -0,0 +1,468 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/SendEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com> +# Portions Copyright 2000 Tobias Brox <tobix@cpan.org> +# Released under the terms of version 2 of the GNU Public License + +package RT::Action::SendEmail; +require RT::Action::Generic; + +@ISA = qw(RT::Action::Generic); + + +=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 + + require RT::Action::SendEmail; + @ISA = qw(RT::Action::SendEmail); + + +=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::SendEmail); + +=end testing + + +=head1 AUTHOR + +Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org> + +=head1 SEE ALSO + +perl(1). + +=cut + +# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) + +# {{{ sub _Init +# We use _Init from RT::Action +# }}} + +# {{{ sub Commit +#Do what we need to do and send it out. +sub Commit { + my $self = shift; + #send the email + + # 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'}}); + } + } + } + + # 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; + + + #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); + } + + # 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); + } + 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->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(); + + $self->SetRTSpecialHeaders(); + + 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. + +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(); + +} + + + +# {{{ sub SetReferences + +=head2 SetReferences + + # This routine will set the References: and In-Reply-To headers, +# autopopulating it with all the correspondence on this ticket so +# far. This should make RT responses threadable. + +=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. + + $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. +} + +# }}} + +# {{{ 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. + +sub SetMessageID { + my $self = shift; + + # TODO this one might be sort of broken. If we have several scrips +++ + # sending several emails to several different persons, we need to + # pull out different message-ids. I'd suggest message ids like + # "rt-ticket#-transaction#-scrip#-receipient#" + + $self->SetHeader + ('Message-ID', "<rt-".$self->TicketObj->id(). + "-". + $self->TransactionObj->id()."." .rand(20) . "\@".$RT::Organization.">") + unless $self->TemplateObj->MIMEObj->head->get('Message-ID'); +} + + +# }}} + +# }}} + +# {{{ sub SetReturnAddress + +sub SetReturnAddress { + + my $self = shift; + my %args = ( is_comment => 0, + @_ ); + + # From and Reply-To + # $args{is_comment} should be set if the comment address is to be used. + my $replyto; + + if ($args{'is_comment'}) { + $replyto = $self->TicketObj->QueueObj->CommentAddress || + $RT::CommentAddress; + } + else { + $replyto = $self->TicketObj->QueueObj->CorrespondAddress || + $RT::CorrespondAddress; + } + + unless ($self->TemplateObj->MIMEObj->head->get('From')) { + my $friendly_name=$self->TransactionObj->CreatorObj->RealName; + + if ($friendly_name =~ /^\S+\@\S+$/) { # A "bare" mail address + $friendly_name =~ s/"/\\"/g; + $friendly_name = qq|"$friendly_name"|; + } + + + # TODO: this "via RT" should really be site-configurable. + $self->SetHeader('From', "\"$friendly_name via RT\" <$replyto>"); + } + + unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) { + $self->SetHeader('Reply-To', "$replyto"); + } + +} + +# }}} + +# {{{ sub SetHeader + +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); +} + +# }}} + +# {{{ sub SetRecipients + +=head2 SetRecipients + +Dummy method to be overriden by subclasses which want to set the recipients. + +=cut + +sub SetRecipients { + my $self = shift; + return(); +} + +# }}} + +# {{{ sub SetTo + +sub SetTo { + my $self=shift; + my $addresses = shift; + return $self->SetHeader('To',$addresses); +} +# }}} + +# {{{ sub SetCc +=head2 SetCc + +Takes a string that is the addresses you want to Cc + +=cut + +sub SetCc { + my $self=shift; + my $addresses = shift; + + return $self->SetHeader('Cc', $addresses); +} +# }}} + +# {{{ sub SetBcc + +=head2 SetBcc + +Takes a string that is the addresses you want to Bcc + +=cut +sub SetBcc { + my $self=shift; + my $addresses = shift; + + return $self->SetHeader('Bcc', $addresses); +} + +# }}} + +# {{{ sub SetPrecedence + +sub SetPrecedence { + my $self = shift; + + unless ($self->TemplateObj->MIMEObj->head->get("Precedence")) { + $self->SetHeader('Precedence', "bulk"); + } +} + +# }}} + +# {{{ sub SetSubject + +=head2 SetSubject + +This routine sets the subject. it does not add the rt tag. that gets done elsewhere +If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get +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 $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); + + } + return($subject); +} +# }}} + +# {{{ sub SetSubjectToken + +=head2 SetSubjectToken + + 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"); + } +} + +# }}} + +# }}} + +__END__ + +# {{{ POD + +# }}} + +1; + diff --git a/rt/lib/RT/Action/SendPasswordEmail.pm b/rt/lib/RT/Action/SendPasswordEmail.pm new file mode 100755 index 000000000..91bb3c1cb --- /dev/null +++ b/rt/lib/RT/Action/SendPasswordEmail.pm @@ -0,0 +1,170 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Action/Attic/SendPasswordEmail.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License + +package RT::Action::SendPasswordEmail; +require RT::Action::Generic; + +@ISA = qw(RT::Action::Generic); + + +=head1 NAME + + RT::Action::SendGenericEmail - An Action which users can use to send mail + or can subclassed for more specialized mail sending behavior. + + + +=head1 SYNOPSIS + + require RT::Action::SendPasswordEmail; + + +=head1 DESCRIPTION + +Basically, you create another module RT::Action::YourAction which ISA +RT::Action::SendEmail. + +If you want to set the recipients of the mail to something other than +the addresses mentioned in the To, Cc, Bcc and headers in +the template, you should subclass RT::Action::SendEmail and override +either the SetRecipients method or the SetTo, SetCc, etc methods (see +the comments for the SetRecipients sub). + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Action::SendPasswordEmail); + +=end testing + + +=head1 AUTHOR + +Jesse Vincent <jesse@bestpractical.com> + +=head1 SEE ALSO + +perl(1). + +=cut + +# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) + +# {{{ sub Commit + +#Do what we need to do and send it out. + +sub Commit { + my $self = shift; + #send the email + + + + + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + + $MIMEObj->make_singlepart; + + #If we don\'t have any recipients to send to, don\'t send a message; + unless ($MIMEObj->head->get('To')) { + $RT::Logger->debug("$self: No recipients found. Not sending.\n"); + return(1); + } + + if ($RT::MailCommand eq 'sendmailpipe') { + open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0); + print MAIL $MIMEObj->as_string; + close(MAIL); + } + else { + unless ($MIMEObj->send($RT::MailCommand, $RT::MailParams)) { + $RT::Logger->crit("$self: Could not send mail for ". + $self->TransactionObj . "\n"); + return(0); + } + } + + return (1); + +} +# }}} + +# {{{ sub Prepare + +sub Prepare { + my $self = shift; + + # This actually populates the MIME::Entity fields in the Template Object + + unless ($self->TemplateObj) { + $RT::Logger->warning("No template object handed to $self\n"); + } + + + unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) { + $self->SetHeader('Reply-To',$RT::CorrespondAddress ); + } + + + $self->SetHeader('Precedence', "bulk"); + $self->SetHeader('X-RT-Loop-Prevention', $RT::rtname); + $self->SetHeader + ('Managed-by',"Request Tracker $RT::VERSION (http://www.fsck.com/projects/rt/)"); + + $self->TemplateObj->Parse(Argument => $self->Argument); + + + return 1; +} + +# }}} + +# }}} + + +# {{{ sub SetTo + +=head2 SetTo EMAIL + +Sets this message's "To" field to EMAIL + +=cut + +sub SetTo { + my $self = shift; + my $to = shift; + $self->SetHeader('To',$to); +} + +# }}} + +# {{{ sub SetHeader + +sub SetHeader { + my $self = shift; + my $field = shift; + my $val = shift; + + chomp $val; + chomp $field; + $self->TemplateObj->MIMEObj->head->fold_length($field,10000); + $self->TemplateObj->MIMEObj->head->add($field, $val); + return $self->TemplateObj->MIMEObj->head->get($field); +} + +# }}} + + + +__END__ + +# {{{ POD + +# }}} + +1; + diff --git a/rt/lib/RT/Action/StallDependent.pm b/rt/lib/RT/Action/StallDependent.pm new file mode 100644 index 000000000..09d3448a8 --- /dev/null +++ b/rt/lib/RT/Action/StallDependent.pm @@ -0,0 +1,68 @@ +# This Action will stall the BASE if a dependency or membership link +# (according to argument) is created and if BASE is open. + +# TODO: Rename this .pm + +package RT::Action::StallDependent; +require RT::Action::Generic; +@ISA=qw|RT::Action::Generic|; + +# {{{ sub Describe +sub Describe { + my $self = shift; + return (ref $self . " will stall a [local] BASE if it's dependent [or member] of a linked up request."); +} +# }}} + + +# {{{ sub Prepare +sub Prepare { + # nothing to prepare + return 1; +} +# }}} + +sub Commit { + my $self = shift; + # Find all Dependent + my $arg=$self->Argument || "DependsOn"; + unless ($self->TransactionObj->Data =~ /^([^ ]+) $arg /) { + warn; return 0; + } + my $base_id=$1; + my $base; + if ($1 eq "THIS") { + $base=$self->TicketObj; + } else { + $base_id=&RT::Link::_IsLocal(undef, $base_id) || return 0; + $base=RT::Ticket->new($self->TicketObj->CurrentUser); + $base->Load($base_id); + } + $base->Stall if $base->Status eq 'open'; + return 0; +} + + +# {{{ sub IsApplicable + +# Only applicable if: +# 1. the link action is a dependency +# 2. BASE is a local ticket + +sub IsApplicable { + my $self = shift; + + my $arg=$self->Argument || "DependsOn"; + + # 1: + $self->TransactionObj->Data =~ /^([^ ]*) $arg / || return 0; + + # 2: + # (dirty!) + &RT::Link::_IsLocal(undef,$1) || return 0; + + return 1; +} +# }}} + +1; diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm new file mode 100755 index 000000000..916ac355e --- /dev/null +++ b/rt/lib/RT/Attachment.pm @@ -0,0 +1,423 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attachment.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License + +=head1 NAME + + RT::Attachment -- an RT attachment object + +=head1 SYNOPSIS + + use RT::Attachment; + + +=head1 DESCRIPTION + +This module should never be instantiated directly by client code. it's an internal +module which should only be instantiated through exported APIs in Ticket, Queue and other +similar objects. + + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Attachment); + +=end testing + +=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 TransactionObj + +=head2 TransactionObj + +Returns the transaction object asscoiated with this attachment. + +=cut + +sub TransactionObj { + require RT::Transaction; + my $self=shift; + unless (exists $self->{_TransactionObj}) { + $self->{_TransactionObj}=RT::Transaction->new($self->CurrentUser); + $self->{_TransactionObj}->Load($self->TransactionId); + } + return $self->{_TransactionObj}; +} + +# }}} + +# {{{ 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.; + +=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); + } +} + +# }}} + + +# {{{ sub Content + +=head2 Content + +Returns the attachment's content. if it's base64 encoded, decode it +before returning it. + +=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); + } +} + + +# }}} + +# {{{ sub Children + +=head2 Children + + Returns an RT::Attachments object which is preloaded with all Attachments objects with this Attachment\'s Id as their 'Parent' + +=cut + +sub Children { + my $self = shift; + + my $kids = new RT::Attachments($self->CurrentUser); + $kids->ChildrenOf($self->Id); + return($kids); +} + +# }}} + +# {{{ UTILITIES + +# {{{ sub Quote + + + +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; + + # 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? + + # Remove quoted signature. + $body =~ s/\n-- \n(.*)$//s; + + # What's the longest line like? + foreach (split (/\n/,$body)) { + $max=length if ( length > $max); + } + + if ($max>76) { + require Text::Wrapper; + my $wrapper=new Text::Wrapper + ( + columns => 70, + body_start => ($max > 70*3 ? ' ' : ''), + par_start => '' + ); + $body=$wrapper->wrap($body); + } + + $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; + + return (\$body, $max); +} +# }}} + +# {{{ sub NiceHeaders - pulls out only the most relevant headers + +=head2 NiceHeaders + +Returns the To, From, Cc, Date and Subject headers. + +It is a known issue that this breaks if any of these headers are not +properly unfolded. + +=cut + +sub NiceHeaders { + my $self=shift; + my $hdrs=""; + for (split(/\n/,$self->Headers)) { + $hdrs.="$_\n" if /^(To|From|RT-Send-Cc|Cc|Date|Subject): /i + } + return $hdrs; +} +# }}} + +# {{{ sub Headers + +=head2 Headers + +Returns this object's headers as a string. This method specifically +removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc. +We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send +out mail. (The mailing rules are seperated from the ticket update code by +an abstraction barrier that makes it impossible to pass this data directly + +=cut + +sub Headers { + my $self = shift; + my $hdrs=""; + for (split(/\n/,$self->SUPER::Headers)) { + $hdrs.="$_\n" unless /^(RT-Send-Bcc): /i + } + return $hdrs; +} + + +# }}} + +# {{{ sub GetHeader + +=head2 GetHeader ( 'Tag') + +Returns the value of the header Tag as a string. This bypasses the weeding out +done in Headers() above. + +=cut + +sub GetHeader { + my $self = shift; + my $tag = shift; + foreach my $line (split(/\n/,$self->SUPER::Headers)) { + $RT::Logger->debug( "Does $line match $tag\n"); + if ($line =~ /^$tag:\s+(.*)$/i) { #if we find the header, return its value + return ($1); + } + } + + # we found no header. return an empty string + return undef; +} +# }}} + +# {{{ 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->__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); + } + + +} + +# }}} + +# }}} + +1; diff --git a/rt/lib/RT/Attachments.pm b/rt/lib/RT/Attachments.pm new file mode 100755 index 000000000..73cd350a4 --- /dev/null +++ b/rt/lib/RT/Attachments.pm @@ -0,0 +1,99 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attachments.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Attachments - a collection of RT::Attachment objects + +=head1 SYNOPSIS + + 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 + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Attachments); + +=end testing + +=cut + +package RT::Attachments; + +use RT::EasySearch; + +@ISA= qw(RT::EasySearch); + +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "Attachments"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); +} +# }}} + + +# {{{ sub ContentType + +=head2 ContentType (VALUE => 'text/plain', ENTRYAGGREGATOR => 'OR', OPERATOR => '=' ) + +Limit result set to attachments of ContentType 'TYPE'... + +=cut + + +sub ContentType { + my $self = shift; + my %args = ( VALUE => 'text/plain', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + @_); + + $self->Limit ( FIELD => 'ContentType', + VALUE => $args{'VALUE'}, + OPERATOR => $args{'OPERATOR'}, + ENTRYAGGREGATOR => $args{'ENTRYAGGREGATOR'}); +} +# }}} + +# {{{ sub ChildrenOf + +=head2 ChildrenOf ID + +Limit result set to children of Attachment ID + +=cut + + +sub ChildrenOf { + my $self = shift; + my $attachment = shift; + $self->Limit ( FIELD => 'Parent', + VALUE => $attachment); +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + + use RT::Attachment; + my $item = new RT::Attachment($self->CurrentUser); + return($item); +} +# }}} + 1; + + + + diff --git a/rt/lib/RT/Condition/AnyTransaction.pm b/rt/lib/RT/Condition/AnyTransaction.pm new file mode 100644 index 000000000..83e5de6ce --- /dev/null +++ b/rt/lib/RT/Condition/AnyTransaction.pm @@ -0,0 +1,23 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Condition/AnyTransaction.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1996-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU General Public License + +package RT::Condition::AnyTransaction; +require RT::Condition::Generic; + +@ISA = qw(RT::Condition::Generic); + + +=head2 IsApplicable + +This happens on every transaction. it's always applicable + +=cut + +sub IsApplicable { + my $self = shift; + return(1); +} + +1; + diff --git a/rt/lib/RT/Condition/Generic.pm b/rt/lib/RT/Condition/Generic.pm new file mode 100755 index 000000000..393f4b786 --- /dev/null +++ b/rt/lib/RT/Condition/Generic.pm @@ -0,0 +1,170 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Condition/Generic.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Condition::Generic - ; + +=head1 SYNOPSIS + + use RT::Condition::Generic; + my $foo = new RT::Condition::IsApplicable( + TransactionObj => $tr, + TicketObj => $ti, + ScripObj => $scr, + Argument => $arg, + Type => $type); + + if ($foo->IsApplicable) { + # do something + } + + +=head1 DESCRIPTION + + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Condition::Generic); + +=end testing + + +=cut + +package RT::Condition::Generic; + +# {{{ sub new +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + $self->_Init(@_); + return $self; +} +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + my %args = ( TransactionObj => undef, + TicketObj => undef, + ScripObj => undef, + TemplateObj => undef, + Argument => undef, + ApplicableTransTypes => undef, + @_ ); + + + $self->{'Argument'} = $args{'Argument'}; + $self->{'ScripObj'} = $args{'ScripObj'}; + $self->{'TicketObj'} = $args{'TicketObj'}; + $self->{'TransactionObj'} = $args{'TransactionObj'}; + $self->{'ApplicableTransTypes'} = $args{'ApplicableTransTypes'}; +} +# }}} + +# Access Scripwide data + +# {{{ sub Argument + +=head2 Argument + +Return the optional argument associated with this ScripCondition + +=cut + +sub Argument { + my $self = shift; + return($self->{'Argument'}); +} +# }}} + +# {{{ sub TicketObj + +=head2 TicketObj + +Return the ticket object we're talking about + +=cut + +sub TicketObj { + my $self = shift; + return($self->{'TicketObj'}); +} +# }}} + +# {{{ sub TransactionObj + +=head2 TransactionObj + +Return the transaction object we're talking about + +=cut + +sub TransactionObj { + my $self = shift; + return($self->{'TransactionObj'}); +} +# }}} + +# {{{ sub Type + +=head2 Type + + + +=cut + +sub ApplicableTransTypes { + my $self = shift; + return($self->{'ApplicableTransTypes'}); +} +# }}} + + +# Scrip methods + + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return ("No description for " . ref $self); +} +# }}} + + +#Parse the templates, get things ready to go. + +#If this rule applies to this transaction, return true. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + return(undef); +} +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self = shift; + + # We need to clean up all the references that might maybe get + # oddly circular + $self->{'TemplateObj'} =undef + $self->{'TicketObj'} = undef; + $self->{'TransactionObj'} = undef; + $self->{'ScripObj'} = undef; + +} + +# }}} +1; diff --git a/rt/lib/RT/Condition/NewDependency.pm b/rt/lib/RT/Condition/NewDependency.pm new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/rt/lib/RT/Condition/NewDependency.pm diff --git a/rt/lib/RT/Condition/StatusChange.pm b/rt/lib/RT/Condition/StatusChange.pm new file mode 100644 index 000000000..56419b2c7 --- /dev/null +++ b/rt/lib/RT/Condition/StatusChange.pm @@ -0,0 +1,30 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Condition/StatusChange.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ +# Copyright 1996-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU General Public License + +package RT::Condition::StatusChange; +require RT::Condition::Generic; + +@ISA = qw(RT::Condition::Generic); + + +=head2 IsApplicable + +If the argument passed in is equivalent to the new value of +the Status Obj + +=cut + +sub IsApplicable { + my $self = shift; + if (($self->TransactionObj->Field eq 'Status') and + ($self->Argument eq $self->TransactionObj->NewValue())) { + return(1); + } + else { + return(undef); + } +} + +1; + diff --git a/rt/lib/RT/CurrentUser.pm b/rt/lib/RT/CurrentUser.pm new file mode 100755 index 000000000..6997ddbac --- /dev/null +++ b/rt/lib/RT/CurrentUser.pm @@ -0,0 +1,270 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/CurrentUser.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-1999 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::CurrentUser - an RT object representing the current user + +=head1 SYNOPSIS + + use RT::CurrentUser + + +=head1 DESCRIPTION + + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::CurrentUser); + +=end testing + +=cut + + +package RT::CurrentUser; +use RT::Record; +@ISA= qw(RT::Record); + + +# {{{ sub _Init + +#The basic idea here is that $self->CurrentUser is always supposed +# to be a CurrentUser object. but that's hard to do when we're trying to load +# the CurrentUser object + +sub _Init { + my $self = shift; + my $Name = shift; + + $self->{'table'} = "Users"; + + if (defined($Name)) { + $self->Load($Name); + } + + $self->_MyCurrentUser($self); + +} +# }}} + +# {{{ sub Create + +sub Create { + return (0, 'Permission Denied'); +} + +# }}} + +# {{{ sub Delete + +sub Delete { + return (0, 'Permission Denied'); +} + +# }}} + +# {{{ sub UserObj + +=head2 UserObj + + Returns the RT::User object associated with this CurrentUser object. + +=cut + +sub UserObj { + my $self = shift; + + unless ($self->{'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"); + } + + } + return ($self->{'UserObj'}); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Name => 'read', + Gecos => 'read', + RealName => 'read', + Password => 'neither', + EmailAddress => 'read', + Privileged => 'read', + IsAdministrator => 'read' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} + +# {{{ sub LoadByEmail + +=head2 LoadByEmail + +Loads a User into this CurrentUser object. +Takes the email address of the user to load. + +=cut + +sub LoadByEmail { + my $self = shift; + my $identifier = shift; + + $self->LoadByCol("EmailAddress",$identifier); + +} +# }}} + +# {{{ sub LoadByGecos + +=head2 LoadByGecos + +Loads a User into this CurrentUser object. +Takes a unix username as its only argument. + +=cut + +sub LoadByGecos { + my $self = shift; + my $identifier = shift; + + $self->LoadByCol("Gecos",$identifier); + +} +# }}} + +# {{{ sub LoadByName + +=head2 LoadByName + +Loads a User into this CurrentUser object. +Takes a Name. +=cut + +sub LoadByName { + my $self = shift; + my $identifier = shift; + $self->LoadByCol("Name",$identifier); + +} +# }}} + +# {{{ sub Load + +=head2 Load + +Loads a User into this CurrentUser object. +Takes either an integer (users id column reference) or a Name +The latter is deprecated. Instead, you should use LoadByName. +Formerly, this routine also took email addresses. + +=cut + +sub Load { + my $self = shift; + my $identifier = shift; + + #if it's an int, load by id. otherwise, load by name. + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + # This is a bit dangerous, we might get false authen if somebody + # uses ambigous userids or real names: + $self->LoadByCol("Name",$identifier); + } +} + +# }}} + +# {{{ sub IsPassword + +=head2 IsPassword + +Takes a password as a string. Passes it off to IsPassword in this +user's UserObj. If it is the user's password and the user isn't +disabled, returns 1. + +Otherwise, returns undef. + +=cut + +sub IsPassword { + my $self = shift; + my $value = shift; + + return ($self->UserObj->IsPassword($value)); +} + +# }}} + +# {{{ sub Privileged + +=head2 Privileged + +Returns true if the current user can be granted rights and be +a member of groups. + +=cut + +sub Privileged { + my $self = shift; + return ($self->UserObj->Privileged()); +} + +# }}} + +# {{{ Convenient ACL methods + +=head2 HasQueueRight + +calls $self->UserObj->HasQueueRight with the arguments passed in + +=cut + +sub HasQueueRight { + my $self = shift; + return ($self->UserObj->HasQueueRight(@_)); +} + +=head2 HasSystemRight + +calls $self->UserObj->HasSystemRight with the arguments passed in + +=cut + + +sub HasSystemRight { + my $self = shift; + return ($self->UserObj->HasSystemRight(@_)); +} +# }}} + +# {{{ sub HasRight + +=head2 HasSystemRight + +calls $self->UserObj->HasRight with the arguments passed in + +=cut + +sub HasRight { + my $self = shift; + return ($self->UserObj->HasRight(@_)); +} + +# }}} + +1; + diff --git a/rt/lib/RT/Date.pm b/rt/lib/RT/Date.pm new file mode 100644 index 000000000..d56997174 --- /dev/null +++ b/rt/lib/RT/Date.pm @@ -0,0 +1,436 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Date.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Date - a simple Object Oriented date. + +=head1 SYNOPSIS + + use RT::Date + +=head1 DESCRIPTION + +RT Date is a simple Date Object designed to be speedy and easy for RT to use + +The fact that it assumes that a time of 0 means "never" is probably a bug. + +=begin testing + +ok (require RT::Date); + +=end testing + +=head1 METHODS + +=cut + + +package RT::Date; +use Time::Local; +use vars qw($MINUTE $HOUR $DAY $WEEK $MONTH $YEAR); + +$MINUTE = 60; +$HOUR = 60 * $MINUTE; +$DAY = 24 * $HOUR; +$WEEK = 7 * $DAY; +$MONTH = 4 * $WEEK; +$YEAR = 365 * $DAY; + +# {{{ sub new + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + $self->Unix(0); + return $self; +} + +# }}} + +# {{{ sub Set + +=head2 sub Set + +takes a param hash with the fields 'Format' and 'Value' + +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->{'Value'} is 0, assumes you mean never. + + +=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()); + } + + 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'} =~ /^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"; + } + + return($self->Unix()); +} + +# }}} + +# {{{ sub SetToMidnight + +=head2 SetToMidnight + +Sets the date to midnight (at the beginning of the day) GMT +Returns the unixtime at midnight. + +=cut + +sub SetToMidnight { + my $self = shift; + + use Time::Local; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($self->Unix); + $self->Unix(timegm (0,0,0,$mday,$mon,$year,$wday,$yday)); + + return ($self->Unix); + + +} + + +# }}} + +# {{{ sub SetToNow +sub SetToNow { + my $self = shift; + return($self->Set(Format => 'unix', Value => time)) +} +# }}} + +# {{{ sub Diff + +=head2 Diff + +Takes either an RT::Date object or the date in unixtime format as a string + +Returns the differnce between $self and that time as a number of seconds + +=cut + +sub Diff { + my $self = shift; + my $other = shift; + + if (ref($other) eq 'RT::Date') { + $other=$other->Unix; + } + return ($self->Unix - $other); +} +# }}} + +# {{{ sub DiffAsString + +=head2 sub DiffAsString + +Takes either an RT::Date object or the date in unixtime format as a string + +Returns the differnce between $self and that time as a number of seconds as +as string fit for human consumption + +=cut + +sub DiffAsString { + my $self = shift; + my $other = shift; + + + if ($other < 1) { + return (""); + } + if ($self->Unix < 1) { + return(""); + } + my $diff = $self->Diff($other); + + return ($self->DurationAsString($diff)); +} +# }}} + +# {{{ sub DurationAsString + +=head2 DurationAsString + +Takes a number of seconds. returns a string describing that duration + +=cut + +sub DurationAsString{ + + my $self=shift; + my $duration = shift; + + my ($negative, $s); + + $negative = 'ago' 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"; + } + + return ("$s $string $negative"); +} + +# }}} + +# {{{ sub AgeAsString + +=head2 sub AgeAsString + +Takes nothing + +Returns a string that's the differnce between the time in the object and now + +=cut + +sub AgeAsString { + my $self = shift; + return ($self->DiffAsString(time)); + } +# }}} + +# {{{ sub AsString + +=head2 sub AsString + +Returns the object\'s time as a string with the current timezone. + +=cut + +sub AsString { + my $self = shift; + return ("Not set") if ($self->Unix <= 0); + + return (scalar(localtime($self->Unix))); +} +# }}} + +# {{{ sub AddSeconds + +=head2 sub AddSeconds + +Takes a number of seconds as a string + +Returns the new time + +=cut + +sub AddSeconds { + my $self = shift; + my $delta = shift; + + $self->Set(Format => 'unix', Value => ($self->Unix + $delta)); + + return ($self->Unix); + + +} + +# }}} + +# {{{ sub AddDays + +=head2 AddDays $DAYS + +Adds 24 hours * $DAYS to the current time + +=cut + +sub AddDays { + my $self = shift; + my $days = shift; + $self->AddSeconds($days * $DAY); + +} + +# }}} + +# {{{ sub AddDay + +=head2 AddDay + +Adds 24 hours to the current time + +=cut + +sub AddDay { + my $self = shift; + $self->AddSeconds($DAY); + +} + +# }}} + +# {{{ sub Unix + +=head2 sub Unix [unixtime] + +Optionally takes a date in unix seconds since the epoch format. +Returns the number of seconds since the epoch + +=cut + +sub Unix { + my $self = shift; + + $self->{'time'} = shift if (@_); + + return ($self->{'time'}); +} +# }}} + +# {{{ sub ISO + +=head2 ISO + +Takes nothing + +Returns the object's date in ISO format + +=cut + +sub ISO { + my $self=shift; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst, $date) ; + + return ('1970-01-01 00:00:00') if ($self->Unix == -1); + + # 0 1 2 3 4 5 6 7 8 + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($self->Unix); + #make the year YYYY + $year+=1900; + + #the month needs incrementing, as gmtime returns 0-11 + $mon++; + + $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year,$mon,$mday, $hour,$min,$sec); + + return ($date); +} + +# }}} + + +# {{{ sub LocalTimezone +=head2 LocalTimezone + + Returns the current timezone. For now, draws off a system timezone, RT::Timezone. Eventually, this may +pull from a 'Timezone' attribute of the CurrentUser + +=cut + +sub LocalTimezone { + my $self = shift; + + return ($RT::Timezone); +} + +# }}} + + + +1; diff --git a/rt/lib/RT/EasySearch.pm b/rt/lib/RT/EasySearch.pm new file mode 100755 index 000000000..bcbfa01b2 --- /dev/null +++ b/rt/lib/RT/EasySearch.pm @@ -0,0 +1,115 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/EasySearch.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::EasySearch - a baseclass for RT collection objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + + +=head1 METHODS + + +=begin testing + +ok (require RT::EasySearch); + +=end testing + + +=cut + +package RT::EasySearch; +use DBIx::SearchBuilder; +@ISA= qw(DBIx::SearchBuilder); + +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'user'} = shift; + unless(defined($self->CurrentUser)) { + use Carp; + Carp::confess("$self was created without a CurrentUser"); + $RT::Logger->err("$self was created without a CurrentUser\n"); + return(0); + } + $self->SUPER::_Init( 'Handle' => $RT::Handle); +} +# }}} + +# {{{ sub LimitToEnabled + +=head2 LimitToEnabled + +Only find items that haven\'t been disabled + +=cut + +sub LimitToEnabled { + my $self = shift; + + $self->Limit( FIELD => 'Disabled', + VALUE => '0', + OPERATOR => '=' ); +} +# }}} + +# {{{ sub LimitToDisabled + +=head2 LimitToDeleted + +Only find items that have been deleted. + +=cut + +sub LimitToDeleted { + my $self = shift; + + $self->{'find_disabled_rows'} = 1; + $self->Limit( FIELD => 'Disabled', + OPERATOR => '=', + VALUE => '1' + ); +} +# }}} + + +# {{{ sub Limit + +=head2 Limit PARAMHASH + +This Limit sub calls SUPER::Limit, but defaults "CASESENSITIVE" to 1, thus +making sure that by default lots of things don't do extra work trying to +match lower(colname) agaist lc($val); + +=cut + +sub Limit { + my $self = shift; + my %args = ( CASESENSITIVE => 1, + @_ ); + + return $self->SUPER::Limit(%args); +} + +# {{{ sub CurrentUser + +=head2 CurrentUser + + Returns the current user as an RT::User object. + +=cut + +sub CurrentUser { + my $self = shift; + return ($self->{'user'}); +} +# }}} + + +1; + + diff --git a/rt/lib/RT/Group.pm b/rt/lib/RT/Group.pm new file mode 100755 index 000000000..005601f5e --- /dev/null +++ b/rt/lib/RT/Group.pm @@ -0,0 +1,364 @@ +# $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 +# +# + +=head1 NAME + + RT::Group - RT\'s group object + +=head1 SYNOPSIS + + use RT::Group; +my $group = new RT::Group($CurrentUser); + +=head1 DESCRIPTION + +An RT group object. + +=head1 AUTHOR + +Jesse Vincent, jesse@fsck.com + +=head1 SEE ALSO + +RT + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Group); + +=end testing + +=cut + + +package RT::Group; +use RT::Record; +use RT::GroupMember; +use RT::ACE; + +use vars qw|@ISA|; +@ISA= qw(RT::Record); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Groups"; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Name => 'read/write', + Description => 'read/write', + Pseudo => 'read' + ); + return $self->SUPER::_Accessible(@_, %Cols); +} +# }}} + +# {{{ sub Load + +=head2 Load + +Load a group object from the database. Takes a single argument. +If the argument is numerical, load by the column 'id'. Otherwise, load by +the "Name" column which is the group's textual name + +=cut + +sub Load { + my $self = shift; + my $identifier = shift || return undef; + + #if it's an int, load by id. otherwise, load by name. + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol("Name",$identifier); + } +} + +# }}} + +# {{{ sub Create + +=head2 Create + +Takes a paramhash with three named arguments: Name, Description and Pseudo. +Pseudo is used internally by RT for certain special ACL decisions. + +=cut + +sub Create { + my $self = shift; + my %args = ( Name => undef, + Description => undef, + Pseudo => 0, + @_); + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + $RT::Logger->warning($self->CurrentUser->Name ." Tried to create a group without permission."); + return(0, 'Permission Denied'); + } + + my $retval = $self->SUPER::Create(Name => $args{'Name'}, + Description => $args{'Description'}, + Pseudo => $args{'Pseudo'}); + + return ($retval); +} + +# }}} + +# {{{ sub Delete + +=head2 Delete + +Delete this object + +=cut + +sub Delete { + my $self = shift; + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + + return($self->SUPER::Delete(@_)); +} + +# }}} + +# {{{ MembersObj + +=head2 MembersObj + +Returns an RT::GroupMembers object of this group's members. + +=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'}); + +} + +# }}} + +# {{{ AddMember + +=head2 AddMember + +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"); +} + +# }}} + +# {{{ HasMember + +=head2 HasMember + +Takes a user Id and returns a GroupMember Id if that user is a member of +this group. +Returns undef if the user isn't a member of the group or if the current +user doesn't have permission to find out. Arguably, it should differentiate +between ACL failure and non membership. + +=cut + +sub HasMember { + my $self = shift; + my $user_id = shift; + + #Try to cons up a member object using "LoadByCols" + + my $member_obj = new RT::GroupMember($self->CurrentUser); + $member_obj->LoadByCols( UserId => $user_id, GroupId => $self->id); + + #If we have a member object + if (defined $member_obj->id) { + return ($member_obj->id); + } + + #If Load returns no objects, we have an undef id. + else { + return(undef); + } +} + +# }}} + +# {{{ DeleteMember + +=head2 DeleteMember + +Takes the user id of a member. +If the current user has apropriate rights, +removes that GroupMember from this group. +Returns a two value array. the first value is true on successful +addition or 0 on failure. The second value is a textual status msg. + +=cut + +sub DeleteMember { + my $self = shift; + my $member = shift; + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + #User has no permission to be doing this + return(0,"Permission Denied"); + } + + my $member_user_obj = new RT::User($self->CurrentUser); + $member_user_obj->Load($member); + + unless ($member_user_obj->Id) { + $RT::Logger->debug("Couldn't find user $member"); + return(0, "User not found"); + } + + my $member_obj = new RT::GroupMember($self->CurrentUser); + unless ($member_obj->LoadByCols ( UserId => $member_user_obj->Id, + GroupId => $self->Id )) { + return(0, "Couldn\'t load member"); #couldn\'t load member object + } + + #If we couldn't load it, return undef. + unless ($member_obj->Id()) { + return (0, "Group has no such member"); + } + + #Now that we've checked ACLs and sanity, delete the groupmember + my $val = $member_obj->Delete(); + if ($val) { + return ($val, "Member deleted"); + } + else { + return (0, "Member not deleted"); + } +} + +# }}} + +# {{{ ACL Related routines + +# {{{ GrantQueueRight + +=head2 GrantQueueRight + +Grant a queue right to this group. 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 => 'Group', + PrincipalId => $self->Id, + @_); + + #ACLs get checked in ACE.pm + + my $ace = new RT::ACE($self->CurrentUser); + + return ($ace->Create(%args)); +} + +# }}} + +# {{{ GrantSystemRight + +=head2 GrantSystemRight + +Grant a system right to this group. +The only element that's important to set is RightName. + +=cut +sub GrantSystemRight { + + my $self = shift; + my %args = ( RightScope => 'System', + RightName => undef, + RightAppliesTo => 0, + PrincipalType => 'Group', + PrincipalId => $self->Id, + @_); + + # ACLS get checked in ACE.pm + + my $ace = new RT::ACE($self->CurrentUser); + return ($ace->Create(%args)); +} + + +# }}} + + +# {{{ sub _Set +sub _Set { + my $self = shift; + + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + + return ($self->SUPER::_Set(@_)); + +} +# }}} diff --git a/rt/lib/RT/GroupMember.pm b/rt/lib/RT/GroupMember.pm new file mode 100755 index 000000000..69de50b42 --- /dev/null +++ b/rt/lib/RT/GroupMember.pm @@ -0,0 +1,136 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/GroupMember.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License + +=head1 NAME + + RT::GroupMember - a member of an RT Group + +=head1 SYNOPSIS + +RT::GroupMember should never be called directly. It should generally +only be accessed through the helper functions in RT::Group; + +=head1 DESCRIPTION + + + + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::GroupMember); + +=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(@_)); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + GroupId => 'read', + UserId => 'read' + ); + + 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'})) +} +# }}} + +# {{{ sub Add + +=head2 Add + +Takes a paramhash of UserId and GroupId. makes that user a memeber +of that group + +=cut + +sub Add { + my $self = shift; + return ($self->Create(@_)); +} +# }}} + +# {{{ sub Delete + +=head2 Delete + +Takes no arguments. deletes the currently loaded member from the +group in question. + +=cut + +sub Delete { + my $self = shift; + unless ($self->CurrentUser->HasSystemRight('AdminGroups')) { + return (0, 'Permission Denied'); + } + return($self->SUPER::Delete(@_)); +} + +# }}} + +# {{{ sub UserObj + +=head2 UserObj + +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(@_)); +} +# }}} diff --git a/rt/lib/RT/GroupMembers.pm b/rt/lib/RT/GroupMembers.pm new file mode 100755 index 000000000..a90a2a899 --- /dev/null +++ b/rt/lib/RT/GroupMembers.pm @@ -0,0 +1,73 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/GroupMembers.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::GroupMembers - a collection of RT::GroupMember objects + +=head1 SYNOPSIS + + 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::GroupMember; + +@ISA= qw(RT::EasySearch); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "GroupMembers"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_) ); +} +# }}} + +# {{{ sub LimitToGroup + +=head2 LimitToGroup + +Takes a group id as its only argument. Limits the current search to that +group object + +=cut + +sub LimitToGroup { + my $self = shift; + my $group = shift; + + return ($self->Limit( + VALUE => "$group", + FIELD => 'GroupId', + ENTRYAGGREGATOR => 'OR', + )); + +} +# }}} + +# {{{ sub NewItem + +sub NewItem { + my $self = shift; + return(RT::GroupMember->new($self->CurrentUser)) +} + +# }}} +1; diff --git a/rt/lib/RT/Groups.pm b/rt/lib/RT/Groups.pm new file mode 100755 index 000000000..f44f1fdb3 --- /dev/null +++ b/rt/lib/RT/Groups.pm @@ -0,0 +1,100 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Groups.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Groups - a collection of RT::Group objects + +=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"; + } + +=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); + +# {{{ sub _Init + +sub _Init { + my $self = shift; + $self->{'table'} = "Groups"; + $self->{'primary_key'} = "id"; + + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); + + + return ( $self->SUPER::_Init(@_)); +} +# }}} + +# {{{ LimitToReal + +=head2 LimitToReal + +Make this groups object return only "real" groups, which can be +granted rights and have members assigned to them + +=cut + +sub LimitToReal { + my $self = shift; + + return ($self->Limit( FIELD => 'Pseudo', + VALUE => '0', + OPERATOR => '=')); + +} +# }}} + +# {{{ sub LimitToPseudo + +=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 => '=')); + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return (RT::Group->new($self->CurrentUser)); +} +# }}} + + +1; + diff --git a/rt/lib/RT/Handle.pm b/rt/lib/RT/Handle.pm new file mode 100644 index 000000000..6b74f361b --- /dev/null +++ b/rt/lib/RT/Handle.pm @@ -0,0 +1,53 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Handle.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Handle - RT's database handle + +=head1 SYNOPSIS + + use RT::Handle; + +=head1 DESCRIPTION + +=begin testing + +ok(require RT::Handle); + +=end testing + +=head1 METHODS + +=cut + +package RT::Handle; + +eval "use DBIx::SearchBuilder::Handle::$RT::DatabaseType; + +\@ISA= qw(DBIx::SearchBuilder::Handle::$RT::DatabaseType);"; + +#TODO check for errors here. + +=head2 Connect + +Takes nothing. Calls SUPER::Connect with the needed args + +=cut + +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, + User => $RT::DatabaseUser, + Password => $RT::DatabasePassword, + Port => $RT::DatabasePort, + Driver => $RT::DatabaseType, + RequireSSL => $RT::DatabaseRequireSSL, + ); + +} +1; diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm new file mode 100644 index 000000000..a3bf92d5f --- /dev/null +++ b/rt/lib/RT/Interface/CLI.pm @@ -0,0 +1,224 @@ +# $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> + +package RT::Interface::CLI; + +use strict; + + +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 + + @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); +} + +=head1 NAME + + RT::Interface::CLI - helper functions for creating a commandline RT interface + +=head1 SYNOPSIS + + use lib "!!RT_LIB_PATH!!"; + use lib "!!RT_ETC_PATH!!"; + + 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(); + + #Connect to the database and get RT::SystemUser and RT::Nobody loaded + DBConnect(); + + + #Get the current user all loaded + my $CurrentUser = GetCurrentUser(); + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Interface::CLI); + +=end testing + +=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 GetCurrentUser + +=head2 GetCurrentUser + + Figures out the uid of the current user and returns an RT::CurrentUser object +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]; + + #If the current user is 0, then RT will assume that the User object + #is that of the currentuser. + + $CurrentUser = new RT::CurrentUser(); + $CurrentUser->LoadByGecos($Gecos); + + unless ($CurrentUser->Id) { + $RT::Logger->debug("No user with a unix login of '$Gecos' was found. "); + } + return($CurrentUser); +} +# }}} + +# {{{ sub GetMessageContent + +=head2 GetMessageContent + +Takes two arguments a source file and a boolean "edit". If the source file +is undef or "", assumes an empty file. Returns an edited file as an +array of lines. + +=cut + +sub GetMessageContent { + my %args = ( Source => undef, + Content => undef, + Edit => undef, + CurrentUser => undef, + @_); + my $source = $args{'Source'}; + + my $edit = $args{'Edit'}; + + my $currentuser = $args{'CurrentUser'}; + my @lines; + + use File::Temp qw/ tempfile/; + + #Load the sourcefile, if it's been handed to us + if ($source) { + open (SOURCE, "<$source"); + @lines = (<SOURCE>); + close (SOURCE); + } + elsif ($args{'Content'}) { + @lines = split('\n',$args{'Content'}); + } + #get us a tempfile. + my ($fh, $filename) = tempfile(); + + #write to a tmpfile + for (@lines) { + print $fh $_; + } + close ($fh); + + #Edit the file if we need to + if ($edit) { + + unless ($ENV{'EDITOR'}) { + $RT::Logger->crit('No $EDITOR variable defined'. "\n"); + return undef; + } + system ($ENV{'EDITOR'}, $filename); + } + + open (READ, "<$filename"); + my @newlines = (<READ>); + close (READ); + + unlink ($filename) unless (debug()); + return(\@newlines); + +} + +# }}} + +# {{{ 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); + } +} + +# }}} + + +1; diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm new file mode 100755 index 000000000..e95436091 --- /dev/null +++ b/rt/lib/RT/Interface/Email.pm @@ -0,0 +1,581 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Email.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ +# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com> + +package RT::Interface::Email; + +use strict; +use Mail::Address; +use MIME::Entity; + +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 + + @ISA = qw(Exporter); + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw(&CleanEnv + &LoadConfig + &DBConnect + &GetCurrentUser + &GetMessageContent + &CheckForLoops + &CheckForSuspiciousSender + &CheckForAutoGenerated + &ParseMIMEEntityFromSTDIN + &ParseTicketId + &MailError + &ParseCcAddressesFromHead + &ParseSenderAddressFromHead + &ParseErrorsToAddressFromHead + &ParseAddressFromHeader + + + &debug); +} + +=head1 NAME + + RT::Interface::CLI - helper functions for creating a commandline RT interface + +=head1 SYNOPSIS + + 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(); + +=head1 DESCRIPTION + + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Interface::Email); + +=end testing + + +=head1 METHODS + +=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 { + my $head = shift; + + #If this instance of RT sent it our, we don't want to take it in + my $RTLoop = $head->get("X-RT-Loop-Prevention") || ""; + chomp ($RTLoop); #remove that newline + if ($RTLoop eq "$RT::rtname") { + return (1); + } + + # TODO: We might not trap the case where RT instance A sends a mail + # to RT instance B which sends a mail to ... + return (undef); +} + +# }}} + +# {{{ sub CheckForSuspiciousSender + +sub CheckForSuspiciousSender { + my $head = shift; + + #if it's from a postmaster or mailer daemon, it's likely a bounce. + + #TODO: better algorithms needed here - there is no standards for + #bounces, so it's very difficult to separate them from anything + #else. At the other hand, the Return-To address is only ment to be + #used as an error channel, we might want to put up a separate + #Return-To address which is treated differently. + + #TODO: search through the whole email and find the right Ticket ID. + + my ($From, $junk) = ParseSenderAddressFromHead($head); + + if (($From =~ /^mailer-daemon/i) or + ($From =~ /^postmaster/i)){ + return (1); + + } + + return (undef); + +} + +# }}} + +# {{{ sub CheckForAutoGenerated +sub CheckForAutoGenerated { + my $head = shift; + + my $Precedence = $head->get("Precedence") || "" ; + if ($Precedence =~ /^(bulk|junk)/i) { + return (1); + } + else { + return (0); + } +} + +# }}} + +# {{{ 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 { + my %args = (To => $RT::OwnerEmail, + Bcc => undef, + From => $RT::CorrespondAddress, + Subject => 'There has been an error', + Explanation => 'Unexplained error', + MIMEObj => undef, + LogLevel => 'crit', + @_); + + + $RT::Logger->log(level => $args{'LogLevel'}, + message => $args{'Explanation'} + ); + my $entity = MIME::Entity->build( Type =>"multipart/mixed", + From => $args{'From'}, + Bcc => $args{'Bcc'}, + To => $args{'To'}, + Subject => $args{'Subject'}, + 'X-RT-Loop-Prevention' => $RT::rtname, + ); + + $entity->attach( Data => $args{'Explanation'}."\n"); + + my $mimeobj = $args{'MIMEObj'}; + 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; + close(MAIL); + } + else { + $entity->send($RT::MailCommand, $RT::MailParams); + } +} + +# }}} + +# {{{ sub GetCurrentUser + +sub GetCurrentUser { + my $head = shift; + my $entity = shift; + my $ErrorsTo = shift; + + my %UserInfo = (); + + #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(); + + # First try looking up by a username, if we got one from the external + # db lookup. Next, try looking up by email address. Failing that, + # try looking up by users who have this user's email address as their + # username. + + if ($Username) { + $CurrentUser->LoadByName($Username); + } + + unless ($CurrentUser->Id) { + $CurrentUser->LoadByEmail($Address); + } + + #If we can't get it by email address, try by name. + unless ($CurrentUser->Id) { + $CurrentUser->LoadByName($Address); + } + + + unless ($CurrentUser->Id) { + #If we couldn't load a user, determine whether to create a user + + # {{{ If we require an incoming address to be found in the external + # user database, reject the incoming message appropriately + if ( $RT::LookupSenderInExternalDatabase && + $RT::SenderMustExistInExternalDatabase && + !$UserFoundInExternalDatabase) { + + my $Message = "Sender's email address was not found in the user database."; + + # {{{ This code useful only if you've defined an AutoRejectRequest template + + require RT::Template; + my $template = new RT::Template($RT::Nobody); + $template->Load('AutoRejectRequest'); + $Message = $template->Content || $Message; + + # }}} + + MailError( To => $ErrorsTo, + Subject => "Ticket Creation failed: user could not be created", + Explanation => $Message, + MIMEObj => $entity, + LogLevel => 'notice' + ); + + return($CurrentUser); + + } + # }}} + + else { + my $NewUser = RT::User->new($RT::SystemUser); + + my ($Val, $Message) = + $NewUser->Create(Name => ($Username || $Address), + EmailAddress => $Address, + RealName => "$Name", + Password => undef, + Privileged => 0, + Comments => 'Autocreated on ticket submission' + ); + + unless ($Val) { + + # Deal with the race condition of two account creations at once + # + if ($Username) { + $NewUser->LoadByName($Username); + } + + unless ($NewUser->Id) { + $NewUser->LoadByEmail($Address); + } + + unless ($NewUser->Id) { + MailError( To => $ErrorsTo, + Subject => "User could not be created", + Explanation => "User creation failed in mailgateway: $Message", + MIMEObj => $entity, + LogLevel => 'crit' + ); + } + } + } + + #Load the new user object + $CurrentUser->LoadByEmail($Address); + + unless ($CurrentUser->id) { + $RT::Logger->warning("Couldn't load user '$Address'.". "giving up"); + MailError( To => $ErrorsTo, + Subject => "User could not be loaded", + Explanation => "User '$Address' could not be loaded in the mail gateway", + MIMEObj => $entity, + LogLevel => 'crit' + ); + + } + } + + return ($CurrentUser); + +} +# }}} + +# {{{ ParseCcAddressesFromHead + +=head2 ParseCcAddressesFromHead HASHREF + +Takes a hashref object containing QueueObj, Head and CurrentUser objects. +Returns a list of all email addresses in the To and Cc +headers b<except> the current Queue\'s email addresses, the CurrentUser\'s +email address and anything that the configuration sub RT::IsRTAddress matches. + +=cut + +sub ParseCcAddressesFromHead { + my %args = ( Head => undef, + QueueObj => undef, + CurrentUser => undef, + @_ ); + + my (@Addresses); + + my @ToObjs = Mail::Address->parse($args{'Head'}->get('To')); + my @CcObjs = Mail::Address->parse($args{'Head'}->get('Cc')); + + foreach my $AddrObj (@ToObjs, @CcObjs) { + my $Address = $AddrObj->address; + $Address = RT::CanonicalizeAddress($Address); + next if ($args{'CurrentUser'}->EmailAddress =~ /^$Address$/i); + next if ($args{'QueueObj'}->CorrespondAddress =~ /^$Address$/i); + next if ($args{'QueueObj'}->CommentAddress =~ /^$Address$/i); + next if (RT::IsRTAddress($Address)); + + push (@Addresses, $Address); + } + return (@Addresses); +} + + +# }}} + +# {{{ ParseSenderAdddressFromHead + +=head2 ParseSenderAddressFromHead + +Takes a MIME::Header object. Returns a tuple: (user@host, friendly name) +of the From (evaluated in order of Reply-To:, From:, Sender) + +=cut + +sub ParseSenderAddressFromHead { + my $head = shift; + #Figure out who's sending this message. + my $From = $head->get('Reply-To') || + $head->get('From') || + $head->get('Sender'); + return (ParseAddressFromHeader($From)); +} +# }}} + +# {{{ ParseErrorsToAdddressFromHead + +=head2 ParseErrorsToAddressFromHead + +Takes a MIME::Header object. Return a single value : user@host +of the From (evaluated in order of Errors-To:,Reply-To:, From:, Sender) + +=cut + +sub ParseErrorsToAddressFromHead { + my $head = shift; + #Figure out who's sending this message. + + foreach my $header ('Errors-To' , 'Reply-To', 'From', 'Sender' ) { + # If there's a header of that name + my $headerobj = $head->get($header); + if ($headerobj) { + my ($addr, $name ) = ParseAddressFromHeader($headerobj); + # If it's got actual useful content... + return ($addr) if ($addr); + } + } +} +# }}} + +# {{{ ParseAddressFromHeader + +=head2 ParseAddressFromHeader ADDRESS + +Takes an address from $head->get('Line') and returns a tuple: user@host, friendly name + +=cut + + +sub ParseAddressFromHeader{ + my $Addr = shift; + + my @Addresses = Mail::Address->parse($Addr); + + my $AddrObj = $Addresses[0]; + + unless (ref($AddrObj)) { + return(undef,undef); + } + + my $Name = ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address); + + + #Lets take the from and load a user object. + my $Address = $AddrObj->address; + + return ($Address, $Name); +} +# }}} + + +1; diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm new file mode 100644 index 000000000..6b5272848 --- /dev/null +++ b/rt/lib/RT/Interface/Web.pm @@ -0,0 +1,1287 @@ +## $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Web.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ + +## Portions Copyright 2000 Tobias Brox <tobix@fsck.com> +## Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com> + +## This is a library of static subs to be used by the Mason web +## interface to RT + +package RT::Interface::Web; + +# {{{ sub NewParser + +=head2 NewParser + + Returns a new Mason::Parser object. Takes a param hash of things + that get passed to HTML::Mason::Parser. Currently hard coded to only + take the parameter 'allow_globals'. + +=cut + +sub NewParser { + my %args = ( + allow_globals => undef, + @_ + ); + + my $parser = new HTML::Mason::Parser( + default_escape_flags => 'h', + allow_globals => $args{'allow_globals'} + ); + return ($parser); +} + +# }}} + +# {{{ sub NewInterp + +=head2 NewInterp + + Takes a paremeter hash. Needs a param called 'parser' which is a reference + to an HTML::Mason::Parser. + returns a new Mason::Interp object + +=cut + +sub NewInterp { + my %params = ( + comp_root => [ + [ local => $RT::MasonLocalComponentRoot ], + [ standard => $RT::MasonComponentRoot ] + ], + data_dir => "$RT::MasonDataDir", + @_ + ); + + #We allow recursive autohandlers to allow for RT auth. + + use HTML::Mason::Interp; + my $interp = new HTML::Mason::Interp(%params); + +} + +# }}} + +# {{{ sub NewApacheHandler + +=head2 NewApacheHandler + + Takes a Mason::Interp object + Returns a new Mason::ApacheHandler object + +=cut + +sub NewApacheHandler { + my $interp = shift; + my $ah = new HTML::Mason::ApacheHandler( interp => $interp ); + return ($ah); +} + +# }}} + + +# {{{ sub NewMason11ApacheHandler + +=head2 NewMason11ApacheHandler + + Returns a new Mason::ApacheHandler object + +=cut + +sub NewMason11ApacheHandler { + my %args = ( default_escape_flags => 'h', + allow_globals => [%session], + comp_root => [ + [ local => $RT::MasonLocalComponentRoot ], + [ standard => $RT::MasonComponentRoot ] + ], + data_dir => "$RT::MasonDataDir", + args_method => 'CGI' + ); + my $ah = new HTML::Mason::ApacheHandler(%args); + return ($ah); +} + +# }}} + + + + + +# }}} + +package HTML::Mason::Commands; + +# {{{ sub Abort +# Error - calls Error and aborts +sub Abort { + + if ( $session{'ErrorDocument'} && $session{'ErrorDocumentType'} ) { + SetContentType( $session{'ErrorDocumentType'} ); + $m->comp( $session{'ErrorDocument'}, Why => shift ); + $m->abort; + } + else { + SetContentType('text/html'); + $m->comp( "/Elements/Error", Why => shift ); + $m->abort; + } +} + +# }}} + +# {{{ sub CreateTicket + +=head2 CreateTicket ARGS + +Create a new ticket, using Mason's %ARGS. returns @results. +=cut + +sub CreateTicket { + my %ARGS = (@_); + + my (@Actions); + + my $Ticket = new RT::Ticket( $session{'CurrentUser'} ); + + my $Queue = new RT::Queue( $session{'CurrentUser'} ); + unless ( $Queue->Load( $ARGS{'Queue'} ) ) { + Abort('Queue not found'); + } + + unless ( $Queue->CurrentUserHasRight('CreateTicket') ) { + Abort('You have no permission to create tickets in that queue.'); + } + + my $due = new RT::Date( $session{'CurrentUser'} ); + $due->Set( Format => 'unknown', Value => $ARGS{'Due'} ); + my $starts = new RT::Date( $session{'CurrentUser'} ); + $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} ); + + my @Requestors = split ( /,/, $ARGS{'Requestors'} ); + my @Cc = split ( /,/, $ARGS{'Cc'} ); + my @AdminCc = split ( /,/, $ARGS{'AdminCc'} ); + + my $MIMEObj = MakeMIMEEntity( + Subject => $ARGS{'Subject'}, + From => $ARGS{'From'}, + Cc => $ARGS{'Cc'}, + Body => $ARGS{'Content'}, + AttachmentFieldName => 'Attach' + ); + + my %create_args = ( + Queue => $ARGS{Queue}, + Owner => $ARGS{Owner}, + InitialPriority => $ARGS{InitialPriority}, + FinalPriority => $ARGS{FinalPriority}, + TimeLeft => $ARGS{TimeLeft}, + TimeWorked => $ARGS{TimeWorked}, + Requestor => \@Requestors, + Cc => \@Cc, + AdminCc => \@AdminCc, + Subject => $ARGS{Subject}, + Status => $ARGS{Status}, + Due => $due->ISO, + Starts => $starts->ISO, + MIMEObj => $MIMEObj + ); + + # we need to get any KeywordSelect-<integer> fields into %create_args.. + grep { $_ =~ /^KeywordSelect-/ &&{ $create_args{$_} = $ARGS{$_} } } %ARGS; + + my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); + unless ( $id && $Trans ) { + Abort($ErrMsg); + } + my @linktypes = qw( DependsOn MemberOf RefersTo ); + + foreach my $linktype (@linktypes) { + foreach my $luri ( split ( / /, $ARGS{"new-$linktype"} ) ) { + $luri =~ s/\s*$//; # Strip trailing whitespace + my ( $val, $msg ) = $Ticket->AddLink( + Target => $luri, + Type => $linktype + ); + push ( @Actions, $msg ) unless ($val); + } + + foreach my $luri ( split ( / /, $ARGS{"$linktype-new"} ) ) { + my ( $val, $msg ) = $Ticket->AddLink( + Base => $luri, + Type => $linktype + ); + + push ( @Actions, $msg ) unless ($val); + } + } + + push ( @Actions, $ErrMsg ); + unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) { + Abort( "No permission to view newly created ticket #" + . $Ticket->id . "." ); + } + return ( $Ticket, @Actions ); + +} + +# }}} + +# {{{ sub LoadTicket - loads a ticket + +=head2 LoadTicket id + +Takes a ticket id as its only variable. if it's handed an array, it takes +the first value. + +Returns an RT::Ticket object as the current user. + +=cut + +sub LoadTicket { + my $id = shift; + + if ( ref($id) eq "ARRAY" ) { + $id = $id->[0]; + } + + unless ($id) { + Abort("No ticket specified"); + } + + my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); + $Ticket->Load($id); + unless ( $Ticket->id ) { + Abort("Could not load ticket $id"); + } + return $Ticket; +} + +# }}} + +# {{{ sub ProcessUpdateMessage + +sub ProcessUpdateMessage { + + #TODO document what else this takes. + my %args = ( + ARGSRef => undef, + Actions => undef, + TicketObj => undef, + @_ + ); + + #Make the update content have no 'weird' newlines in it + if ( $args{ARGSRef}->{'UpdateContent'} ) { + + if ( + $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() ) + { + $args{ARGSRef}->{'UpdateSubject'} = undef; + } + + my $Message = MakeMIMEEntity( + Subject => $args{ARGSRef}->{'UpdateSubject'}, + Body => $args{ARGSRef}->{'UpdateContent'}, + AttachmentFieldName => 'UpdateAttachment' + ); + + ## Check whether this was a refresh or not. + + # Match Correspondence or Comments. + my $trans_flag = -2; + my $trans_type = undef; + my $orig_trans = $args{ARGSRef}->{'UpdateType'}; + if ( $orig_trans =~ /^(private|public)$/ ) { + $trans_type = "Comment"; + }elsif ( $orig_trans eq 'response' ) { + $trans_type = "Correspond"; + } + + # Do we have a transaction that we need to update on? session + if( defined( $trans_type ) ){ + $trans_flag = 0; + + # Prepare a checksum. + # See perldoc -f unpack for example of this. + my $this_checksum = unpack("%32C*", $Message->body_as_string ) % 65535; + + # The above *could* generate duplicate checksums. Crosscheck with + # the length. + my $this_length = length( $Message->body_as_string ); + + # Don't forget the ticket id. + my $this_id = $args{TicketObj}->id; + + # Check whether the previous transaction in the + # ticket is the same as the current transaction. + if( defined( $session{'prev_trans_type'} ) && defined( $session{'prev_trans_chksum'} ) && defined( $session{'prev_trans_length'} ) && defined( $session{'prev_trans_tickid'} ) ){ + if( $session{'prev_trans_type'} eq $orig_trans && $session{'prev_trans_chksum'} == $this_checksum && $session{'prev_trans_length'} == $this_length && $session{'prev_trans_tickid'} == $this_id ){ + # Its the same as the previous transaction for this user. + $trans_flag = -1; + } + } + + # Store them for next time. + $session{'prev_trans_type'} = $orig_trans; + $session{'prev_trans_chksum'} = $this_checksum; + $session{'prev_trans_length'} = $this_length; + $session{'prev_trans_tickid'} = $this_id; + + if( $trans_flag == -1 ){ + push ( @{ $args{'Actions'} }, +"This appears to be a duplicate of your previous update (please do not refresh this page)" ); + } + + + if ( $trans_type eq 'Comment' && $trans_flag >= 0 ) { + my ( $Transaction, $Description ) = $args{TicketObj}->Comment( + CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, + BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, + MIMEObj => $Message, + TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'} + ); + push ( @{ $args{Actions} }, $Description ); + } + elsif ( $trans_type eq 'Correspond' && $trans_flag >= 0 ) { + my ( $Transaction, $Description ) = $args{TicketObj}->Correspond( + CcMessageTo => $args{ARGSRef}->{'UpdateCc'}, + BccMessageTo => $args{ARGSRef}->{'UpdateBcc'}, + MIMEObj => $Message, + TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'} + ); + push ( @{ $args{Actions} }, $Description ); + } + } + else { + push ( @{ $args{'Actions'} }, + "Update type was neither correspondence nor comment. Update not recorded" + ); + } + } +} + +# }}} + +# {{{ sub MakeMIMEEntity + +=head2 MakeMIMEEntity PARAMHASH + +Takes a paramhash Subject, Body and AttachmentFieldName. + + Returns a MIME::Entity. + +=cut + +sub MakeMIMEEntity { + + #TODO document what else this takes. + my %args = ( + Subject => undef, + From => undef, + Cc => undef, + Body => undef, + AttachmentFieldName => undef, + @_ + ); + + #Make the update content have no 'weird' newlines in it + + $args{'Body'} =~ s/\r\n/\n/gs; + my $Message = MIME::Entity->build( + Subject => $args{'Subject'} || "", + From => $args{'From'}, + Cc => $args{'Cc'}, + Data => [ $args{'Body'} ] + ); + + my $cgi_object = CGIObject(); + if ( $cgi_object->param( $args{'AttachmentFieldName'} ) ) { + + my $cgi_filehandle = + $cgi_object->upload( $args{'AttachmentFieldName'} ); + + use File::Temp qw(tempfile tempdir); + + #foreach my $filehandle (@filenames) { + + # my ( $fh, $temp_file ) = tempfile(); + + #$binmode $fh; #thank you, windows + + # We're having trouble with tempfiles not getting created. Let's try it with + # a scalar instead + + my ( $buffer, @file ); + + while ( my $bytesread = read( $cgi_filehandle, $buffer, 4096 ) ) { + push ( @file, $buffer ); + } + + $RT::Logger->debug($file); + my $filename = "$cgi_filehandle"; + $filename =~ s#^(.*)/##; + $filename =~ s#^(.*)\\##; + my $uploadinfo = $cgi_object->uploadInfo($cgi_filehandle); + $Message->attach( + Data => \@file, + + #Path => $temp_file, + Filename => $filename, + Type => $uploadinfo->{'Content-Type'} + ); + + #close($fh); + #unlink($temp_file); + + # } + } + $Message->make_singlepart(); + return ($Message); + +} + +# }}} + +# {{{ sub ProcessSearchQuery + +=head2 ProcessSearchQuery + + Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand. + +TODO Doc exactly what comes in the paramhash + + +=cut + +sub ProcessSearchQuery { + my %args = @_; + + ## TODO: The only parameter here is %ARGS. Maybe it would be + ## cleaner to load this parameter as $ARGS, and use $ARGS->{...} + ## instead of $args{ARGS}->{...} ? :) + + #Searches are sticky. + if ( defined $session{'tickets'} ) { + + # Reset the old search + $session{'tickets'}->GotoFirstItem; + } + else { + + # Init a new search + $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} ); + } + + #Import a bookmarked search if we have one + if ( defined $args{ARGS}->{'Bookmark'} ) { + $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} ); + } + + # {{{ Goto next/prev page + if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) { + $session{'tickets'}->NextPage; + } + elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) { + $session{'tickets'}->PrevPage; + } + + # }}} + + # {{{ Deal with limiting the search + + if ( $args{ARGS}->{'RefreshSearchInterval'} ) { + $session{'tickets_refresh_interval'} = + $args{ARGS}->{'RefreshSearchInterval'}; + } + + if ( $args{ARGS}->{'TicketsSortBy'} ) { + $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'}; + $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'}; + $session{'tickets'}->OrderBy( + FIELD => $args{ARGS}->{'TicketsSortBy'}, + ORDER => $args{ARGS}->{'TicketsSortOrder'} + ); + } + + # }}} + + # {{{ Set the query limit + if ( defined $args{ARGS}->{'RowsPerPage'} ) { + $RT::Logger->debug( + "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" ); + + $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'}; + $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} ); + } + + # }}} + # {{{ Limit priority + if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) { + $session{'tickets'}->LimitPriority( + VALUE => $args{ARGS}->{'ValueOfPriority'}, + OPERATOR => $args{ARGS}->{'PriorityOp'} + ); + } + + # }}} + # {{{ Limit owner + if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) { + $session{'tickets'}->LimitOwner( + VALUE => $args{ARGS}->{'ValueOfOwner'}, + OPERATOR => $args{ARGS}->{'OwnerOp'} + ); + } + + # }}} + # {{{ Limit requestor email + + if ( $args{ARGS}->{'ValueOfRequestor'} ne '' ) { + my $alias = $session{'tickets'}->LimitRequestor( + VALUE => $args{ARGS}->{'ValueOfRequestor'}, + OPERATOR => $args{ARGS}->{'RequestorOp'}, + ); + + } + + # }}} + # {{{ Limit Queue + if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) { + $session{'tickets'}->LimitQueue( + VALUE => $args{ARGS}->{'ValueOfQueue'}, + OPERATOR => $args{ARGS}->{'QueueOp'} + ); + } + + # }}} + # {{{ Limit Status + if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) { + if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) { + foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) { + $session{'tickets'}->LimitStatus( + VALUE => $value, + OPERATOR => $args{ARGS}->{'StatusOp'}, + ); + } + } + else { + $session{'tickets'}->LimitStatus( + VALUE => $args{ARGS}->{'ValueOfStatus'}, + OPERATOR => $args{ARGS}->{'StatusOp'}, + ); + } + + } + + # }}} + # {{{ Limit Subject + if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) { + $session{'tickets'}->LimitSubject( + VALUE => $args{ARGS}->{'ValueOfSubject'}, + OPERATOR => $args{ARGS}->{'SubjectOp'}, + ); + } + + # }}} + # {{{ Limit Dates + if ( $args{ARGS}->{'ValueOfDate'} ne '' ) { + + my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} ); + $args{ARGS}->{'DateType'} =~ s/_Date$//; + + $session{'tickets'}->LimitDate( + FIELD => $args{ARGS}->{'DateType'}, + VALUE => $date, + OPERATOR => $args{ARGS}->{'DateOp'}, + ); + } + + # }}} + # {{{ Limit Content + if ( $args{ARGS}->{'ValueOfContent'} ne '' ) { + $session{'tickets'}->LimitContent( + VALUE => $args{ARGS}->{'ValueOfContent'}, + OPERATOR => $args{ARGS}->{'ContentOp'}, + ); + } + + # }}} + # {{{ Limit KeywordSelects + + foreach my $KeywordSelectId ( + map { /^KeywordSelect(\d+)$/; $1 } + grep { /^KeywordSelect(\d+)$/; } keys %{ $args{ARGS} } + ) + { + my $form = $args{ARGS}->{"KeywordSelect$KeywordSelectId"}; + my $oper = $args{ARGS}->{"KeywordSelectOp$KeywordSelectId"}; + foreach my $KeywordId ( ref($form) ? @{$form} : ($form) ) { + next unless ($KeywordId); + my $quote = 1; + if ( $KeywordId =~ /^null$/i ) { + + #Don't quote the string 'null' + $quote = 0; + + # Convert the operator to something apropriate for nulls + $oper = 'IS' if ( $oper eq '=' ); + $oper = 'IS NOT' if ( $oper eq '!=' ); + } + $session{'tickets'}->LimitKeyword( + KEYWORDSELECT => $KeywordSelectId, + OPERATOR => $oper, + QUOTEVALUE => $quote, + KEYWORD => $KeywordId + ); + } + } + + # }}} + +} + +# }}} + +# {{{ sub ParseDateToISO + +=head2 ParseDateToISO + +Takes a date in an arbitrary format. +Returns an ISO date and time in GMT + +=cut + +sub ParseDateToISO { + my $date = shift; + + my $date_obj = new RT::Date($CurrentUser); + $date_obj->Set( + Format => 'unknown', + Value => $date + ); + return ( $date_obj->ISO ); +} + +# }}} + +# {{{ sub Config +# TODO: This might eventually read the cookies, user configuration +# information from the DB, queue configuration information from the +# DB, etc. + +sub Config { + my $args = shift; + my $key = shift; + return $args->{$key} || $RT::WebOptions{$key}; +} + +# }}} + +# {{{ sub ProcessACLChanges + +sub ProcessACLChanges { + my $ACLref = shift; + my $ARGSref = shift; + + my @CheckACL = @$ACLref; + my %ARGS = %$ARGSref; + + my ( $ACL, @results ); + + # {{{ Add rights + foreach $ACL (@CheckACL) { + my ($Principal); + + next unless ($ACL); + + # Parse out what we're really talking about. + if ( $ACL =~ /^(.*?)-(\d+)-(.*?)-(\d+)/ ) { + my $PrincipalType = $1; + my $PrincipalId = $2; + my $Scope = $3; + my $AppliesTo = $4; + + # {{{ Create an object called Principal + # so we can do rights operations + + if ( $PrincipalType eq 'User' ) { + $Principal = new RT::User( $session{'CurrentUser'} ); + } + elsif ( $PrincipalType eq 'Group' ) { + $Principal = new RT::Group( $session{'CurrentUser'} ); + } + else { + Abort("$PrincipalType unknown principal type"); + } + + $Principal->Load($PrincipalId) + || Abort("$PrincipalType $PrincipalId couldn't be loaded"); + + # }}} + + # {{{ load up an RT::ACL object with the same current vals of this ACL + + my $CurrentACL = new RT::ACL( $session{'CurrentUser'} ); + if ( $Scope eq 'Queue' ) { + $CurrentACL->LimitToQueue($AppliesTo); + } + elsif ( $Scope eq 'System' ) { + $CurrentACL->LimitToSystem(); + } + + $CurrentACL->LimitPrincipalToType($PrincipalType); + $CurrentACL->LimitPrincipalToId($PrincipalId); + + # }}} + + # {{{ Get the values of the select we're working with + # into an array. it will contain all the new rights that have + # been granted + #Hack to turn the ACL returned into an array + my @rights = + ref( $ARGS{"GrantACE-$ACL"} ) eq 'ARRAY' + ? @{ $ARGS{"GrantACE-$ACL"} } + : ( $ARGS{"GrantACE-$ACL"} ); + + # }}} + + # {{{ Add any rights we need. + + foreach my $right (@rights) { + next unless ($right); + + #if the right that's been selected wasn't there before, add it. + unless ( + $CurrentACL->HasEntry( + RightScope => "$Scope", + RightName => "$right", + RightAppliesTo => "$AppliesTo", + PrincipalType => $PrincipalType, + PrincipalId => $Principal->Id + ) + ) + { + + #Add new entry to list of rights. + if ( $Scope eq 'Queue' ) { + my $Queue = new RT::Queue( $session{'CurrentUser'} ); + $Queue->Load($AppliesTo); + unless ( $Queue->id ) { + Abort("Couldn't find a queue called $AppliesTo"); + } + + my ( $val, $msg ) = $Principal->GrantQueueRight( + RightAppliesTo => $Queue->id, + RightName => "$right" + ); + + if ($val) { + push ( @results, + "Granted right $right to " + . $Principal->Name + . " for queue " + . $Queue->Name ); + } + else { + push ( @results, $msg ); + } + } + elsif ( $Scope eq 'System' ) { + my ( $val, $msg ) = $Principal->GrantSystemRight( + RightAppliesTo => $AppliesTo, + RightName => "$right" + ); + if ($val) { + push ( @results, "Granted system right '$right' to " + . $Principal->Name ); + } + else { + push ( @results, $msg ); + } + } + } + } + + # }}} + } + } + + # }}} Add rights + + # {{{ remove any rights that have been deleted + + my @RevokeACE = + ref( $ARGS{"RevokeACE"} ) eq 'ARRAY' + ? @{ $ARGS{"RevokeACE"} } + : ( $ARGS{"RevokeACE"} ); + + foreach my $aceid (@RevokeACE) { + + my $right = new RT::ACE( $session{'CurrentUser'} ); + $right->Load($aceid); + next unless ( $right->id ); + + my $phrase = "Revoked " + . $right->PrincipalType . " " + . $right->PrincipalObj->Name + . "'s right to " + . $right->RightName; + + if ( $right->RightScope eq 'System' ) { + $phrase .= ' across all queues.'; + } + else { + $phrase .= ' for the queue ' . $right->AppliesToObj->Name . '.'; + } + my ( $val, $msg ) = $right->Delete(); + if ($val) { + push ( @results, $phrase ); + } + else { + push ( @results, $msg ); + } + } + + # }}} + + return (@results); +} + +# }}} + +# {{{ sub UpdateRecordObj + +=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs) + +@attribs is a list of ticket fields to check and update if they differ from the B<Object>'s current values. ARGSRef is a ref to HTML::Mason's %ARGS. + +Returns an array of success/failure messages + +=cut + +sub UpdateRecordObject { + my %args = ( + ARGSRef => undef, + AttributesRef => undef, + Object => undef, + @_ + ); + + my (@results); + + my $object = $args{'Object'}; + my $attributes = $args{'AttributesRef'}; + my $ARGSRef = $args{'ARGSRef'}; + + foreach $attribute (@$attributes) { + if ( ( defined $ARGSRef->{"$attribute"} ) + and ( $ARGSRef->{"$attribute"} ne $object->$attribute() ) ) + { + $ARGSRef->{"$attribute"} =~ s/\r\n/\n/gs; + + my $method = "Set$attribute"; + my ( $code, $msg ) = $object->$method( $ARGSRef->{"$attribute"} ); + push @results, "$attribute: $msg"; + } + } + return (@results); +} + +# }}} + +# {{{ sub ProcessTicketBasics + +=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketBasics { + + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $TicketObj = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + # {{{ Set basic fields + my @attribs = qw( + Subject + FinalPriority + Priority + TimeWorked + TimeLeft + Status + Queue + ); + + if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) { + my $tempqueue = RT::Queue->new($RT::SystemUser); + $tempqueue->Load( $ARGSRef->{'Queue'} ); + if ( $tempqueue->id ) { + $ARGSRef->{'Queue'} = $tempqueue->Id(); + } + } + + my @results = UpdateRecordObject( + AttributesRef => \@attribs, + Object => $TicketObj, + ARGSRef => $ARGSRef + ); + + # We special case owner changing, so we can use ForceOwnerChange + if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner ne $ARGSRef->{'Owner'} ) ) { + my ($ChownType); + if ( $ARGSRef->{'ForceOwnerChange'} ) { + $ChownType = "Force"; + } + else { + $ChownType = "Give"; + } + + my ( $val, $msg ) = + $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType ); + push ( @results, "$msg" ); + } + + # }}} + + return (@results); +} + +# }}} + +# {{{ sub ProcessTicketWatchers + +=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketWatchers { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + my (@results); + + my $Ticket = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + # {{{ Munge watchers + + foreach my $key ( keys %$ARGSRef ) { + + # Delete deletable watchers + if ( ( $key =~ /^DelWatcher(\d*)$/ ) and ( $ARGSRef->{$key} ) ) { + my ( $code, $msg ) = $Ticket->DeleteWatcher($1); + push @results, $msg; + } + + # Delete watchers in the simple style demanded by the bulk manipulator + elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) { + my ( $code, $msg ) = $Ticket->DeleteWatcher( $ARGSRef->{$key}, $1 ); + push @results, $msg; + } + + # Add new wathchers by email address + elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ ) + and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) ) + { + + #They're in this order because otherwise $1 gets clobbered :/ + my ( $code, $msg ) = $Ticket->AddWatcher( + Type => $ARGSRef->{$key}, + Email => $ARGSRef->{ "WatcherAddressEmail" . $1 } + ); + push @results, $msg; + } + + #Add requestors in the simple style demanded by the bulk manipulator + elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) { + my ( $code, $msg ) = $Ticket->AddWatcher( + Type => $1, + Email => $ARGSRef->{$key} + ); + push @results, $msg; + } + + # Add new watchers by owner + elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ ) + and ( $key =~ /^WatcherTypeUser(\d*)$/ ) ) + { + + #They're in this order because otherwise $1 gets clobbered :/ + my ( $code, $msg ) = + $Ticket->AddWatcher( Type => $ARGSRef->{$key}, Owner => $1 ); + push @results, $msg; + } + } + + # }}} + + return (@results); +} + +# }}} + +# {{{ sub ProcessTicketDates + +=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketDates { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $Ticket = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my (@results); + + # {{{ Set date fields + my @date_fields = qw( + Told + Resolved + Starts + Started + Due + ); + + #Run through each field in this list. update the value if apropriate + foreach $field (@date_fields) { + my ( $code, $msg ); + + my $DateObj = RT::Date->new( $session{'CurrentUser'} ); + + #If it's something other than just whitespace + if ( $ARGSRef->{ $field . '_Date' } ne '' ) { + $DateObj->Set( + Format => 'unknown', + Value => $ARGSRef->{ $field . '_Date' } + ); + my $obj = $field . "Obj"; + if ( ( defined $DateObj->Unix ) + and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) ) + { + my $method = "Set$field"; + my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO ); + push @results, "$msg"; + } + } + } + + # }}} + return (@results); +} + +# }}} + +# {{{ sub ProcessTicketLinks + +=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketLinks { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $Ticket = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my (@results); + + # Delete links that are gone gone gone. + foreach my $arg ( keys %$ARGSRef ) { + if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) { + my $base = $1; + my $type = $2; + my $target = $3; + + push @results, + "Trying to delete: Base: $base Target: $target Type $type"; + my ( $val, $msg ) = $Ticket->DeleteLink( + Base => $base, + Type => $type, + Target => $target + ); + + push @results, $msg; + + } + + } + + my @linktypes = qw( DependsOn MemberOf RefersTo ); + + foreach my $linktype (@linktypes) { + + for my $luri ( split ( / /, $ARGSRef->{ $Ticket->Id . "-$linktype" } ) ) + { + $luri =~ s/\s*$//; # Strip trailing whitespace + my ( $val, $msg ) = $Ticket->AddLink( + Target => $luri, + Type => $linktype + ); + push @results, $msg; + } + + for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Ticket->Id } ) ) + { + my ( $val, $msg ) = $Ticket->AddLink( + Base => $luri, + Type => $linktype + ); + + push @results, $msg; + } + } + + #Merge if we need to + if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) { + my ( $val, $msg ) = + $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ); + push @results, $msg; + } + + return (@results); +} + +# }}} + +# {{{ sub ProcessTicketObjectKeywords + +=head2 ProcessTicketObjectKeywords ( TicketObj => $Ticket, ARGSRef => \%ARGS ); + +Returns an array of results messages. + +=cut + +sub ProcessTicketObjectKeywords { + my %args = ( + TicketObj => undef, + ARGSRef => undef, + @_ + ); + + my $TicketObj = $args{'TicketObj'}; + my $ARGSRef = $args{'ARGSRef'}; + + my (@results); + + # {{{ set ObjectKeywords. + + my $KeywordSelects = $TicketObj->QueueObj->KeywordSelects; + + # iterate through all the keyword selects for this queue + while ( my $KeywordSelect = $KeywordSelects->Next ) { + + # {{{ do some setup + + # if we have KeywordSelectMagic for this keywordselect: + next + unless + defined $ARGSRef->{ 'KeywordSelectMagic' . $KeywordSelect->id }; + + # Lets get a hash of the possible values to work with + my $value = $ARGSRef->{ 'KeywordSelect' . $KeywordSelect->id } || []; + + #lets get all those values in a hash. regardless of # of entries + #we'll use this for adding and deleting keywords from this object. + my %values = map { $_ => 1 } ref($value) ? @{$value} : ($value); + + # Load up the ObjectKeywords for this KeywordSelect for this ticket + my $ObjectKeys = $TicketObj->KeywordsObj( $KeywordSelect->id ); + + # }}} + # {{{ add new keywords + + foreach my $key ( keys %values ) { + + #unless the ticket has that keyword for that keyword select, + unless ( $ObjectKeys->HasEntry($key) ) { + + #Add the keyword + my ( $result, $msg ) = $TicketObj->AddKeyword( + Keyword => $key, + KeywordSelect => $KeywordSelect->id + ); + push ( @results, $msg ); + } + } + + # }}} + # {{{ Delete unused keywords + + #redo this search, so we don't ask it to delete things that are already gone + # such as when a single keyword select gets its value changed. + $ObjectKeys = $TicketObj->KeywordsObj( $KeywordSelect->id ); + + while ( my $TicketKey = $ObjectKeys->Next ) { + + # if the hash defined above doesn\'t contain the keyword mentioned, + unless ( $values{ $TicketKey->Keyword } ) { + + #I'd really love to just call $keyword->Delete, but then + # we wouldn't get a transaction recorded + my ( $result, $msg ) = $TicketObj->DeleteKeyword( + Keyword => $TicketKey->Keyword, + KeywordSelect => $KeywordSelect->id + ); + push ( @results, $msg ); + } + } + + # }}} + } + + #Iterate through the keyword selects for BulkManipulator style access + while ( my $KeywordSelect = $KeywordSelects->Next ) { + if ( $ARGSRef->{ "AddToKeywordSelect" . $KeywordSelect->Id } ) { + + #Add the keyword + my ( $result, $msg ) = $TicketObj->AddKeyword( + Keyword => + $ARGSRef->{ "AddToKeywordSelect" . $KeywordSelect->Id }, + KeywordSelect => $KeywordSelect->id + ); + push ( @results, $msg ); + } + if ( $ARGSRef->{ "DeleteFromKeywordSelect" . $KeywordSelect->Id } ) { + + #Delete the keyword + my ( $result, $msg ) = $TicketObj->DeleteKeyword( + Keyword => + $ARGSRef->{ "DeleteFromKeywordSelect" . $KeywordSelect->Id }, + KeywordSelect => $KeywordSelect->id + ); + push ( @results, $msg ); + } + } + + # }}} + + return (@results); +} + +# }}} + +1; diff --git a/rt/lib/RT/Keyword.pm b/rt/lib/RT/Keyword.pm new file mode 100644 index 000000000..a41e0a585 --- /dev/null +++ b/rt/lib/RT/Keyword.pm @@ -0,0 +1,446 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Keyword.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Keyword - Manipulate an RT::Keyword record + +=head1 SYNOPSIS + + use RT::Keyword; + + my $keyword = RT::Keyword->new($CurrentUser); + $keyword->Create( Name => 'tofu', + Description => 'fermented soy beans', + ); + + + my $keyword2 = RT::Keyword->new($CurrentUser); + $keyword2->Create( Name => 'beast', + Description => 'a wild animal', + Parent => $keyword->id(), + ); + +=head1 DESCRIPTION + +An B<RT::Keyword> object is an arbitrary string. + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Scrip); + +=end testing + + +=cut +package RT::Keyword; + +use strict; +use vars qw(@ISA); +use Tie::IxHash; +use RT::Record; +use RT::Keywords; + +@ISA = qw(RT::Record); + +# {{{ Core methods + +sub _Init { + my $self = shift; + $self->{'table'} = "Keywords"; + $self->SUPER::_Init(@_); +} + +sub _Accessible { + my $self = shift; + my %cols = ( + Name => 'read/write', #the keyword itself + Description => 'read/write', #a description of the keyword + Parent => 'read/write', #optional id of another B<RT::Keyword>, allowing keywords to be arranged hierarchically + Disabled => 'read/write' + ); + return ($self->SUPER::_Accessible( @_, %cols)); + +} + +# }}} + + +=over 4 + +=item new CURRENT_USER + +Takes a single argument, an RT::CurrentUser object. Instantiates a new +(uncreated) RT::Keyword object. + +=cut + +# {{{ sub Create + +=item Create KEY => VALUE, ... + +Takes a list of key/value pairs and creates a the object. Returns the id of +the newly created record, or false if there was an error. + +Keys are: + +Name - the keyword itself +Description - (not yet used) +Parent - optional link to another B<RT::Keyword>, allowing keyword to be arranged in a hierarchical fashion. Can be specified by id or Name. + +=cut + +sub Create { + my $self = shift; + my %args = (Name => undef, + Description => undef, + Parent => 0, + @_); + + unless ($self->CurrentUserHasRight('AdminKeywords')) { + return (0, 'Permission Denied'); + } + + if ( $args{'Parent'} && $args{'Parent'} !~ /^\d+$/ ) { + $RT::Logger->err( "can't yet specify parents by name, sorry: ". $args{'Parent'}); + return(0,'Parent must be specified by id'); + } + + my $val = $self->SUPER::Create(Name => $args{'Name'}, + Description => $args{'Description'}, + Parent => $args{'Parent'} + ); + if ($val) { + return ($val, 'Keyword created'); + } + else { + return(0,'Could not create keyword'); + } +} + +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + + return (0, 'Deleting this object would break referential integrity.'); +} + +# }}} + +# {{{ sub LoadByPath + +=head2 LoadByPath STRING + +LoadByPath takes a string. Whatever character starts the string is assumed to be a delimter. The routine parses the keyword path description and tries to load the keyword +described by that path. It returns a numerical status and a textual message. +A non-zero status means 'Success'. + +=cut + +sub LoadByPath { + my $self = shift; + + my $path = shift; + + my $delimiter = substr($path,0,1); + my @path_elements = split($delimiter, $path); + + #throw awya the first bogus path element + shift @path_elements; + + my $parent = 0; + my ($tempkey); + #iterate through all the path elements loading up a + #keyword object. when we're done, this object becomes + #whatever the last tempkey object was. + while (my $name = shift @path_elements) { + + $tempkey = new RT::Keyword($self->CurrentUser); + + my $loaded = $tempkey->LoadByNameAndParentId($name, $parent); + + #Set the new parent for loading its child. + $parent = $tempkey->Id; + + #If the parent Id is 0, then we're not recursing through the tree + # time to bail + return (0, "Couldn't find keyword") unless ($tempkey->id()); + + } + #Now that we're through with the loop, the last keyword loaded + # is the the one we wanted. + # we shouldn't need to explicitly load it like this. but we do. Thanks SQL + + $self->Load($tempkey->Id); + + return (1, 'Keyword loaded'); +} + + +# }}} + +# {{{ sub LoadByNameAndParentId + +=head2 LoadByNameAndParentId NAME PARENT_ID + +Takes two arguments, a keyword name and a parent id. Loads a keyword into + the current object. + +=cut + +sub LoadByNameAndParentId { + my $self = shift; + my $name = shift; + my $parentid = shift; + + my $val = $self->LoadByCols( Name => $name, Parent => $parentid); + if ($self->Id) { + return ($self->Id, 'Keyword loaded'); + } + else { + return (0, 'Keyword could not be found'); + } + } + +# }}} + + +# {{{ sub Load + +=head2 Load KEYWORD + +Loads KEYWORD, either by id if it's an integer or by Path, otherwise + +=cut + +sub Load { + my $self = shift; + my $id = shift; + + if (!$id) { + return (0, 'No keyword defined'); + } + if ($id =~ /^(\d+)$/) { + return ($self->SUPER::Load($id)); + } + else { + return($self->LoadByPath($id)); + } +} + + +# }}} + +# {{{ sub Path + +=item Path + + Returns this Keyword's full path going back to the root. (eg /OS/Unix/Linux/Redhat if +this keyword is "Redhat" ) + +=cut + +sub Path { + my $self = shift; + + if ($self->Parent == 0) { + return ("/".$self->Name); + } + else { + return ( $self->ParentObj->Path . "/" . $self->Name); + } + +} + +# }}} + +# {{{ sub RelativePath + +=head2 RelativePath KEYWORD_OBJ + +Takes a keyword object. Returns this keyword's path relative to that +keyword. + +=item Bugs + +Currently assumes that the "other" keyword is a predecessor of this keyword + +=cut + +sub RelativePath { + my $self = shift; + my $OtherKey = shift; + + my $OtherPath = $OtherKey->Path(); + my $MyPath = $self->Path; + $MyPath =~ s/^$OtherPath\///g; + return ($MyPath); +} + + +# }}} + +# {{{ sub ParentObj + +=item ParentObj + + Returns an RT::Keyword object of this Keyword's 'parents' + +=cut + +sub ParentObj { + my $self = shift; + + my $ParentObj = new RT::Keyword($self->CurrentUser); + $ParentObj->Load($self->Parent); + return ($ParentObj); +} + +# }}} + +# {{{ sub Children + +=item Children + +Return an RT::Keywords object this Object's children. + +=cut + +sub Children { + my $self = shift; + + my $Children = new RT::Keywords($self->CurrentUser); + $Children->LimitToParent($self->id); + return ($Children); +} + +# }}} + +# {{{ sub Descendents + +=item Descendents [ NUM_GENERATIONS [ EXCLUDE_HASHREF ] ] + +Returns an ordered (see L<Tie::IxHash>) hash reference of the descendents of +this keyword, possibly limited to a given number of generations. The keys +are B<RT::Keyword> I<id>s, and the values are strings containing the I<Name>s +of those B<RT::Keyword>s. + +=cut + +sub Descendents { + my $self = shift; + my $generations = shift || 0; + my $exclude = shift || {}; + my %results; + + + tie %results, 'Tie::IxHash'; + my $Keywords = new RT::Keywords($self->CurrentUser); + $Keywords->LimitToParent($self->id || 0 ); #If we have no id, start at the top + + while ( my $Keyword = $Keywords->Next ) { + + next if defined $exclude->{ $Keyword->id }; + $results{ $Keyword->id } = $Keyword->Name; + + if ( $generations == 0 || $generations > 1 ) { + #if we're limiting to some number of generations, + # decrement the number of generations + + my $nextgen = $generations; + $nextgen-- if ( $nextgen > 1 ); + + my $kids = $Keyword->Descendents($nextgen, \%results); + + foreach my $kid ( keys %{$kids}) { + $results{"$kid"} = $Keyword->Name. "/". $kids->{"$kid"}; + } + } + } + return(\%results); +} + +# }}} + +# {{{ ACL related methods + +# {{{ sub _Set + +# does an acl check and then passes off the call +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('AdminKeywords')) { + return (0,'Permission Denied'); + } + return $self->SUPER::_Set(@_); +} + +# }}} + +# {{{ sub CurrentUserHasRight + +=head2 CurrentUserHasRight + +Helper menthod for HasRight. Presets Principal to CurrentUser then +calls HasRight. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Principal => $self->CurrentUser->UserObj, + Right => $right )); + +} + +# }}} + +# {{{ sub HasRight + +=head2 HasRight + +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to Keywords. + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + @_ ); + + return( $args{'Principal'}->HasSystemRight( $args{'Right'}) ); + +} +# }}} + +# }}} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-rt@420.am> + +=head1 BUGS + +Yes. + +=head1 SEE ALSO + +L<RT::Keywords>, L<RT::ObjectKeyword>, L<RT::ObjectKeywords>, L<RT::Ticket>, +L<RT::Record> + +[A=cut + +1; + diff --git a/rt/lib/RT/KeywordSelect.pm b/rt/lib/RT/KeywordSelect.pm new file mode 100644 index 000000000..6865216fd --- /dev/null +++ b/rt/lib/RT/KeywordSelect.pm @@ -0,0 +1,452 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/KeywordSelect.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::KeywordSelect; + +use strict; +use vars qw(@ISA); +use RT::Record; +use RT::Keyword; + +@ISA = qw(RT::Record); + +# {{{ POD + +=head1 NAME + + RT::KeywordSelect - Manipulate an RT::KeywordSelect record + +=head1 SYNOPSIS + + use RT::KeywordSelect; + + my $keyword_select = RT::KeywordSelect->new($CurrentUser); + $keyword_select->Create( + Keyword => 20, + ObjectType => 'Ticket', + Name => 'Choices' + ); + + my $keyword_select = RT::KeywordSelect->new($CurrentUser); + $keyword_select->Create( + Name => 'Choices', + Keyword => 20, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => 1, + Single => 1, + Depth => 4, + ); + +=head1 DESCRIPTION + +An B<RT::KeywordSelect> object is a link between a Keyword and a object +type (one of: Ticket), titled by the I<Name> field of the B<RT::Keyword> such +that: + +=over 4 + +=item Object display will contain a field, titled with the I<Name> field and + showing any descendent keywords which are related to this object via the + B<RT::ObjectKeywords> table. + +=item Object creation for this object will contain a field titled with the + I<Name> field and containing the descendents of the B<RT::Keyword> as + choices. If the I<Single> field of this B<RT::KeywordSelect> is true, each + object must be associated (via an B<RT::ObjectKeywords> record) to a single + descendent. If the I<Single> field is false, each object may be connect to + zero, one, or many descendents. + +=item Searches for this object type will contain a selection field titled with + the I<Name> field and containing the descendents of the B<RT::Keyword> as + choices. + +=item If I<ObjectField> is defined (one of: Queue), all of the above apply only + when the value of I<ObjectField> (Queue) in B<ObjectType> (Ticket) matches + I<ObjectValue>. + +=back + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::KeywordSelects); + +=end testing + + +=head1 METHODS + + +=cut + + +=over 4 + +=item new CURRENT_USER + +Takes a single argument, an RT::CurrentUser object. Instantiates a new +(uncreated) RT::KeywordSelect object. + +=cut +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "KeywordSelects"; + $self->SUPER::_Init(@_); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Name => 'read/write', + Keyword => 'read/write', # link to Keywords. Can be specified by id + Single => 'read/write', # bool (described below) + + Depth => 'read/write', #- If non-zero, limits the descendents to this number of levels deep. + ObjectType => 'read/write', # currently only C<Ticket> + ObjectField => 'read/write', #optional, currently only C<Queue> + ObjectValue => 'read/write', #constrains KeywordSelect function to when B<ObjectType>.I<ObjectField> equals I<ObjectValue> + Disabled => 'read/write' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} + +# {{{ sub LoadByName + +=head2 LoadByName( Name => [NAME], Queue => [QUEUE_ID]) +. Takes a queue id and a keyword select name. + tries to load the keyword select for that queue. if that fails, it tries to load it + without a queue specified. + +=cut + + +sub LoadByName { + my $self = shift; + my %args = ( Name => undef, + Queue => undef, + @_ + ); + if ($args{'Queue'}) { + #Try to get the keyword select for this queue + $self->LoadByCols( Name => $args{'Name'}, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => $args{'Queue'}); + } + unless ($self->Id) { #if that failed to load an object + #Try to get the keyword select of that name that's global + $self->LoadByCols( Name => $args{'Name'}, + ObjectType => 'Ticket', + ObjectField => 'Queue', + ObjectValue => '0'); + } + + return($self->Id); + +} + +# }}} + +# {{{ sub Create +=item Create KEY => VALUE, ... + +Takes a list of key/value pairs and creates a the object. Returns the id of +the newly created record, or false if there was an error. + +Keys are: + +Keyword - link to Keywords. Can be specified by id. +Name - A name for this KeywordSelect +Single - bool (described above) +Depth - If non-zero, limits the descendents to this number of levels deep. +ObjectType - currently only C<Ticket> +ObjectField - optional, currently only C<Queue> +ObjectValue - constrains KeywordSelect function to when B<ObjectType>.I<ObjectField> equals I<ObjectValue> + +=cut + +sub Create { + my $self = shift; + my %args = ( Keyword => undef, + Single => 1, + Depth => 0, + Name => undef, + ObjectType => undef, + ObjectField => undef, + ObjectValue => undef, + @_); + + #If we're talking about a keyword select based on a ticket's 'Queue' field + if ( ($args{'ObjectField'} eq 'Queue') and + ($args{'ObjectType'} eq 'Ticket')) { + + #If we're talking about a keywordselect for all queues + if ($args{'ObjectValue'} == 0) { + unless( $self->CurrentUserHasSystemRight('AdminKeywordSelects')) { + return (0, 'Permission Denied'); + } + } + #otherwise, we're talking about a keywordselect for a specific queue + else { + unless ($self->CurrentUserHasQueueRight( Right => 'AdminKeywordSelects', + Queue => $args{'ObjectValue'})) { + return (0, 'Permission Denied'); + } + } + } + else { + return (0, "Can't create a KeywordSelect for that object/field combo"); + } + + my $Keyword = new RT::Keyword($self->CurrentUser); + + if ( $args{'Keyword'} && $args{'Keyword'} !~ /^\d+$/ ) { + $Keyword->LoadByPath($args{'Keyword'}); + } + else { + $Keyword->Load($args{'Keyword'}); + } + + unless ($Keyword->Id) { + $RT::Logger->debug("Keyword ".$args{'Keyword'} ." not found\n"); + return(0, 'Keyword not found'); + } + + $args{'Name'} = $Keyword->Name if (!$args{'Name'}); + + my $val = $self->SUPER::Create( Name => $args{'Name'}, + Keyword => $Keyword->Id, + Single => $args{'Single'}, + Depth => $args{'Depth'}, + ObjectType => $args{'ObjectType'}, + ObjectField => $args{'ObjectField'}, + ObjectValue => $args{'ObjectValue'}); + if ($val) { + return ($val, 'KeywordSelect Created'); + } + else { + return (0, 'System error. KeywordSelect not created'); + + } +} +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + + return (0, 'Deleting this object would break referential integrity.'); +} + +# }}} + + +# {{{ sub SetDisabled + +=head2 Sub SetDisabled + +Toggles the KeywordSelect's disabled flag. + + +=cut + +sub SetDisabled { + my $self = shift; + my $value = shift; + + unless ($self->CurrentUserHasRight('AdminKeywordSelects')) { + return (0, "Permission Denied"); + } + return($self->_Set(Field => 'Disabled', Value => $value)); +} + +# }}} + +# {{{ sub KeywordObj + +=item KeywordObj + +Returns the B<RT::Keyword> referenced by the I<Keyword> field. + +=cut + +sub KeywordObj { + my $self = shift; + + my $Keyword = new RT::Keyword($self->CurrentUser); + $Keyword->Load( $self->Keyword ); #or ? + return($Keyword); +} +# }}} + +# {{{ sub Object + +=item Object + +Returns the object (currently only RT::Queue) specified by ObjectField and ObjectValue. + +=cut + +sub Object { + my $self = shift; + if ( $self->ObjectField eq 'Queue' ) { + my $Queue = new RT::Queue($self->CurrentUser); + $Queue->Load( $self->ObjectValue ); + return ($Queue); + } else { + $RT::Logger->error("$self trying to load an object value for a non-queue object"); + return (undef); + } +} + +# }}} + +# {{{ sub _Set + +# does an acl check, then passes off the call +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('AdminKeywordSelects')) { + return (0, "Permission Denied"); + } + + return ($self->SUPER::_Set(@_)); + +} + +# }}} + + +# {{{ sub CurrentUserHasQueueRight + +=head2 CurrentUserHasQueueRight ( Queue => QUEUEID, Right => RIGHTNANAME ) + +Check to see whether the current user has the specified right for the specified queue. + +=cut + +sub CurrentUserHasQueueRight { + my $self = shift; + my %args = (Queue => undef, + Right => undef, + @_ + ); + return ($self->HasRight( Right => $args{'Right'}, + Principal => $self->CurrentUser->UserObj, + Queue => $args{'Queue'})); +} + +# }}} + +# {{{ sub CurrentUserHasSystemRight + +=head2 CurrentUserHasSystemRight RIGHTNAME + +Check to see whether the current user has the specified right for the 'system' scope. + +=cut + +sub CurrentUserHasSystemRight { + my $self = shift; + my $right = shift; + $RT::Logger->debug("$self in hashsysright for right $right\n"); + return ($self->HasRight( Right => $right, + System => 1, + Principal => $self->CurrentUser->UserObj)); +} + +# }}} + +# {{{ sub CurrentUserHasRight + +=item CurrentUserHasRight RIGHT [QUEUEID] + +Takes a rightname as a string. Can take a queue id as a second +optional parameter, which can be useful to a routine like create. +Helper menthod for HasRight. Presets Principal to CurrentUser then +calls HasRight. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->HasRight( Principal => $self->CurrentUser->UserObj, + Right => $right, + )); +} + +# }}} + +# {{{ sub HasRight + +=item HasRight + +Takes a param-hash consisting of "Right" and "Principal" Principal is +an RT::User object or an RT::CurrentUser object. "Right" is a textual +Right string that applies to KeywordSelects + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + Queue => undef, + System => undef, + @_ ); + + #If we're explicitly specifying a queue, as we need to do on create + if ($args{'Queue'}) { + return ($args{'Principal'}->HasQueueRight(Right => $args{'Right'}, + Queue => $args{'Queue'})); + } + #else if we're specifying to check a system right + elsif ($args{'System'}) { + return( $args{'Principal'}->HasSystemRight( $args{'Right'} )); + } + + #else if we 're using the object's queue + elsif (($self->__Value('ObjectField') eq 'Queue') and + ($self->__Value('ObjectValue') > 0 )) { + return ($args{'Principal'}->HasQueueRight(Right => $args{'Right'}, + Queue => $self->__Value('ObjectValue') )); + } + + #If the object is system scoped. + else { + return( $args{'Principal'}->HasSystemRight( $args{'Right'} )); + } +} + +# }}} + +=back + +=head1 AUTHORS + +Ivan Kohler <ivan-rt@420.am>, Jesse Vincent <jesse@fsck.com> + +=head1 BUGS + +The ACL system for this object is more byzantine than it should be. reworking it eventually +would be a good thing. + +=head1 SEE ALSO + +L<RT::KeywordSelects>, L<RT::Keyword>, L<RT::Keywords>, L<RT::ObjectKeyword>, +L<RT::ObjectKeywords>, L<RT::Record> + +=cut + +1; + diff --git a/rt/lib/RT/KeywordSelects.pm b/rt/lib/RT/KeywordSelects.pm new file mode 100644 index 000000000..c220b39f9 --- /dev/null +++ b/rt/lib/RT/KeywordSelects.pm @@ -0,0 +1,143 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/KeywordSelects.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Scrip); + +=end testing + +=cut + + +package RT::KeywordSelects; + +use strict; +use vars qw( @ISA ); +use RT::EasySearch; +use RT::KeywordSelect; + +@ISA = qw( RT::EasySearch ); + +# {{{ _Init +sub _Init { + my $self = shift; + $self->{'table'} = 'KeywordSelects'; + $self->{'primary_key'} = 'id'; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _DoSearch + +=head2 _DoSearch + + A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless +we're explicitly trying to see them. + +=cut + +sub _DoSearch { + my $self = shift; + + #unless we really want to find disabled rows, make sure we\'re only finding enabled ones. + unless($self->{'find_disabled_rows'}) { + $self->LimitToEnabled(); + } + + return($self->SUPER::_DoSearch(@_)); + +} + +# }}} + +# {{{ sub LimitToQueue +=head2 LimitToQueue + +Takes a queue id. Limits the returned set to KeywordSelects for that queue. +Repeated calls will be OR'd together. + +=cut + +sub LimitToQueue { + my $self = shift; + my $queue = shift; + + $self->Limit( FIELD => 'ObjectValue', + VALUE => $queue, + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' + ); + + $self->Limit( FIELD => 'ObjectType', + VALUE => 'Ticket', + OPERATOR => '='); + + $self->Limit( FIELD => 'ObjectField', + VALUE => 'Queue', + OPERATOR => '='); + + +} +# }}} + +# {{{ sub LimitToGlobals + +=head2 LimitToGlobals + +Limits the returned set to KeywordSelects for all queues. +Repeated calls will be OR'd together. + +=cut + +sub LimitToGlobals { + my $self = shift; + + $self->Limit( FIELD => 'ObjectType', + VALUE => 'Ticket', + OPERATOR => '='); + + $self->Limit( FIELD => 'ObjectField', + VALUE => 'Queue', + OPERATOR => '='); + + $self->Limit( FIELD => 'ObjectValue', + VALUE => '0', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' + ); + +} +# }}} + +# {{{ sub IncludeGlobals +=head2 IncludeGlobals + +Include KeywordSelects which apply globally in the set of returned results + +=cut + + +sub IncludeGlobals { + my $self = shift; + $self->Limit( FIELD => 'ObjectValue', + VALUE => '0', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' + ); + + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + #my $Handle = shift; + return (new RT::KeywordSelect($self->CurrentUser)); +} +# }}} +1; + diff --git a/rt/lib/RT/Keywords.pm b/rt/lib/RT/Keywords.pm new file mode 100644 index 000000000..a9ecda2bc --- /dev/null +++ b/rt/lib/RT/Keywords.pm @@ -0,0 +1,106 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Keywords.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Keywords - a collection of RT::Keyword objects + +=head1 SYNOPSIS + + use RT::Keywords; + my $keywords = RT::Keywords->new($user); + $keywords->LimitToParent(0); + while my ($keyword = $keywords->Next()) { + print $keyword->Name ."\n"; + } + + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Keywords); + +=end testing + +=cut + +package RT::Keywords; + +use strict; +use vars qw( @ISA ); +use RT::EasySearch; +use RT::Keyword; + +@ISA = qw( RT::EasySearch ); + + +# {{{ sub _Init + +sub _Init { + my $self = shift; + $self->{'table'} = 'Keywords'; + $self->{'primary_key'} = 'id'; + + # By default, order by name + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); + + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _DoSearch + +=head2 _DoSearch + + A subclass of DBIx::SearchBuilder::_DoSearch that makes sure that _Disabled rows never get seen unless +we're explicitly trying to see them. + +=cut + +sub _DoSearch { + my $self = shift; + + #unless we really want to find disabled rows, make sure we\'re only finding enabled ones. + unless($self->{'find_disabled_rows'}) { + $self->LimitToEnabled(); + } + + return($self->SUPER::_DoSearch(@_)); + +} + +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return (RT::Keyword->new($self->CurrentUser)); +} +# }}} + +# {{{ sub LimitToParent + +=head2 LimitToParent + +Takes a parent id and limits the returned keywords to children of that parent. + +=cut + +sub LimitToParent { + my $self = shift; + my $parent = shift; + $self->Limit( FIELD => 'Parent', + VALUE => $parent, + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR' ); +} +# }}} + +1; + diff --git a/rt/lib/RT/Link.pm b/rt/lib/RT/Link.pm new file mode 100644 index 000000000..885ffe3ed --- /dev/null +++ b/rt/lib/RT/Link.pm @@ -0,0 +1,373 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Link.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-1999 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Link - an RT Link object + +=head1 SYNOPSIS + + use RT::Link; + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket other similar objects. + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Link); + +=end testing + +=cut + +package RT::Link; +use RT::Record; +use Carp; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Links"; + return ($self->SUPER::_Init(@_)); +} + +# }}} + +# {{{ sub Create + +=head2 Create PARAMHASH + +Create a new link object. Takes 'Base', 'Target' and 'Type'. +Returns undef on failure or a Link Id on success. + +=cut + +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); +} + +# }}} + +# {{{ 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); + + +=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"); + } +} + +# }}} + +# {{{ sub TargetObj + +=head2 TargetObj + +=cut + +sub TargetObj { + my $self = shift; + return $self->_TicketObj('base',$self->Target); +} +# }}} + +# {{{ sub BaseObj + +=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)); +} +# }}} + + +# Static methods: + +# {{{ sub BaseIsLocal + +=head2 BaseIsLocal + +Returns true if the base of this link is a local ticket + +=cut + +sub BaseIsLocal { + my $self = shift; + return $self->_IsLocal($self->Base); +} + +# }}} + +# {{{ sub TargetIsLocal + +=head2 TargetIsLocal + +Returns true if the target of this link is a local ticket + +=cut + +sub TargetIsLocal { + my $self = shift; + return $self->_IsLocal($self->Target); +} + +# }}} + +# {{{ sub _IsLocal + +=head2 _IsLocal URI + +When handed a URI returns the local ticket id if it\'s local. otherwise returns undef. + +=cut + +sub _IsLocal { + my $self = shift; + my $URI=shift; + unless ($URI) { + $RT::Logger->warning ("$self _IsLocal called without a URI\n"); + return (undef); + } + # TODO: More thorough check + if ($URI =~ /^$RT::TicketBaseURI(\d+)$/) { + return($1); + } + else { + return (undef); + } +} +# }}} + + +# {{{ sub BaseAsHREF + +=head2 BaseAsHREF + +Returns an HTTP url to access the base of this link + +=cut + +sub BaseAsHREF { + my $self = shift; + return $self->AsHREF($self->Base); +} +# }}} + +# {{{ sub TargetAsHREF + +=head2 TargetAsHREF + +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 + +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 + +=head2 CanonicalizeURI + +Takes a single argument: some form of ticket identifier. +Returns its canonicalized URI. + +Bug: ticket aliases can't have :// in them. URIs must have :// in them. + +=cut + +sub 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 { + + #If we couldn't find a ticket, return undef. + return( undef); + + } + + +} + +# }}} + +1; + diff --git a/rt/lib/RT/Links.pm b/rt/lib/RT/Links.pm new file mode 100644 index 000000000..a8180caf0 --- /dev/null +++ b/rt/lib/RT/Links.pm @@ -0,0 +1,90 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Links.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Links - A collection of Link objects + +=head1 SYNOPSIS + + use RT::Links; + my $links = new RT::Links($CurrentUser); + +=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::Link; + +@ISA= qw(RT::EasySearch); + +# {{{ sub _Init +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); +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::Link->new($self->CurrentUser)); +} +# }}} + 1; + diff --git a/rt/lib/RT/ObjectKeyword.pm b/rt/lib/RT/ObjectKeyword.pm new file mode 100644 index 000000000..287d41fab --- /dev/null +++ b/rt/lib/RT/ObjectKeyword.pm @@ -0,0 +1,192 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/ObjectKeyword.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Released under the terms of the GNU Public License + +=head1 NAME + + RT::ObjectKeyword -- a keyword tied to an object in the database + +=head1 SYNOPSIS + + use RT::ObjectKeyword; + + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ObjectKeyword); + +=end testing + +=head1 METHODS + +=cut + +package RT::ObjectKeyword; + +use strict; +use vars qw(@ISA); +use RT::Record; + +@ISA = qw(RT::Record); + +sub _Init { + my $self = shift; + $self->{'table'} = "ObjectKeywords"; + $self->SUPER::_Init(@_); +} + +sub _Accessible { + my $self = shift; + + my %cols = ( + Keyword => 'read/write', #link to the B<RT::Keyword> + KeywordSelect => 'read/write', #link to the B<RT::KeywordSelect> + ObjectType => 'read/write', #currently only C<Ticket> + ObjectId => 'read/write', #link to the object specified in I<ObjectType> + ); + return ($self->SUPER::_Accessible( @_, %cols)); +} + + + +# TODO - post 2.0. add in _Set and _Value, so we can ACL them. protected at another API level + + +=head1 NAME + + RT::ObjectKeyword - Manipulate an RT::ObjectKeyword record + +=head1 SYNOPSIS + + use RT::ObjectKeyword; + + my $keyword = RT::ObjectKeyword->new($CurrentUser); + $keyword->Create; + +=head1 DESCRIPTION + +An B<RT::ObjectKeyword> object associates an B<RT::Keyword> with another +object (currently only B<RT::Ticket>. + +This module should B<NEVER> be called directly by client code. its API is entirely through RT ticket or other objects which can have keywords assigned. + + +=head1 METHODS + +=over 4 + +=item new CURRENT_USER + +Takes a single argument, an RT::CurrentUser object. Instantiates a new +(uncreated) RT::ObjectKeyword object. + +=cut + +# {{{ sub Create + +=item Create KEY => VALUE, ... + +Takes a list of key/value pairs and creates a the object. Returns the id of +the newly created record, or false if there was an error. + +Keys are: + +Keyword - link to the B<RT::Keyword> +ObjectType - currently only C<Ticket> +ObjectId - link to the object specified in I<ObjectType> + +=cut + + +sub Create { + my $self = shift; + my %args = (Keyword => undef, + KeywordSelect => undef, + ObjectType => undef, + ObjectId => undef, + @_); + + #TODO post 2.0 ACL check + + return ($self->SUPER::Create( Keyword => $args{'Keyword'}, + KeywordSelect => $args{'KeywordSelect'}, + ObjectType => $args{'ObjectType'}, + ObjectId => $args{'ObjectId'})) +} +# }}} + +# {{{ sub KeywordObj + +=item KeywordObj + +Returns an B<RT::Keyword> object of the Keyword associated with this ObjectKeyword. + +=cut + +sub KeywordObj { + my $self = shift; + my $keyword = new RT::Keyword($self->CurrentUser); + $keyword->Load($self->Keyword); + return ($keyword); +} +# }}} + +# {{{ sub KeywordSelectObj + +=item KeywordSelectObj + +Returns an B<RT::KeywordSelect> object of the KeywordSelect associated with this ObjectKeyword. + +=cut + +sub KeywordSelectObj { + my $self = shift; + my $keyword_sel = new RT::KeywordSelect($self->CurrentUser); + $keyword_sel->Load($self->KeywordSelect); + return ($keyword_sel); +} +# }}} + +# {{{ sub KeywordRelativePath + +=item KeywordRelativePath + +Returns a string of the Keyword's path relative to this ObjectKeyword's KeywordSelect + + + +=cut + +sub KeywordRelativePath { + my $self = shift; + return($self->KeywordObj->RelativePath( + $self->KeywordSelectObj->KeywordObj->Path)); + +} +# }}} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-rt@420.am> + +=head1 BUGS + +Yes. + +=head1 SEE ALSO + +L<RT::ObjectKeywords>, L<RT::Keyword>, L<RT::Keywords>, L<RT::Ticket>, +L<RT::Record> + +=cut + +1; + diff --git a/rt/lib/RT/ObjectKeywords.pm b/rt/lib/RT/ObjectKeywords.pm new file mode 100644 index 000000000..5df996e37 --- /dev/null +++ b/rt/lib/RT/ObjectKeywords.pm @@ -0,0 +1,234 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/ObjectKeywords.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +package RT::ObjectKeywords; + +use strict; +use vars qw( @ISA ); + +=head1 NAME + + RT::ObjectKeywords - note warning + +=head1 WARNING + +This module should B<NEVER> be called directly by client code. its API is entirely through RT ticket or other objects which can have keywords assigned. + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ObjectKeywords); + +=end testing + +=cut + +use RT::EasySearch; +use RT::ObjectKeyword; + +@ISA = qw( RT::EasySearch ); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = 'ObjectKeywords'; + $self->{'primary_key'} = 'id'; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return (new RT::ObjectKeyword($self->CurrentUser)); +} +# }}} + +# {{{ sub LimitToKeywordSelect + +=head2 LimitToKeywordSelect + + Takes a B<RT::KeywordSelect> id or Nameas its single argument. limits the returned set of ObjectKeywords +to ObjectKeywords which apply to that ticket + +=cut + + +sub LimitToKeywordSelect { + my $self = shift; + my $keywordselect = shift; + + if ($keywordselect =~ /^\d+$/) { + + $self->Limit(FIELD => 'KeywordSelect', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => "$keywordselect"); + } + + #We're limiting by name. time to be klever + else { + my $ks = $self->NewAlias('KeywordSelects'); + $self->Join(ALIAS1 => $ks, FIELD1 => 'id', + ALIAS2 => 'main', FIELD2 => 'KeywordSelect'); + + $self->Limit( ALIAS => "$ks", + FIELD => 'Name', + VALUE => "$keywordselect", + OPERATOR => "=", + ENTRYAGGREGATOR => "OR"); + + $self->Limit ( ALIAS => "$ks", + FIELD => 'ObjectType', + VALUE => 'Ticket', + OPERATOR => '=', + ); + + $self->Limit ( ALIAS => "$ks", + FIELD => 'ObjectField', + VALUE => 'Queue', + OPERATOR => '=', + ); + + + # TODO +++ we need to be able to limit the returned + # keywordselects to ones that apply only to this queue + # $self->Limit( ALIAS => "$ks", + # FIELD => 'ObjectValue', + # VALUE => $self->QueueObj->Id, + # OPERATOR => "=", + # ENTRYAGGREGATOR => "OR"); + + } + + + +} + +# }}} + +# {{{ LimitToTicket + +=head2 LimitToTicket TICKET_ID + + Takes an B<RT::Ticket> id as its single argument. limits the returned set of ObjectKeywords +to ObjectKeywords which apply to that ticket + +=cut + +sub LimitToTicket { + my $self = shift; + my $ticket = shift; + $self->Limit(FIELD => 'ObjectId', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => "$ticket"); + + $self->Limit(FIELD => 'ObjectType', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => "Ticket"); + +} + +# }}} + +# {{{ sub _DoSearch +#wrap around _DoSearch so that we can build the hash of returned +#values + +sub _DoSearch { + my $self = shift; + # $RT::Logger->debug("Now in ".$self."->_DoSearch"); + my $return = $self->SUPER::_DoSearch(@_); + # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return\n"); + $self->_BuildHash(); + return ($return); +} +# }}} + +# {{{ sub _BuildHash +#Build a hash of this ACL's entries. +sub _BuildHash { + my $self = shift; + + while (my $entry = $self->Next) { + + my $hashkey = $entry->Keyword; + $self->{'as_hash'}->{"$hashkey"} =1; + } + +} +# }}} + +# {{{ HasEntry + +=head2 HasEntry KEYWORD_ID + + Takes a keyword id and returns true if this ObjectKeywords object has an entry for that +keyword. Returns undef otherwise. + +=cut + +sub HasEntry { + + my $self = shift; + my $keyword = shift; + + + #if we haven't done the search yet, do it now. + $self->_DoSearch(); + + # $RT::Logger->debug("Now in ".$self."->HasEntry\n"); + + + if ($self->{'as_hash'}->{ $keyword } == 1) { + return(1); + } + else { + return(undef); + } +} + +# }}} + +# {{{ sub RelativePaths + +=head2 RelativePaths + +# Return a (reference to a) list of KeywordRelativePaths + +=cut + +sub RelativePaths { + my $self = shift; + + my @list; + + # Here $key is a RT::ObjectKeyword + while (my $key=$self->Next()) { + push(@list, $key->KeywordRelativePath); + } + return(\@list); +} +# }}} + +# {{{ sub RelativePathsAsString + +=head2 RelativePathsAsString + +# Returns the RT::ObjectKeywords->RelativePaths as a comma seperated string + +=cut + +sub RelativePathsAsString { + my $self = shift; + return(join(", ",@{$self->KeywordRelativePaths})); +} +# }}} + +1; + diff --git a/rt/lib/RT/Queue.pm b/rt/lib/RT/Queue.pm new file mode 100755 index 000000000..1656903b3 --- /dev/null +++ b/rt/lib/RT/Queue.pm @@ -0,0 +1,944 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Queue.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Queue - an RT Queue object + +=head1 SYNOPSIS + + use RT::Queue; + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing +use RT::TestHarness; + +use RT::Queue; + +=end testing + +=cut + + + +package RT::Queue; +use RT::Record; + +@ISA= qw(RT::Record); + +use vars (@STATUS); + +@STATUS = qw(new open stalled resolved dead); + +=head2 StatusArray + +Returns an array of all statuses for this queue + +=cut + +sub StatusArray { + my $self = shift; + return (@STATUS); +} + + +=head2 IsValidStatus VALUE + +Returns true if VALUE is a valid status. Otherwise, returns 0 + +=for testing +my $q = new RT::Queue($RT::SystemUser); +ok($q->IsValidStatus('new')== 1, 'New is a valid status'); +ok($q->IsValidStatus('f00')== 0, 'f00 is not a valid status'); + +=cut + +sub IsValidStatus { + my $self = shift; + my $value = shift; + + my $retval = grep (/^$value$/, $self->StatusArray); + return ($retval); + +} + + + + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Queues"; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _Accessible + +sub _Accessible { + my $self = shift; + my %Cols = ( Name => 'read/write', + CorrespondAddress => 'read/write', + Description => 'read/write', + CommentAddress => 'read/write', + InitialPriority => 'read/write', + FinalPriority => 'read/write', + DefaultDueIn => 'read/write', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto', + Disabled => 'read/write', + + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} + +# }}} + +# {{{ sub Create + +=head2 Create + +Create takes the name of the new queue +If you pass the ACL check, it creates the queue and returns its queue id. + +=cut + +sub Create { + my $self = shift; + my %args = ( Name => undef, + CorrespondAddress => '', + Description => '', + CommentAddress => '', + InitialPriority => "0", + FinalPriority => "0", + DefaultDueIn => "0", + @_); + + unless ($self->CurrentUser->HasSystemRight('AdminQueue')) { #Check them ACLs + return (0, "No permission to create queues") + } + + unless ($self->ValidateName($args{'Name'})) { + return(0, 'Queue already exists'); + } + #TODO better input validation + + my $id = $self->SUPER::Create(%args); + unless ($id) { + return (0, 'Queue could not be created'); + } + + return ($id, "Queue $id created"); +} + +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + return (0, 'Deleting this object would break referential integrity'); +} + +# }}} + +# {{{ sub SetDisabled + +=head2 SetDisabled + +Takes a boolean. +1 will cause this queue to no longer be avaialble for tickets. +0 will re-enable this queue + +=cut + +# }}} + +# {{{ sub Load + +=head2 Load + +Takes either a numerical id or a textual Name and loads the specified queue. + +=cut + +sub Load { + 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); + + +} +# }}} + +# {{{ 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. + +=cut + +sub ValidateName { + my $self = shift; + my $name = shift; + + my $tempqueue = new RT::Queue($RT::SystemUser); + $tempqueue->Load($name); + + #If we couldn't load it :) + unless ($tempqueue->id()) { + return(1); + } + + #If this queue exists, return undef + #Avoid the ACL check. + if ($tempqueue->Name()){ + return(undef); + } + + #If the queue doesn't exist, return 1 + else { + return(1); + } + +} + + +# }}} + +# {{{ sub Templates + +=head2 Templates + +Returns an RT::Templates object of all of this queue's templates. + +=cut + +sub Templates { + my $self = shift; + + + my $templates = RT::Templates->new($self->CurrentUser); + + if ($self->CurrentUserHasRight('ShowTemplate')) { + $templates->LimitToQueue($self->id); + } + + return ($templates); +} + +# }}} + +# {{{ Dealing with watchers + +# {{{ sub Watchers + +=head2 Watchers + +Watchers returns a Watchers object preloaded with this queue\'s watchers. + +=cut + +sub Watchers { + my $self = shift; + + require RT::Watchers; + my $watchers =RT::Watchers->new($self->CurrentUser); + + if ($self->CurrentUserHasRight('SeeQueue')) { + $watchers->LimitToQueue($self->id); + } + + return($watchers); +} + +# }}} + +# {{{ sub WatchersAsString +=head2 WatchersAsString + +Returns a string of all queue watchers email addresses concatenated with ','s. + +=cut + +sub WatchersAsString { + my $self=shift; + return($self->Watchers->EmailsAsString()); +} + +# }}} + +# {{{ sub AdminCcAsString + +=head2 AdminCcAsString + +Takes nothing. returns a string: All Ticket/Queue AdminCcs. + +=cut + + +sub AdminCcAsString { + my $self=shift; + + return($self->AdminCc->EmailsAsString()); + } + +# }}} + +# {{{ sub CcAsString + +=head2 CcAsString + +B<Returns> String: All Queue Ccs as a comma delimited set of email addresses. + +=cut + +sub CcAsString { + my $self=shift; + + return ($self->Cc->EmailsAsString()); +} + +# }}} + +# {{{ sub Cc + +=head2 Cc + +Takes nothing. +Returns a watchers object which contains this queue\'s Cc watchers + +=cut + +sub Cc { + my $self = shift; + my $cc = $self->Watchers(); + if ($self->CurrentUserHasRight('SeeQueue')) { + $cc->LimitToCc(); + } + return ($cc); +} + +# A helper function for Cc, so that we can call it from the ACL checks +# without going through acl checks. + +sub _Cc { + my $self = shift; + my $cc = $self->Watchers(); + $cc->LimitToCc(); + return($cc); + +} + +# }}} + +# {{{ sub AdminCc + +=head2 AdminCc + +Takes nothing. +Returns this queue's administrative Ccs as an RT::Watchers object + +=cut + +sub AdminCc { + my $self = shift; + my $admin_cc = $self->Watchers(); + if ($self->CurrentUserHasRight('SeeQueue')) { + $admin_cc->LimitToAdminCc(); + } + return($admin_cc); +} + +#helper function for AdminCc so we can call it without ACLs +sub _AdminCc { + my $self = shift; + my $admin_cc = $self->Watchers(); + $admin_cc->LimitToAdminCc(); + return($admin_cc); +} + +# }}} + +# {{{ IsWatcher, IsCc, IsAdminCc + +# {{{ sub IsWatcher + +# a generic routine to be called by IsRequestor, IsCc and IsAdminCc + +=head2 IsWatcher + +Takes a param hash with the attributes Type and User. User is either a user object or string containing an email address. Returns true if that user or string +is a queue watcher. Returns undef otherwise + +=cut + +sub IsWatcher { + my $self = shift; + + my %args = ( Type => 'Requestor', + Id => undef, + Email => undef, + @_ + ); + #ACL check - can't do it. we need this method for ACL checks + # unless ($self->CurrentUserHasRight('SeeQueue')) { + # return(undef); + # } + + + my %cols = ('Type' => $args{'Type'}, + 'Scope' => 'Queue', + 'Value' => $self->Id + ); + if (defined ($args{'Id'})) { + if (ref($args{'Id'})){ #If it's a ref, assume it's an RT::User object; + #Dangerous but ok for now + $cols{'Owner'} = $args{'Id'}->Id; + } + elsif ($args{'Id'} =~ /^\d+$/) { # if it's an integer, it's an RT::User obj + $cols{'Owner'} = $args{'Id'}; + } + else { + $cols{'Email'} = $args{'Id'}; + } + } + + if (defined $args{'Email'}) { + $cols{'Email'} = $args{'Email'}; + } + + my ($description); + $description = join(":",%cols); + + #If we've cached a positive match... + if (defined $self->{'watchers_cache'}->{"$description"}) { + if ($self->{'watchers_cache'}->{"$description"} == 1) { + return(1); + } + #If we've cached a negative match... + else { + return(undef); + } + } + + require RT::Watcher; + my $watcher = new RT::Watcher($self->CurrentUser); + $watcher->LoadByCols(%cols); + + + if ($watcher->id) { + $self->{'watchers_cache'}->{"$description"} = 1; + return(1); + } + else { + $self->{'watchers_cache'}->{"$description"} = 0; + return(undef); + } + +} + +# }}} + +# {{{ sub IsCc + +=head2 IsCc + +Takes a string. Returns true if the string is a Cc watcher of the current queue + +=item Bugs + +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 Bugs + +Should also be able to handle an RT::User object + +=cut + +sub IsAdminCc { + my $self = shift; + my $admincc = shift; + + return ($self->IsWatcher( Type => 'AdminCc', Id => $admincc )); + +} + +# }}} + +# }}} + +# {{{ sub AddWatcher + +=head2 AddWatcher + +Takes a paramhash of Email, Owner and Type. Type is one of 'Cc' or 'AdminCc', +We need either an Email Address in Email or a userid in Owner + +=cut + +sub AddWatcher { + my $self = shift; + my %args = ( Email => undef, + Type => undef, + Owner => 0, + @_ + ); + + # {{{ Check ACLS + #If the watcher we're trying to add is for the current user + if ( ( ( defined $args{'Email'}) && + ( $args{'Email'} eq $self->CurrentUser->EmailAddress) ) or + ($args{'Owner'} eq $self->CurrentUser->Id)) { + + # If it's an AdminCc and they don't have + # 'WatchAsAdminCc' or 'ModifyQueueWatchers', bail + if ($args{'Type'} eq 'AdminCc') { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers') or + $self->CurrentUserHasRight('WatchAsAdminCc')) { + return(0, 'Permission Denied'); + } + } + + # If it's a Requestor or Cc and they don't have + # 'Watch' or 'ModifyQueueWatchers', bail + elsif ($args{'Type'} eq 'Cc') { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers') or + $self->CurrentUserHasRight('Watch')) { + return(0, 'Permission Denied'); + } + } + else { + $RT::Logger->warn("$self -> AddWatcher hit code". + " it never should. We got passed ". + " a type of ". $args{'Type'}); + return (0,'Error in parameters to $self AddWatcher'); + } + } + # If the watcher isn't the current user + # and the current user doesn't have 'ModifyQueueWatchers' + # bail + else { + unless ($self->CurrentUserHasRight('ModifyQueueWatchers')) { + return (0, "Permission Denied"); + } + } + # }}} + + require RT::Watcher; + my $Watcher = new RT::Watcher ($self->CurrentUser); + return ($Watcher->Create(Scope => 'Queue', + Value => $self->Id, + Email => $args{'Email'}, + Type => $args{'Type'}, + Owner => $args{'Owner'} + )); +} + +# }}} + +# {{{ sub AddCc + +=head2 AddCc + +Add a Cc to this queue. +Takes a paramhash of Email and Owner. +We need either an Email Address in Email or a userid in Owner + +=cut + + +sub AddCc { + my $self = shift; + return ($self->AddWatcher( Type => 'Cc', @_)); +} +# }}} + +# {{{ sub AddAdminCc + +=head2 AddAdminCc + +Add an Administrative Cc to this queue. +Takes a paramhash of Email and Owner. +We need either an Email Address in Email or a userid in Owner + +=cut + +sub AddAdminCc { + my $self = shift; + return ($self->AddWatcher( Type => 'AdminCc', @_)); +} +# }}} + +# {{{ sub DeleteWatcher + +=head2 DeleteWatcher id [type] + +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. + + +=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 + +=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')) +} + +# }}} + + +# }}} + +# }}} + +# {{{ 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 + +=head2 KeywordSelect([NAME]) + +Takes the name of a keyword select for this queue or that's global. +Returns the relevant KeywordSelect object. Prefers a keywordselect that's +specific to this queue over a global one. If it can't find the proper +Keword select or the user doesn't have permission, returns an empty +KeywordSelect object + +=cut + +sub KeywordSelect { + my $self = shift; + my $name = shift; + + require RT::KeywordSelect; + + my $select = RT::KeywordSelect->new($self->CurrentUser); + if ($self->CurrentUserHasRight('SeeQueue')) { + $select->LoadByName( Name => $name, Queue => $self->Id); + } + return ($select); +} + + +# }}} + +# {{{ sub KeywordSelects + +=head2 KeywordSelects + +Returns an B<RT::KeywordSelects> object containing the collection of +B<RT::KeywordSelect> objects which apply to this queue. (Both queue specific keyword selects +and global keyword selects. + +=cut + +sub KeywordSelects { + my $self = shift; + + + use RT::KeywordSelects; + my $KeywordSelects = new RT::KeywordSelects($self->CurrentUser); + + if ($self->CurrentUserHasRight('SeeQueue')) { + $KeywordSelects->LimitToQueue($self->id); + $KeywordSelects->IncludeGlobals(); + } + return ($KeywordSelects); +} +# }}} + +# }}} + +# {{{ ACCESS CONTROL + +# {{{ sub ACL + +=head2 ACL + +#Returns an RT::ACL object of ACEs everyone who has anything to do with this queue. + +=cut + +sub ACL { + my $self = shift; + + use RT::ACL; + my $acl = new RT::ACL($self->CurrentUser); + + if ($self->CurrentUserHasRight('ShowACL')) { + $acl->LimitToQueue($self->Id); + } + + return ($acl); +} + +# }}} + +# {{{ sub _Set +sub _Set { + my $self = shift; + + unless ($self->CurrentUserHasRight('AdminQueue')) { + return(0, 'Permission Denied'); + } + return ($self->SUPER::_Set(@_)); +} +# }}} + +# {{{ sub _Value + +sub _Value { + my $self = shift; + + unless ($self->CurrentUserHasRight('SeeQueue')) { + return (undef); + } + + return ($self->__Value(@_)); +} + +# }}} + +# {{{ sub CurrentUserHasRight + +=head2 CurrentUserHasRight + +Takes one argument. A textual string with the name of the right we want to check. +Returns true if the current user has that right for this queue. +Returns undef otherwise. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return ($self->HasRight( Principal=> $self->CurrentUser, + Right => "$right")); + +} + +# }}} + +# {{{ sub HasRight + +=head2 HasRight + +Takes a param hash with the fields 'Right' and 'Principal'. +Principal defaults to the current user. +Returns true if the principal has that right for this queue. +Returns undef otherwise. + +=cut + +# TAKES: Right and optional "Principal" which defaults to the current user +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => $self->CurrentUser, + @_); + unless(defined $args{'Principal'}) { + $RT::Logger->debug("Principal undefined in Queue::HasRight"); + + } + return($args{'Principal'}->HasQueueRight(QueueObj => $self, + Right => $args{'Right'})); +} +# }}} + +# }}} + +1; diff --git a/rt/lib/RT/Queues.pm b/rt/lib/RT/Queues.pm new file mode 100755 index 000000000..ab58d8d6d --- /dev/null +++ b/rt/lib/RT/Queues.pm @@ -0,0 +1,123 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Queues.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Queues - a collection of RT::Queue objects + +=head1 SYNOPSIS + + 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); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Queues"; + $self->{'primary_key'} = "id"; + + # By default, order by name + $self->OrderBy( ALIAS => 'main', + FIELD => 'Name', + ORDER => 'ASC'); + + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ 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 Limit +sub Limit { + my $self = shift; + my %args = ( ENTRYAGGREGATOR => 'AND', + @_); + $self->SUPER::Limit(%args); +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + my $item; + + use RT::Queue; + $item = new RT::Queue($self->CurrentUser); + return($item); +} +# }}} + +# {{{ sub Next + +=head2 Next + +Returns the next queue that this user can see. + +=cut + +sub Next { + my $self = shift; + + + my $Queue = $self->SUPER::Next(); + if ((defined($Queue)) and (ref($Queue))) { + + if ($Queue->CurrentUserHasRight('SeeQueue')) { + return($Queue); + } + + #If the user doesn't have the right to show this queue + else { + return($self->Next()); + } + } + #if there never was any queue + else { + return(undef); + } + +} +# }}} + +1; + diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm new file mode 100755 index 000000000..5340f7de4 --- /dev/null +++ b/rt/lib/RT/Record.pm @@ -0,0 +1,345 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Record.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Record - Base class for RT record objects + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=begin testing + +ok (require RT::Record); + +=end testing + +=head1 METHODS + +=cut + + +package RT::Record; +use DBIx::SearchBuilder::Record::Cachable; +use RT::Date; +use RT::User; + +@ISA= qw(DBIx::SearchBuilder::Record::Cachable); + +# {{{ sub _Init + +sub _Init { + my $self = shift; + $self->_MyCurrentUser(@_); + +} + +# }}} + +# {{{ _PrimaryKeys + +=head2 _PrimaryKeys + +The primary keys for RT classes is 'id' + +=cut + +sub _PrimaryKeys { + my $self = shift; + return(['id']); +} + +# }}} + +# {{{ sub _MyCurrentUser + +sub _MyCurrentUser { + 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); + } +} + +# }}} + +# {{{ 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); + } + + return($id); + +} + +# }}} + + +# {{{ sub LoadByCols + +=head2 LoadByCols + +Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the +DB is case sensitive + +=cut + +sub LoadByCols { + my $self = shift; + my %hash = (@_); + + # 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); + } +} + +# }}} + + +# {{{ Datehandling + +# There is room for optimizations in most of those subs: + +# {{{ LastUpdatedObj + +sub LastUpdatedObj { + my $self=shift; + my $obj = new RT::Date($self->CurrentUser); + + $obj->Set(Format => 'sql', Value => $self->LastUpdated); + return $obj; +} + +# }}} + +# {{{ CreatedObj + +sub CreatedObj { + my $self=shift; + my $obj = new RT::Date($self->CurrentUser); + + $obj->Set(Format => 'sql', Value => $self->Created); + + + return $obj; +} + +# }}} + +# {{{ AgeAsString +# +# TODO: This should be deprecated +# +sub AgeAsString { + my $self=shift; + return($self->CreatedObj->AgeAsString()); +} +# }}} + +# {{{ LastUpdatedAsString + +# TODO this should be deprecated + +sub LastUpdatedAsString { + my $self=shift; + if ($self->LastUpdated) { + return ($self->LastUpdatedObj->AsString()); + + } else { + return "never"; + } +} + +# }}} + +# {{{ CreatedAsString +# +# TODO This should be deprecated +# +sub CreatedAsString { + my $self = shift; + return ($self->CreatedObj->AsString()); +} +# }}} + +# {{{ LongSinceUpdateAsString +# +# TODO This should be deprecated +# +sub LongSinceUpdateAsString { + my $self=shift; + if ($self->LastUpdated) { + + return ($self->LastUpdatedObj->AgeAsString()); + + } else { + return "never"; + } +} +# }}} + +# }}} Datehandling + + +# {{{ sub _Set +sub _Set { + my $self = shift; + + my %args = ( Field => undef, + Value => undef, + IsSQL => undef, + @_ ); + + + #if the user is trying to modify the record + if ((!defined ($args{'Field'})) || (!defined ($args{'Value'}))) { + $args{'Value'} = 0; + } + + $self->_SetLastUpdated(); + $self->SUPER::_Set(Field => $args{'Field'}, + Value => $args{'Value'}, + IsSQL => $args{'IsSQL'}); + + +} +# }}} + +# {{{ sub _SetLastUpdated + +=head2 _SetLastUpdated + +This routine updates the LastUpdated and LastUpdatedBy columns of the row in question +It takes no options. Arguably, this is a bug + +=cut + +sub _SetLastUpdated { + my $self = shift; + use RT::Date; + 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('LastUpdatedBy','auto')) { + my ($msg, $val) = $self->__Set( Field => 'LastUpdatedBy', + Value => $self->CurrentUser->id); + } +} + +# }}} + +# {{{ sub CreatorObj + +=head2 CreatorObj + +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 LastUpdatedByObj + +=head2 LastUpdatedByObj + + Returns an RT::User object of the last user to touch this object + +=cut + +sub LastUpdatedByObj { + 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 + +If called with an argument, sets the current user to that user object. +This will affect ACL decisions, etc. +Returns the current user + +=cut + +sub CurrentUser { + my $self = shift; + + if (@_) { + $self->{'user'} = shift; + } + return ($self->{'user'}); +} +# }}} + + +1; diff --git a/rt/lib/RT/Scrip.pm b/rt/lib/RT/Scrip.pm new file mode 100755 index 000000000..aef011ca3 --- /dev/null +++ b/rt/lib/RT/Scrip.pm @@ -0,0 +1,372 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Scrip.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Scrip - an RT Scrip object + +=head1 SYNOPSIS + + use RT::Scrip; + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Scrip); + +=end testing + +=cut + +package RT::Scrip; +use RT::Record; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Scrips"; + return ($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 + +Returns (retval, msg); +retval is 0 for failure or scrip id. msg is a textual description of what happened. + +=cut + +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'); +} + +# }}} + +# {{{ sub Delete + +=head2 Delete + +Delete this object + +=cut + +sub Delete { + my $self = shift; + + unless ($self->CurrentUserHasRight('ModifyScrips')) { + return (0, 'Permission Denied'); + } + + return ($self->SUPER::Delete(@_)); +} +# }}} + +# {{{ sub QueueObj + +=head2 QueueObj + +Retuns an RT::Queue object with this Scrip\'s queue + +=cut + +sub QueueObj { + my $self = shift; + + if (!$self->{'QueueObj'}) { + require RT::Queue; + $self->{'QueueObj'} = RT::Queue->new($self->CurrentUser); + $self->{'QueueObj'}->Load($self->Queue); + } + return ($self->{'QueueObj'}); +} + +# }}} + +# {{{ sub ActionObj + + +=head2 ActionObj + +Retuns an RT::Action object with this Scrip\'s Action + +=cut + +sub ActionObj { + my $self = shift; + + unless (defined $self->{'ScripActionObj'}) { + require RT::ScripAction; + + $self->{'ScripActionObj'} = RT::ScripAction->new($self->CurrentUser); + #TODO: why are we loading Actions with templates like this. + # two seperate methods might make more sense + $self->{'ScripActionObj'}->Load($self->ScripAction, $self->Template); + } + return ($self->{'ScripActionObj'}); +} + +# }}} + + +# {{{ sub TemplateObj +=head2 TemplateObj + +Retuns an RT::Template object with this Scrip\'s Template + +=cut + +sub TemplateObj { + my $self = shift; + + unless (defined $self->{'TemplateObj'}) { + require RT::Template; + $self->{'TemplateObj'} = RT::Template->new($self->CurrentUser); + $self->{'TemplateObj'}->Load($self->Template); + } + return ($self->{'TemplateObj'}); +} + +# }}} + +# {{{ sub Prepare +=head2 Prepare + +Calls the action object's prepare method + +=cut + +sub Prepare { + my $self = shift; + $self->ActionObj->Prepare(@_); +} + +# }}} + +# {{{ sub Commit +=head2 Commit + +Calls the action object's commit method + +=cut + +sub Commit { + my $self = shift; + $self->ActionObj->Commit(@_); +} + +# }}} + +# {{{ sub ConditionObj + +=head2 ConditionObj + +Retuns an RT::ScripCondition object with this Scrip's IsApplicable + +=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'}); +} + +# }}} + +# {{{ sub IsApplicable + +=head2 IsApplicable + +Calls the Condition object\'s IsApplicable method + +=cut + +sub IsApplicable { + my $self = shift; + return ($self->ConditionObj->IsApplicable(@_)); +} + +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self = shift; + $self->{'ActionObj'} = undef; +} +# }}} + +# {{{ 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(@_); +} + +# }}} + +# {{{ 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(@_); +} +# }}} + +# {{{ 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 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'}) ); + } +} +# }}} + +# }}} + +1; + + diff --git a/rt/lib/RT/ScripAction.pm b/rt/lib/RT/ScripAction.pm new file mode 100755 index 000000000..471ad9191 --- /dev/null +++ b/rt/lib/RT/ScripAction.pm @@ -0,0 +1,200 @@ +# Copyright 1999-2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripAction.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::ScripAction - RT Action object + +=head1 SYNOPSIS + + use RT::ScripAction; + + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in other modules. + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ScripAction); + +=end testing + +=head1 METHODS + +=cut + +package RT::ScripAction; +use RT::Record; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ScripActions"; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + 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)); +} +# }}} + +# {{{ sub Create +=head2 Create + + Takes a hash. Creates a new Action entry. + should be better documented. +=cut + +sub Create { + my $self = shift; + #TODO check these args and do smart things. + return($self->SUPER::Create(@_)); +} +# }}} + +# {{{ sub Delete +sub Delete { + my $self = shift; + + return (0, "ScripAction->Delete not implemented"); +} +# }}} + +# {{{ sub Load +sub Load { + my $self = shift; + my $identifier = shift; + + if (!$identifier) { + return (0, 'Input error'); + } + + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol('Name', $identifier); + + } + + if (@_) { + # Set the template Id to the passed in template + my $template = shift; + + $self->{'Template'} = $template; + } + return ($self->Id, 'ScripAction loaded'); +} +# }}} + +# {{{ sub LoadAction + +=head2 LoadAction HASH + + Takes a hash consisting of TicketObj and TransactionObj. Loads an RT::Action:: module. + +=cut + +sub LoadAction { + my $self = shift; + my %args = ( TransactionObj => undef, + TicketObj => undef, + @_ ); + + #TODO: Put this in an eval + $self->ExecModule =~ /^(\w+)$/; + my $module = $1; + my $type = "RT::Action::". $module; + + $RT::Logger->debug("now requiring $type\n"); + eval "require $type" || die "Require of $type failed.\n$@\n"; + + $self->{'Action'} = $type->new ( 'ScripActionObj' => $self, + 'TicketObj' => $args{'TicketObj'}, + 'TransactionObj' => $args{'TransactionObj'}, + 'TemplateObj' => $self->TemplateObj, + 'Argument' => $self->Argument, + ); +} +# }}} + +# {{{ sub TemplateObj + +=head2 TemplateObj + +Return this action\'s template object + +=cut + +sub TemplateObj { + my $self = shift; + return undef unless $self->{Template}; + if (!$self->{'TemplateObj'}) { + require RT::Template; + $self->{'TemplateObj'} = RT::Template->new($self->CurrentUser); + $self->{'TemplateObj'}->LoadById($self->{'Template'}); + + } + + return ($self->{'TemplateObj'}); +} +# }}} + +# The following methods call the action object + +# {{{ sub Prepare + +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()); + +} +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self=shift; + $self->{'Action'} = undef; + $self->{'TemplateObj'} = undef; +} +# }}} + + +1; + + diff --git a/rt/lib/RT/ScripActions.pm b/rt/lib/RT/ScripActions.pm new file mode 100755 index 000000000..ec6141559 --- /dev/null +++ b/rt/lib/RT/ScripActions.pm @@ -0,0 +1,70 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripActions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::ScripActions - Collection of Action objects + +=head1 SYNOPSIS + + 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::ScripAction; + +@ISA= qw(RT::EasySearch); + +# {{{ 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 NewItem +sub NewItem { + my $self = shift; + return(RT::ScripAction->new($self->CurrentUser)); + +} +# }}} + + +1; + diff --git a/rt/lib/RT/ScripCondition.pm b/rt/lib/RT/ScripCondition.pm new file mode 100755 index 000000000..253502bd4 --- /dev/null +++ b/rt/lib/RT/ScripCondition.pm @@ -0,0 +1,192 @@ +# Copyright 1999-2000 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripCondition.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::ScripCondition - RT scrip conditional + +=head1 SYNOPSIS + + use RT::ScripCondition; + + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in other modules. + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::ScripCondition); + +=end testing + +=head1 METHODS + +=cut + +package RT::ScripCondition; +use RT::Record; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "ScripConditions"; + return ($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub _Accessible +sub _Accessible { + 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)); +} +# }}} + +# {{{ sub Create + +=head2 Create + + Takes a hash. Creates a new Condition entry. + should be better documented. + +=cut + +sub Create { + my $self = shift; + return($self->SUPER::Create(@_)); +} +# }}} + +# {{{ sub Delete + +=head2 Delete + +No API available for deleting things just yet. + +=cut + +sub Delete { + my $self = shift; + return(0,'Unimplemented'); +} +# }}} + +# {{{ sub Load + +=head2 Load IDENTIFIER + +Loads a condition takes a name or ScripCondition id. + +=cut + +sub Load { + my $self = shift; + my $identifier = shift; + + unless (defined $identifier) { + return (undef); + } + + if ($identifier !~ /\D/) { + return ($self->SUPER::LoadById($identifier)); + } + else { + return ($self->LoadByCol('Name', $identifier)); + } +} +# }}} + +# {{{ sub LoadCondition + +=head2 LoadCondition HASH + +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, + ); +} +# }}} + +# {{{ The following methods call the Condition object + + +# {{{ sub Describe + +=head2 Describe + +Helper method to call the condition module\'s Describe method. + +=cut + +sub Describe { + my $self = shift; + return ($self->{'Condition'}->Describe()); + +} +# }}} + +# {{{ sub IsApplicable + +=head2 IsApplicable + +Helper method to call the condition module\'s IsApplicable method. + +=cut + +sub IsApplicable { + my $self = shift; + return ($self->{'Condition'}->IsApplicable()); + +} +# }}} + +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self=shift; + $self->{'Condition'} = undef; +} +# }}} + + +1; + + diff --git a/rt/lib/RT/ScripConditions.pm b/rt/lib/RT/ScripConditions.pm new file mode 100755 index 000000000..236e6718d --- /dev/null +++ b/rt/lib/RT/ScripConditions.pm @@ -0,0 +1,69 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/ScripConditions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::ScripConditions - Collection of Action objects + +=head1 SYNOPSIS + + 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::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'); + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + return(RT::ScripCondition->new($self->CurrentUser)); +} +# }}} + + +1; + diff --git a/rt/lib/RT/Scrips.pm b/rt/lib/RT/Scrips.pm new file mode 100755 index 000000000..90be847d8 --- /dev/null +++ b/rt/lib/RT/Scrips.pm @@ -0,0 +1,127 @@ +# Copyright 1999-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Scrips.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Scrips - a collection of RT Scrip objects + +=head1 SYNOPSIS + + use RT::Scrips; + +=head1 DESCRIPTION + + +=head1 METHODS + + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Scrips); + +=end testing + +=cut + +package RT::Scrips; +use RT::EasySearch; +use RT::Scrip; +@ISA= qw(RT::EasySearch); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Scrips"; + $self->{'primary_key'} = "id"; + return ( $self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub LimitToQueue + +=head2 LimitToQueue + +Takes a queue id (numerical) as its only argument. Makes sure that +Scopes it pulls out apply to this queue (or another that you've selected with +another call to this method + +=cut + +sub LimitToQueue { + my $self = shift; + my $queue = shift; + + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Queue', + VALUE => "$queue") + if defined $queue; + +} +# }}} + +# {{{ sub LimitToGlobal + +=head2 LimitToGlobal + +Makes sure that +Scopes it pulls out apply to all queues (or another that you've selected with +another call to this method or LimitToQueue + +=cut + + +sub LimitToGlobal { + my $self = shift; + + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Queue', + VALUE => 0); + +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + + return(new RT::Scrip($self->CurrentUser)); +} +# }}} + +# {{{ sub Next + +=head2 Next + +Returns the next scrip that this user can see. + +=cut + +sub Next { + my $self = shift; + + + my $Scrip = $self->SUPER::Next(); + if ((defined($Scrip)) and (ref($Scrip))) { + + if ($Scrip->CurrentUserHasRight('ShowScrips')) { + return($Scrip); + } + + #If the user doesn't have the right to show this scrip + else { + return($self->Next()); + } + } + #if there never was any scrip + else { + return(undef); + } + +} +# }}} + +1; + diff --git a/rt/lib/RT/Template.pm b/rt/lib/RT/Template.pm new file mode 100755 index 000000000..3ef96c7df --- /dev/null +++ b/rt/lib/RT/Template.pm @@ -0,0 +1,395 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Template.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1996-2002 Jesse Vincent <jesse@bestpractical.com> +# Portions Copyright 2000 Tobias Brox <tobix@cpan.org> +# Released under the terms of the GNU General Public License + +=head1 NAME + + RT::Template - RT's template object + +=head1 SYNOPSIS + + use RT::Template; + + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Template); + +=end testing + +=cut + +package RT::Template; +use RT::Record; +use MIME::Entity; +use MIME::Parser; + +@ISA = qw(RT::Record); + +# {{{ sub _Init + +sub _Init { + my $self = shift; + $self->{'table'} = "Templates"; + return ( $self->SUPER::_Init(@_) ); +} + +# }}} + +# {{{ 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 ); +} + +# }}} + +# {{{ sub _Set + +sub _Set { + my $self = shift; + + # use super::value or we get acl blocked + if ( ( defined $self->SUPER::_Value('Queue') ) + && ( $self->SUPER::_Value('Queue') == 0 ) ) + { + unless ( $self->CurrentUser->HasSystemRight('ModifyTemplate') ) { + return ( 0, 'Permission Denied' ); + } + } + else { + + unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) { + return ( 0, 'Permission Denied' ); + } + } + return ( $self->SUPER::_Set(@_) ); + +} + +# }}} + +# {{{ 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 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) ); + +} + +# }}} + +# {{{ sub Load + +=head2 Load <identifer> + +Load a template, either by number or by name + +=cut + +sub Load { + my $self = shift; + my $identifier = shift; + + if ( !$identifier ) { + return (undef); + } + + if ( $identifier !~ /\D/ ) { + $self->SUPER::LoadById($identifier); + } + else { + $self->LoadByCol( 'Name', $identifier ); + + } +} + +# }}} + +# {{{ sub LoadGlobalTemplate + +=head2 LoadGlobalTemplate NAME + +Load the global tempalte with the name NAME + +=cut + +sub LoadGlobalTemplate { + my $self = shift; + my $id = shift; + + return ( $self->LoadQueueTemplate( Queue => 0, Name => $id ) ); +} + +# }}} + +# {{{ sub LoadQueueTemplate + +=head2 LoadQueueTemplate (Queue => QUEUEID, Name => NAME) + +Loads the Queue template named NAME for Queue QUEUE. + +=cut + +sub LoadQueueTemplate { + my $self = shift; + my %args = ( + Queue => undef, + Name => undef + ); + + return ( $self->LoadByCols( Name => $args{'Name'}, Queue => {'Queue'} ) ); + +} + +# }}} + +# {{{ sub Create + +=head2 Create + +Takes a paramhash of Content, Queue, Name and Description. +Name should be a unique string identifying this Template. +Description and Content should be the template's title and content. +Queue should be 0 for a global template and the queue # for a queue-specific +template. + +Returns the Template's id # if the create was successful. Returns undef for +unknown database failure. + + +=cut + +sub Create { + my $self = shift; + my %args = ( + Content => undef, + Queue => 0, + Description => '[no description]', + Type => 'Action', #By default, template are 'Action' templates + Name => undef, + @_ + ); + + if ( $args{'Queue'} == 0 ) { + unless ( $self->CurrentUser->HasSystemRight('ModifyTemplate') ) { + return (undef); + } + } + else { + my $QueueObj = new RT::Queue( $self->CurrentUser ); + $QueueObj->Load( $args{'Queue'} ) || return ( 0, 'Invalid queue' ); + + unless ( $QueueObj->CurrentUserHasRight('ModifyTemplate') ) { + return (undef); + } + } + + my $result = $self->SUPER::Create( + Content => $args{'Content'}, + Queue => $args{'Queue'}, + , + Description => $args{'Description'}, + Name => $args{'Name'} + ); + + return ($result); + +} + +# }}} + +# {{{ sub Delete + +=head2 Delete + +Delete this template. + +=cut + +sub Delete { + my $self = shift; + + unless ( $self->CurrentUserHasRight('ModifyTemplate') ) { + return ( 0, 'Permission Denied' ); + } + + return ( $self->SUPER::Delete(@_) ); +} + +# }}} + +# {{{ sub MIMEObj +sub MIMEObj { + my $self = shift; + return ( $self->{'MIMEObj'} ); +} + +# }}} + +# {{{ sub Parse + +=item Parse + + This routine performs Text::Template parsing on thte template and then imports the + results into a MIME::Entity so we can really use it + It returns a tuple of (val, message) + If val is 0, the message contains an error message + +=cut + +sub Parse { + my $self = shift; + + #We're passing in whatever we were passed. it's destined for _ParseContent + my $content = $self->_ParseContent(@_); + + #Lets build our mime Entity + + my $parser = MIME::Parser->new(); + + # Do work on the parsed template in memory, rather than on disk + $parser->output_to_core(1); + + ### Should we forgive normally-fatal errors? + $parser->ignore_errors(1); + $self->{'MIMEObj'} = eval { $parser->parse_data($content) }; + $error = ( $@ || $parser->last_error ); + + if ($error) { + $RT::Logger->error("$error"); + return ( 0, $error ); + } + + # Unfold all headers + $self->{'MIMEObj'}->head->unfold(); + + return ( 1, "Template parsed" ); + + +} + +# }}} + +# {{{ sub _ParseContent + +# Perform Template substitutions on the template + +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); +} + +# }}} + +# {{{ sub QueueObj + +=head2 QueueObj + +Takes nothing. returns this ticket's queue object + +=cut + +sub QueueObj { + my $self = shift; + if ( !defined $self->{'queue'} ) { + require RT::Queue; + $self->{'queue'} = RT::Queue->new( $self->CurrentUser ); + + unless ( $self->{'queue'} ) { + $RT::Logger->crit( + "RT::Queue->new(" . $self->CurrentUser . ") returned false" ); + return (undef); + } + my ($result) = $self->{'queue'}->Load( $self->__Value('Queue') ); + + } + return ( $self->{'queue'} ); +} + +# }}} + +# {{{ sub CurrentUserHasQueueRight + +=head2 CurrentUserHasQueueRight + +Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args. + +=cut + +sub CurrentUserHasQueueRight { + my $self = shift; + return ( $self->QueueObj->CurrentUserHasRight(@_) ); +} + +# }}} +1; diff --git a/rt/lib/RT/Templates.pm b/rt/lib/RT/Templates.pm new file mode 100755 index 000000000..b5b483c96 --- /dev/null +++ b/rt/lib/RT/Templates.pm @@ -0,0 +1,122 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Templates.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Templates - a collection of RT Template objects + +=head1 SYNOPSIS + + 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); + + +# {{{ sub _Init + +=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(@_)); +} +# }}} + +# {{{ LimitToNotInQueue + +=head2 LimitToNotInQueue + +Takes a queue id # and limits the returned set of templates to those which +aren't that queue's templates. + +=cut + +sub LimitToNotInQueue { + my $self = shift; + my $queue_id = shift; + $self->Limit(FIELD => 'Queue', + VALUE => "$queue_id", + OPERATOR => '!=' + ); +} +# }}} + +# {{{ LimitToGlobal + +=head2 LimitToGlobal + +Takes no arguments. Limits the returned set to "Global" templates +which can be used with any queue. + +=cut + +sub LimitToGlobal { + my $self = shift; + my $queue_id = shift; + $self->Limit(FIELD => 'Queue', + VALUE => "0", + OPERATOR => '=' + ); +} +# }}} + +# {{{ LimitToQueue + +=head2 LimitToQueue + +Takes a queue id # and limits the returned set of templates to that queue's +templates + +=cut + +sub LimitToQueue { + my $self = shift; + my $queue_id = shift; + $self->Limit(FIELD => 'Queue', + VALUE => "$queue_id", + OPERATOR => '=' + ); +} +# }}} + +# {{{ sub NewItem + +=head2 NewItem + +Returns a new empty Template object + +=cut + +sub NewItem { + my $self = shift; + + use RT::Template; + my $item = new RT::Template($self->CurrentUser); + return($item); +} +# }}} + +1; + diff --git a/rt/lib/RT/TestHarness.pm b/rt/lib/RT/TestHarness.pm new file mode 100644 index 000000000..160e9e636 --- /dev/null +++ b/rt/lib/RT/TestHarness.pm @@ -0,0 +1,14 @@ +use lib "/opt/rt2/etc/"; + +use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect + GetCurrentUser GetMessageContent); + +#Clean out all the nasties from the environment +CleanEnv(); + +#Load etc/config.pm and drop privs +LoadConfig(); + + +use RT; +RT::Init; diff --git a/rt/lib/RT/Ticket.pm b/rt/lib/RT/Ticket.pm new file mode 100755 index 000000000..f7275e4e3 --- /dev/null +++ b/rt/lib/RT/Ticket.pm @@ -0,0 +1,3004 @@ +# $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 +# + +=head1 NAME + + RT::Ticket - RT ticket object + +=head1 SYNOPSIS + + use RT::Ticket; + my $ticket = new RT::Ticket($CurrentUser); + $ticket->Load($ticket_id); + +=head1 DESCRIPTION + +This module lets you manipulate RT\'s ticket object. + + +=head1 METHODS + +=cut + + + +package RT::Ticket; +use RT::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 + +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); + +} + +# }}} + +# {{{ sub LoadByURI + +=head2 LoadByURI + +Given a local ticket URI, loads the specified ticket. + +=cut + +sub LoadByURI { + my $self = shift; + my $uri = shift; + + if ($uri =~ /^$RT::TicketBaseURI(\d+)$/) { + my $id = $1; + return ($self->Load($id)); + } + else { + return(undef); + } +} + +# }}} + +# {{{ sub Create + +=head2 Create (ARGS) + +Arguments: ARGS is a hash of named parameters. Valid parameters are: + + Queue - Either a Queue object or a Queue Name + Requestor - A reference to a list of RT::User objects, email addresses or RT user Names + Cc - A reference to a list of RT::User objects, email addresses or Names + AdminCc - A reference to a list of RT::User objects, email addresses or Names + Type -- The ticket\'s type. ignore this for now + Owner -- This ticket\'s owner. either an RT::User object or this user\'s id + Subject -- A string describing the subject of the ticket + InitialPriority -- an integer from 0 to 99 + FinalPriority -- an integer from 0 to 99 + Status -- any valid status (Defined in RT::Queue) + TimeWorked -- an integer + TimeLeft -- an integer + Starts -- an ISO date describing the ticket\'s start date and time in GMT + Due -- an ISO date describing the ticket\'s due date and time in GMT + MIMEObj -- a MIME::Entity object with the content of the initial ticket request. + + KeywordSelect-<id> -- an array of keyword ids for that keyword select + + +Returns: TICKETID, Transaction Object, Error Message + + +=begin testing + +my $t = RT::Ticket->new($RT::SystemUser); + +ok( $t->Create(Queue => 'General', Subject => 'This is a subject'), "Ticket Created"); + +ok ( my $id = $t->Id, "Got ticket id"); + +=end testing + +=cut + +sub Create { + my $self = shift; + + my %args = ( + 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. + +Arguments are identical to Create(), with the addition of + Id - Ticket Id + +Returns: TICKETID + +=cut + + +sub Import { + my $self = shift; + my ( $ErrStr, $QueueObj, $Owner); + + my %args = (id => undef, + EffectiveId => undef, + Queue => undef, + Requestor => undef, + Type => 'ticket', + Owner => $RT::Nobody->Id, + Subject => '[no subject]', + InitialPriority => undef, + FinalPriority => undef, + Status => 'new', + TimeWorked => "0", + Due => undef, + Created => undef, + Updated => undef, + Resolved => undef, + Told => undef, + @_); + + if ( (defined($args{'Queue'})) && (!ref($args{'Queue'})) ) { + $QueueObj=RT::Queue->new($RT::SystemUser); + $QueueObj->Load($args{'Queue'}); + #TODO error check this and return 0 if it\'s not loading properly +++ + } + elsif (ref($args{'Queue'}) eq 'RT::Queue') { + $QueueObj=RT::Queue->new($RT::SystemUser); + $QueueObj->Load($args{'Queue'}->Id); + } + else { + $RT::Logger->debug("$self ". $args{'Queue'} . + " not a recognised queue object."); + } + + #Can't create a ticket without a queue. + unless (defined ($QueueObj) and $QueueObj->Id) { + $RT::Logger->debug( "$self No queue given for ticket creation."); + return (0,'Could not create ticket. Queue not set'); + } + + #Now that we have a queue, Check the ACLS + unless ($self->CurrentUser->HasQueueRight(Right => 'CreateTicket', + QueueObj => $QueueObj )) { + return (0,"No permission to create tickets in the queue '". + $QueueObj->Name."'."); + } + + + + + # {{{ Deal with setting the owner + + # Attempt to take user object, user name or user id. + # Assign to nobody if lookup fails. + if (defined ($args{'Owner'})) { + if ( ref($args{'Owner'}) ) { + $Owner = $args{'Owner'}; + } + else { + $Owner = new RT::User($self->CurrentUser); + $Owner->Load($args{'Owner'}); + if ( ! defined($Owner->id) ) { + $Owner->Load($RT::Nobody->id); + } + } + } + + + #If we have a proposed owner and they don't have the right + #to own a ticket, scream about it and make them not the owner + if ((defined ($Owner)) and + ($Owner->Id != $RT::Nobody->Id) and + (!$Owner->HasQueueRight( QueueObj => $QueueObj, + Right => 'OwnTicket'))) { + + $RT::Logger->warning("$self user ".$Owner->Name . "(".$Owner->id . + ") was proposed ". + "as a ticket owner but has no rights to own ". + "tickets in '".$QueueObj->Name."'\n"); + + $Owner = undef; + } + + #If we haven't been handed a valid owner, make it nobody. + unless (defined ($Owner)) { + $Owner = new RT::User($self->CurrentUser); + $Owner->Load($RT::Nobody->UserObj->Id); + } + + # }}} + + unless ($self->ValidateStatus($args{'Status'})) { + return (0,"'$args{'Status'}' is an invalid value for status"); + } + + $self->{'_AccessibleCache'}{Created} = { 'read'=>1, 'write'=>1 }; + $self->{'_AccessibleCache'}{Creator} = { 'read'=>1, 'auto'=>1 }; + $self->{'_AccessibleCache'}{LastUpdated} = { 'read'=>1, 'write'=>1 }; + $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read'=>1, 'auto'=>1 }; + + + # If we're coming in with an id, set that now. + my $EffectiveId = undef; + if ($args{'id'}) { + $EffectiveId = $args{'id'}; + + } + + + my $id = $self->SUPER::Create( + id => $args{'id'}, + EffectiveId => $EffectiveId, + Queue => $QueueObj->Id, + Owner => $Owner->Id, + Subject => $args{'Subject'}, + InitialPriority => $args{'InitialPriority'}, + FinalPriority => $args{'FinalPriority'}, + Priority => $args{'InitialPriority'}, + Status => $args{'Status'}, + TimeWorked => $args{'TimeWorked'}, + Type => $args{'Type'}, + Created => $args{'Created'}, + Told => $args{'Told'}, + LastUpdated => $args{'Updated'}, + Resolved => $args{Resolved}, + Due => $args{'Due'}, + ); + + + + # If the ticket didn't have an id + # Set the ticket's effective ID now that we've created it. + if ($args{'id'} ) { + $self->Load($args{'id'}); + } + else { + my ($val, $msg) = $self->__Set(Field => 'EffectiveId', Value => $id); + + unless ($val) { + $RT::Logger->err($self."->Import couldn't set EffectiveId: $msg\n"); + } + } + + my $watcher; + foreach $watcher (@{$args{'Cc'}}) { + $self->_AddWatcher( Type => 'Cc', Person => $watcher, Silent => 1); + } + foreach $watcher (@{$args{'AdminCc'}}) { + $self->_AddWatcher( Type => 'AdminCc', Person => $watcher, Silent => 1); + } + foreach $watcher (@{$args{'Requestor'}}) { + $self->_AddWatcher( Type => 'Requestor', Person => $watcher, Silent => 1); + } + + return($self->Id, $ErrStr); +} + +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + return (0, 'Deleting this object would violate referential integrity.'. + ' That\'s bad.'); +} +# }}} + +# {{{ 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 { + 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 + +Takes an email address. It calls DeleteWatcher with a preset +type of 'Requestor' + + +=cut + +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 + +Watchers returns a Watchers object preloaded with this ticket\'s watchers. + +# It should return only the ticket watchers. the actual FooAsString +# methods capture the queue watchers too. I don't feel thrilled about this, +# but we don't want the Cc Requestors and AdminCc objects to get filled up +# with all the queue watchers too. we've got seperate objects for that. + # should we rename these as s/(.*)AsString/$1Addresses/ or somesuch? + +=cut + +sub Watchers { + my $self = shift; + + require RT::Watchers; + my $watchers=RT::Watchers->new($self->CurrentUser); + if ($self->CurrentUserHasRight('ShowTicket')) { + $watchers->LimitToTicket($self->id); + } + + return($watchers); + +} + +# }}} + +# {{{ a set of [foo]AsString subs that will return the various sorts of watchers for a ticket/queue as a comma delineated string + +=head2 RequestorsAsString + + B<Returns> String: All Ticket Requestor email addresses as a string. + +=cut + +sub RequestorsAsString { + my $self=shift; + + unless ($self->CurrentUserHasRight('ShowTicket')) { + return undef; + } + + return ($self->Requestors->EmailsAsString() ); +} + +=head2 WatchersAsString + +B<Returns> String: All Ticket Watchers email addresses as a string + +=cut + +sub WatchersAsString { + my $self=shift; + + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (0, "Permission Denied"); + } + + return ($self->Watchers->EmailsAsString()); + +} + +=head2 AdminCcAsString + +returns String: All Ticket AdminCc email addresses as a string + +=cut + + +sub AdminCcAsString { + my $self=shift; + + unless ($self->CurrentUserHasRight('ShowTicket')) { + return undef; + } + + return ($self->AdminCc->EmailsAsString()); + +} + +=head2 CcAsString + +returns String: All Ticket Ccs as a string of email addresses + +=cut + +sub CcAsString { + my $self=shift; + + unless ($self->CurrentUserHasRight('ShowTicket')) { + return undef; + } + + return ($self->Cc->EmailsAsString()); + +} + +# }}} + +# {{{ Routines that return RT::Watchers objects of Requestors, Ccs and AdminCcs + +# {{{ sub Requestors + +=head2 Requestors + +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); +} + + +# }}} + +# }}} + +# {{{ 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; +} +# }}} + +# {{{ sub DueAsString + +=head2 DueAsString + +Returns this ticket's due date as a human readable string + +=cut + +sub DueAsString { + my $self = shift; + return $self->DueObj->AsString(); +} + +# }}} + +# {{{ sub GraceTimeAsString + +=head2 GraceTimeAsString + +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 ""; + } +} + +# }}} + + +# {{{ sub ResolvedObj + +=head2 ResolvedObj + + 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; +} +# }}} + +# {{{ sub SetStarted + +=head2 SetStarted + +Takes a date in ISO format or undef +Returns a transaction id and a message +The client calls "Start" to note that the project was started on the date in $date. +A null date means "now" + +=cut + +sub SetStarted { + my $self = shift; + my $time = shift || 0; + + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + #We create a date object to catch date weirdness + my $time_obj = new RT::Date($self->CurrentUser()); + if ($time != 0) { + $time_obj->Set(Format => 'ISO', Value => $time); + } + else { + $time_obj->SetToNow(); + } + + #Now that we're starting, open this ticket + #TODO do we really want to force this as policy? it should be a scrip + + #We need $TicketAsSystem, in case the current user doesn't have + #ShowTicket + # + my $TicketAsSystem = new RT::Ticket($RT::SystemUser); + $TicketAsSystem->Load($self->Id); + if ($TicketAsSystem->Status eq 'new') { + $TicketAsSystem->Open(); + } + + return ($self->_Set(Field => 'Started', Value =>$time_obj->ISO)); + +} + +# }}} + +# {{{ sub StartedObj + +=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; +} +# }}} + +# {{{ sub StartsObj + +=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; +} +# }}} + +# {{{ sub ToldObj + +=head2 ToldObj + + 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; +} + +# }}} + +# {{{ sub LongSinceToldAsString + +# TODO this should be deprecated + + +sub LongSinceToldAsString { + my $self = shift; + + if ($self->Told) { + return $self->ToldObj->AgeAsString(); + } else { + return "Never"; + } +} +# }}} + +# {{{ sub ToldAsString + +=head2 ToldAsString + +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 + +=head2 TimeWorkedAsString + +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)); +} + +# }}} + + +# }}} + +# {{{ 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 + +=head2 Correspond + +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"); +} + +# }}} + +# }}} + +# {{{ Routines dealing with Links and Relations between tickets + +# {{{ Link Collections + +# {{{ sub Members + +=head2 Members + + This returns an RT::Links object which references all the tickets +which are 'MembersOf' this ticket + +=cut + +sub Members { + my $self = shift; + return ($self->_Links('Target', 'MemberOf')); +} + +# }}} + +# {{{ sub MemberOf + +=head2 MemberOf + + 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')); +} + +# }}} + +# {{{ RefersTo + +=head2 RefersTo + + This returns an RT::Links object which shows all references for which this ticket is a base + +=cut + +sub RefersTo { + my $self = shift; + return ($self->_Links('Base', 'RefersTo')); +} + +# }}} + +# {{{ ReferredToBy + +=head2 ReferredToBy + + 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')); +} + +# }}} + +# {{{ DependedOnBy + +=head2 DependedOnBy + + This returns an RT::Links object which references all the tickets that depend on this one + +=cut +sub DependedOnBy { + my $self = shift; + return ($self->_Links('Target','DependsOn')); +} + +# }}} + +# {{{ 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 + +=head2 DeleteLink + +Delete a link. takes a paramhash of Base, Target and Type. +Either Base or Target must be null. The null value will +be replaced with this ticket\'s id + +=cut + +sub DeleteLink { + my $self = shift; + my %args = ( Base => undef, + Target => undef, + Type => undef, + @_ ); + + #check acls + unless ($self->CurrentUserHasRight('ModifyTicket')) { + $RT::Logger->debug("No permission to delete links\n"); + return (0, 'Permission Denied'); + + + } + + #we want one of base and target. we don't care which + #but we only want _one_ + + if ($args{'Base'} and $args{'Target'}) { + $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n"); + return (0, 'Can\'t specifiy both base and target'); + } + elsif ($args{'Base'}) { + $args{'Target'} = $self->Id(); + } + elsif ($args{'Target'}) { + $args{'Base'} = $self->Id(); + } + else { + $RT::Logger->debug("$self: Base or Target must be specified\n"); + return (0, 'Either base or target must be specified'); + } + + my $link = new RT::Link($self->CurrentUser); + $RT::Logger->debug("Trying to load link: ". $args{'Base'}." ". $args{'Type'}. " ". $args{'Target'}. "\n"); + + $link->Load($args{'Base'}, $args{'Type'}, $args{'Target'}); + + + + #it's a real link. + if ($link->id) { + $RT::Logger->debug("We're going to delete link ".$link->id."\n"); + $link->Delete(); + + my $TransString= + "Ticket $args{'Base'} no longer $args{Type} ticket $args{'Target'}."; + my ($Trans, $Msg, $TransObj) = $self->_NewTransaction + (Type => 'DeleteLink', + Field => $args{'Type'}, + Data => $TransString, + TimeTaken => 0 + ); + + return ($linkid, "Link deleted ($TransString)", $transactionid); + } + #if it's not a link we can find + else { + $RT::Logger->debug("Couldn't find that link\n"); + return (0, "Link not found"); + } +} + +# }}} + +# {{{ sub AddLink + +=head2 AddLink + +Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket. + + +=cut + +sub AddLink { + my $self = shift; + my %args = ( Target => '', + Base => '', + Type => '', + @_ ); + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + if ($args{'Base'} and $args{'Target'}) { + $RT::Logger->debug("$self tried to delete a link. both base and target were specified\n"); + return (0, 'Can\'t specifiy both base and target'); + } + elsif ($args{'Base'}) { + $args{'Target'} = $self->Id(); + } + elsif ($args{'Target'}) { + $args{'Base'} = $self->Id(); + } + else { + return (0, 'Either base or target must be specified'); + } + + # {{{ We don't want references to ourself + if ($args{Base} eq $args{Target}) { + return (0, "Can\'t link a ticket to itself"); + } + + # }}} + + # If the base isn't a URI, make it a URI. + # If the target isn't a URI, make it a URI. + + # {{{ Check if the link already exists - we don't want duplicates + my $old_link= new RT::Link ($self->CurrentUser); + $old_link->Load($args{'Base'}, $args{'Type'}, $args{'Target'}); + if ($old_link->Id) { + $RT::Logger->debug("$self Somebody tried to duplicate a link"); + return ($old_link->id, "Link already exists",0); + } + # }}} + + # Storing the link in the DB. + my $link = RT::Link->new($self->CurrentUser); + my ($linkid) = $link->Create(Target => $args{Target}, + Base => $args{Base}, + Type => $args{Type}); + + unless ($linkid) { + return (0,"Link could not be created"); + } + #Write the transaction + + my $TransString="Ticket $args{'Base'} $args{Type} ticket $args{'Target'}."; + + my ($Trans, $Msg, $TransObj) = $self->_NewTransaction + (Type => 'AddLink', + Field => $args{'Type'}, + Data => $TransString, + TimeTaken => 0 + ); + + return ($Trans, "Link created ($TransString)"); + + +} +# }}} + +# {{{ sub URI + +=head2 URI + +Returns this ticket's URI + +=cut + +sub URI { + my $self = shift; + return $RT::TicketBaseURI.$self->id; +} + +# }}} + +# {{{ sub MergeInto + +=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 + +=head2 AddKeyword + +Takes a paramhash of Keyword and KeywordSelect. If Keyword is a valid choice +for KeywordSelect, creates a KeywordObject. If the KeywordSelect says this should +be a single KeywordObject, automatically removes the old value. + + Issues: probably doesn't enforce the depth restrictions or make sure that keywords +are coming from the right part of the tree. really should. + +=cut + +sub AddKeyword { + my $self = shift; + #ACL check + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, 'Permission Denied'); + } + + return($self->_AddKeyword(@_)); + +} + + +# 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."); + +} + +# }}} + +# }}} + +# {{{ Routines dealing with ownership + +# {{{ sub OwnerObj + +=head2 OwnerObj + +Takes nothing and returns an RT::User object of +this ticket's owner + +=cut + +sub OwnerObj { + my $self = shift; + + #If this gets ACLed, we lose on a rights check in User.pm and + #get deep recursion. if we need ACLs here, we need + #an equiv without ACLs + + $owner = new RT::User ($self->CurrentUser); + $owner->Load($self->__Value('Owner')); + + #Return the owner object + return ($owner); +} + +# }}} + +# {{{ sub OwnerAsString + +=head2 OwnerAsString + +Returns the owner's email address + +=cut + +sub OwnerAsString { + my $self = shift; + return($self->OwnerObj->EmailAddress); + +} + +# }}} + +# {{{ sub SetOwner + +=head2 SetOwner + +Takes two arguments: + the Id or Name of the owner +and (optionally) the type of the SetOwner Transaction. It defaults +to 'Give'. 'Steal' is also a valid option. + +=cut + +sub SetOwner { + my $self = shift; + my $NewOwner = shift; + my $Type = shift || "Give"; + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + my $NewOwnerObj = RT::User->new($self->CurrentUser); + my $OldOwnerObj = $self->OwnerObj; + + $NewOwnerObj->Load($NewOwner); + if (!$NewOwnerObj->Id) { + return (0, "That user does not exist"); + } + + #If thie ticket has an owner and it's not the current user + + if (($Type ne 'Steal' ) and ($Type ne 'Force') and #If we're not stealing + ($self->OwnerObj->Id != $RT::Nobody->Id ) and #and the owner is set + ($self->CurrentUser->Id ne $self->OwnerObj->Id())) { #and it's not us + return(0, "You can only reassign tickets that you own or that are unowned"); + } + + #If we've specified a new owner and that user can't modify the ticket + elsif (($NewOwnerObj->Id) and + (!$NewOwnerObj->HasQueueRight(Right => 'OwnTicket', + QueueObj => $self->QueueObj, + TicketObj => $self)) + ) { + return (0, "That user may not own requests in that queue"); + } + + + #If the ticket has an owner and it's the new owner, we don't need + #To do anything + elsif (($self->OwnerObj) and ($NewOwnerObj->Id eq $self->OwnerObj->Id)) { + return(0, "That user already owns that request"); + } + + + my ($trans,$msg)=$self->_Set(Field => 'Owner', + Value => $NewOwnerObj->Id, + TimeTaken => 0, + TransactionType => $Type); + + if ($trans) { + $msg = "Owner changed from ".$OldOwnerObj->Name." to ".$NewOwnerObj->Name; + } + return ($trans, $msg); + +} + +# }}} + +# {{{ sub Take + +=head2 Take + +A convenince method to set the ticket's owner to the current user + +=cut + +sub Take { + my $self = shift; + return ($self->SetOwner($self->CurrentUser->Id, 'Take')); +} + +# }}} + +# {{{ sub Untake + +=head2 Untake + +Convenience method to set the owner to 'nobody' if the current user is the owner. + +=cut + +sub Untake { + my $self = shift; + return($self->SetOwner($RT::Nobody->UserObj->Id, 'Untake')); +} +# }}} + +# {{{ sub Steal + +=head2 Steal + +A convenience method to change the owner of the current ticket to the +current user. Even if it's owned by another user. + +=cut + +sub Steal { + my $self = shift; + + if ($self->IsOwner($self->CurrentUser)) { + return (0,"You already own this ticket"); + } else { + return($self->SetOwner($self->CurrentUser->Id, 'Steal')); + + } + +} + +# }}} + +# }}} + +# {{{ Routines dealing with status + +# {{{ sub ValidateStatus + +=head2 ValidateStatus STATUS + +Takes a string. Returns true if that status is a valid status for this ticket. +Returns false otherwise. + +=cut + +sub ValidateStatus { + my $self = shift; + my $status = shift; + + #Make sure the status passed in is valid + unless ($self->QueueObj->IsValidStatus($status)) { + return (undef); + } + + return (1); + +} + + +# }}} + +# {{{ sub SetStatus + +=head2 SetStatus STATUS + +Set this ticket\'s status. STATUS can be one of: new, open, stalled, resolved or dead. + +=cut + +sub SetStatus { + my $self = shift; + my $status = shift; + + #Check ACL + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, 'Permission Denied'); + } + + my $now = new RT::Date($self->CurrentUser); + $now->SetToNow(); + + #If we're changing the status from new, record that we've started + if (($self->Status =~ /new/) && ($status ne 'new')) { + #Set the Started time to "now" + $self->_Set(Field => 'Started', + Value => $now->ISO, + RecordTransaction => 0); + } + + + if ($status eq 'resolved') { + #When we resolve a ticket, set the 'Resolved' attribute to now. + $self->_Set(Field => 'Resolved', + Value => $now->ISO, + RecordTransaction => 0); + } + + + #Actually update the status + return($self->_Set(Field => 'Status', + Value => $status, + TimeTaken => 0, + TransactionType => 'Status')); +} + +# }}} + +# {{{ sub Kill + +=head2 Kill + +Takes no arguments. Marks this ticket for garbage collection + +=cut + +sub Kill { + my $self = shift; + return ($self->SetStatus('dead')); + # TODO: garbage collection +} + +# }}} + +# {{{ sub Stall + +=head2 Stall + +Sets this ticket's status to stalled + +=cut + +sub Stall { + my $self = shift; + return ($self->SetStatus('stalled')); +} + +# }}} + +# {{{ sub Open + +=head2 Open + +Sets this ticket\'s status to Open + +=cut + +sub Open { + my $self = shift; + return ($self->SetStatus('open')); +} + +# }}} + +# {{{ sub Resolve + +=head2 Resolve + +Sets this ticket\'s status to Resolved + +=cut + +sub Resolve { + my $self = shift; + return ($self->SetStatus('resolved')); +} + +# }}} + +# }}} + +# {{{ Actions + Routines dealing with transactions + +# {{{ sub SetTold and _SetTold + +=head2 SetTold ISO [TIMETAKEN] + +Updates the told and records a transaction + +=cut + +sub SetTold { + my $self=shift; + my $told; + $told = shift if (@_); + my $timetaken=shift || 0; + + unless ($self->CurrentUserHasRight('ModifyTicket')) { + return (0, "Permission Denied"); + } + + my $datetold = new RT::Date($self->CurrentUser); + if ($told) { + $datetold->Set( Format => 'iso', + Value => $told); + } + else { + $datetold->SetToNow(); + } + + return($self->_Set(Field => 'Told', + Value => $datetold->ISO, + TimeTaken => $timetaken, + TransactionType => 'Told')); +} + +=head2 _SetTold + +Updates the told without a transaction or acl check. Useful when we're sending replies. + +=cut + +sub _SetTold { + my $self=shift; + + my $now = new RT::Date($self->CurrentUser); + $now->SetToNow(); + #use __Set to get no ACLs ;) + return($self->__Set(Field => 'Told', + Value => $now->ISO)); +} + +# }}} + +# {{{ sub Transactions + +=head2 Transactions + + Returns an RT::Transactions object of all transactions on this ticket + +=cut + +sub Transactions { + my $self = shift; + + use RT::Transactions; + my $transactions = RT::Transactions->new($self->CurrentUser); + + #If the user has no rights, return an empty object + if ($self->CurrentUserHasRight('ShowTicket')) { + my $tickets = $transactions->NewAlias('Tickets'); + $transactions->Join( ALIAS1 => 'main', + FIELD1 => 'Ticket', + ALIAS2 => $tickets, + FIELD2 => 'id'); + $transactions->Limit( ALIAS => $tickets, + FIELD => 'EffectiveId', + VALUE => $self->id()); + # if the user may not see comments do not return them + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + $transactions->Limit( FIELD => 'Type', + OPERATOR => '!=', + VALUE => "Comment"); + } + } + + return($transactions); +} + +# }}} + +# {{{ sub _NewTransaction + +sub _NewTransaction { + my $self = shift; + my %args = ( TimeTaken => 0, + Type => undef, + OldValue => undef, + NewValue => undef, + Data => undef, + Field => undef, + MIMEObj => undef, + @_ ); + + + require RT::Transaction; + my $trans = new RT::Transaction($self->CurrentUser); + my ($transaction, $msg) = + $trans->Create( Ticket => $self->Id, + TimeTaken => $args{'TimeTaken'}, + Type => $args{'Type'}, + Data => $args{'Data'}, + Field => $args{'Field'}, + NewValue => $args{'NewValue'}, + OldValue => $args{'OldValue'}, + MIMEObj => $args{'MIMEObj'} + ); + + $RT::Logger->warning($msg) unless $transaction; + + $self->_SetLastUpdated; + + if (defined $args{'TimeTaken'} ) { + $self->_UpdateTimeTaken($args{'TimeTaken'}); + } + return($transaction, $msg, $trans); +} + +# }}} + +# }}} + +# {{{ PRIVATE UTILITY METHODS. Mostly needed so Ticket can be a DBIx::Record + +# {{{ sub _ClassAccessible + +sub _ClassAccessible { + { + 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); +} + +# }}} + +# }}} + +# {{{ Routines dealing with ACCESS CONTROL + +# {{{ sub CurrentUserHasRight + +=head2 CurrentUserHasRight + + Takes the textual name of a Ticket scoped right (from RT::ACE) and returns +1 if the user has that right. It returns 0 if the user doesn't have that right. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return ($self->HasRight( Principal=> $self->CurrentUser->UserObj(), + Right => "$right")); + +} + +# }}} + +# {{{ sub HasRight + +=head2 HasRight + + Takes a paramhash with the attributes 'Right' and 'Principal' + 'Right' is a ticket-scoped textual right from RT::ACE + 'Principal' is an RT::User object + + Returns 1 if the principal has the right. Returns undef if not. + +=cut + +sub HasRight { + my $self = shift; + my %args = ( Right => undef, + Principal => undef, + @_); + + unless ((defined $args{'Principal'}) and (ref($args{'Principal'}))) { + $RT::Logger->warning("Principal attrib undefined for Ticket::HasRight"); + } + + return($args{'Principal'}->HasQueueRight(TicketObj => $self, + Right => $args{'Right'})); +} + +# }}} + +# }}} + + +1; + +=head1 AUTHOR + +Jesse Vincent, jesse@fsck.com + +=head1 SEE ALSO + +RT + +=cut + + diff --git a/rt/lib/RT/Tickets.pm b/rt/lib/RT/Tickets.pm new file mode 100755 index 000000000..dd91126c4 --- /dev/null +++ b/rt/lib/RT/Tickets.pm @@ -0,0 +1,1789 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Tickets.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Tickets - A collection of Ticket objects + + +=head1 SYNOPSIS + + use RT::Tickets; + my $tickets = new RT::Tickets($CurrentUser); + +=head1 DESCRIPTION + + A collection of RT::Tickets. + +=head1 METHODS + +=begin testing + +ok (require RT::TestHarness); +ok (require RT::Tickets); + +=end testing + +=cut + +package RT::Tickets; +use RT::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 + +Takes a restriction field and returns a list of values this field is restricted +to. + +=cut + +sub RestrictionValues { + my $self = shift; + my $field = shift; + map $self->{'TicketRestrictions'}{$_}{'VALUE'}, + grep { + $self->{'TicketRestrictions'}{$_}{'FIELD'} eq $field + && $self->{'TicketRestrictions'}{$_}{'OPERATOR'} eq "=" + } + keys %{$self->{'TicketRestrictions'}}; +} + +# }}} + +# {{{ sub ClearRestrictions + +=head2 ClearRestrictions + +Removes all restrictions irretrievably + +=cut + +sub ClearRestrictions { + my $self = shift; + delete $self->{'TicketRestrictions'}; + $self->{'looking_at_effective_id'} = 0; + $self->{'RecalcTicketLimits'} =1; +} + +# }}} + +# {{{ sub DeleteRestriction + +=head2 DeleteRestriction + +Takes the row Id of a restriction (From DescribeRestrictions' output, for example. +Removes that restriction from the session's limits. + +=cut + + +sub DeleteRestriction { + my $self = shift; + my $row = shift; + delete $self->{'TicketRestrictions'}{$row}; + + $self->{'RecalcTicketLimits'} = 1; + #make the underlying easysearch object forget all its preconceptions +} + +# }}} + +# {{{ sub _ProcessRestrictions + +sub _ProcessRestrictions { + my $self = shift; + + #Need to clean the EasySearch slate because it makes things too sticky + $self->CleanSlate(); + + #Blow away ticket aliases since we'll need to regenerate them for a new search + delete $self->{'TicketAliases'}; + delete $self->{KeywordsAliases}; + + my $row; + + foreach $row (keys %{$self->{'TicketRestrictions'}}) { + my $restriction = $self->{'TicketRestrictions'}{$row}; + # {{{ if it's an int + + if ($TYPES{$restriction->{'FIELD'}} eq 'INT' ) { + if ($restriction->{'OPERATOR'} =~ /^(=|!=|>|<|>=|<=)$/) { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => $restriction->{'OPERATOR'}, + VALUE => $restriction->{'VALUE'}, + ); + } + } + # }}} + # {{{ if it's an enum + elsif ($TYPES{$restriction->{'FIELD'}} eq 'ENUM') { + + if ($restriction->{'OPERATOR'} eq '=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'OR', + OPERATOR => '=', + VALUE => $restriction->{'VALUE'}, + ); + } + elsif ($restriction->{'OPERATOR'} eq '!=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => '!=', + VALUE => $restriction->{'VALUE'}, + ); + } + + } + # }}} + # {{{ if it's a date + + elsif ($TYPES{$restriction->{'FIELD'}} eq 'DATE') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => $restriction->{'OPERATOR'}, + VALUE => $restriction->{'VALUE'}, + ); + } + # }}} + # {{{ if it's a string + + elsif ($TYPES{$restriction->{'FIELD'}} eq 'STRING') { + + if ($restriction->{'OPERATOR'} eq '=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'OR', + OPERATOR => '=', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + elsif ($restriction->{'OPERATOR'} eq '!=') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => '!=', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + elsif ($restriction->{'OPERATOR'} eq 'LIKE') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => 'LIKE', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + elsif ($restriction->{'OPERATOR'} eq 'NOT LIKE') { + $self->SUPER::Limit( FIELD => $restriction->{'FIELD'}, + ENTRYAGGREGATOR => 'AND', + OPERATOR => 'NOT LIKE', + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + } + } + + # }}} + # {{{ if it's Transaction content that we're hunting for + elsif ($TYPES{$restriction->{'FIELD'}} eq 'TRANSFIELD') { + + #Basically, we want to make sure that the limits apply to the same attachment, + #rather than just another attachment for the same ticket, no matter how many + #clauses we lump on. + #We put them in TicketAliases so that they get nuked when we redo the join. + + unless (defined $self->{'TicketAliases'}{'TransFieldAlias'}) { + $self->{'TicketAliases'}{'TransFieldAlias'} = $self->NewAlias ('Transactions'); + } + unless (defined $self->{'TicketAliases'}{'TransFieldAttachAlias'}){ + $self->{'TicketAliases'}{'TransFieldAttachAlias'} = $self->NewAlias('Attachments'); + + } + #Join transactions to attachments + $self->Join( ALIAS1 => $self->{'TicketAliases'}{'TransFieldAttachAlias'}, + FIELD1 => 'TransactionId', + ALIAS2 => $self->{'TicketAliases'}{'TransFieldAlias'}, FIELD2=> 'id'); + + #Join transactions to tickets + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 =>$self->{'TicketAliases'}{'TransFieldAlias'}, FIELD2 => 'Ticket'); + + #Search for the right field + $self->SUPER::Limit(ALIAS => $self->{'TicketAliases'}{'TransFieldAttachAlias'}, + ENTRYAGGREGATOR => 'AND', + FIELD => $restriction->{'FIELD'}, + OPERATOR => $restriction->{'OPERATOR'} , + VALUE => $restriction->{'VALUE'}, + CASESENSITIVE => 0 + ); + + + } + + # }}} + # {{{ if it's a Transaction date that we're hunting for + elsif ($TYPES{$restriction->{'FIELD'}} eq 'TRANSDATE') { + + #Basically, we want to make sure that the limits apply to the same attachment, + #rather than just another attachment for the same ticket, no matter how many + #clauses we lump on. + #We put them in TicketAliases so that they get nuked when we redo the join. + + unless (defined $self->{'TicketAliases'}{'TransFieldAlias'}) { + $self->{'TicketAliases'}{'TransFieldAlias'} = $self->NewAlias ('Transactions'); + } + + #Join transactions to tickets + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 =>$self->{'TicketAliases'}{'TransFieldAlias'}, FIELD2 => 'Ticket'); + + #Search for the right field + $self->SUPER::Limit(ALIAS => $self->{'TicketAliases'}{'TransFieldAlias'}, + ENTRYAGGREGATOR => 'AND', + FIELD => 'Created', + OPERATOR => $restriction->{'OPERATOR'} , + VALUE => $restriction->{'VALUE'} ); + } + + # }}} + # {{{ if it's a relationship that we're hunting for + + # Takes FIELD: which is something like "LinkedTo" + # takes TARGET or BASE which is the TARGET or BASE id that we're searching for + # takes TYPE which is the type of link we're looking for. + + elsif ($TYPES{$restriction->{'FIELD'}} eq 'LINKFIELD') { + + + my $LinkAlias = $self->NewAlias ('Links'); + + + #Make sure we get the right type of link, if we're restricting it + if ($restriction->{'TYPE'}) { + $self->SUPER::Limit(ALIAS => $LinkAlias, + ENTRYAGGREGATOR => 'AND', + FIELD => 'Type', + OPERATOR => '=', + VALUE => $restriction->{'TYPE'} ); + } + + #If we're trying to limit it to things that are target of + if ($restriction->{'TARGET'}) { + + + # If the TARGET is an integer that means that we want to look at the LocalTarget + # field. otherwise, we want to look at the "Target" field + + my ($matchfield); + if ($restriction->{'TARGET'} =~/^(\d+)$/) { + $matchfield = "LocalTarget"; + } + else { + $matchfield = "Target"; + } + + $self->SUPER::Limit(ALIAS => $LinkAlias, + ENTRYAGGREGATOR => 'AND', + FIELD => $matchfield, + OPERATOR => '=', + VALUE => $restriction->{'TARGET'} ); + + + #If we're searching on target, join the base to ticket.id + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 => $LinkAlias, + FIELD2 => 'LocalBase'); + + + + + } + #If we're trying to limit it to things that are base of + elsif ($restriction->{'BASE'}) { + + + # If we're trying to match a numeric link, we want to look at LocalBase, + # otherwise we want to look at "Base" + + my ($matchfield); + if ($restriction->{'BASE'} =~/^(\d+)$/) { + $matchfield = "LocalBase"; + } + else { + $matchfield = "Base"; + } + + + $self->SUPER::Limit(ALIAS => $LinkAlias, + ENTRYAGGREGATOR => 'AND', + FIELD => $matchfield, + OPERATOR => '=', + VALUE => $restriction->{'BASE'} ); + + #If we're searching on base, join the target to ticket.id + $self->Join( ALIAS1 => 'main', FIELD1 => $self->{'primary_key'}, + ALIAS2 => $LinkAlias, + FIELD2 => 'LocalTarget'); + + } + + } + + # }}} + # {{{ if it's a watcher that we're hunting for + elsif ($TYPES{$restriction->{'FIELD'}} eq 'WATCHERFIELD') { + + my $Watch = $self->NewAlias('Watchers'); + + #Join watchers to users + my $User = $self->Join( TYPE => 'left', + ALIAS1 => $Watch, + FIELD1 => 'Owner', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + + #Join Ticket to watchers + $self->Join( ALIAS1 => 'main', FIELD1 => 'id', + ALIAS2 => $Watch, FIELD2 => 'Value'); + + + #Make sure we're only talking about ticket watchers + $self->SUPER::Limit( ALIAS => $Watch, + FIELD => 'Scope', + VALUE => 'Ticket', + OPERATOR => '='); + + + # Find email address watchers + $self->SUPER::Limit( SUBCLAUSE => 'WatcherEmailAddress', + ALIAS => $Watch, + FIELD => 'Email', + ENTRYAGGREGATOR => 'OR', + VALUE => $restriction->{'VALUE'}, + OPERATOR => $restriction->{'OPERATOR'}, + CASESENSITIVE => 0 + ); + + + + #Find user watchers + $self->SUPER::Limit( + SUBCLAUSE => 'WatcherEmailAddress', + ALIAS => $User, + FIELD => 'EmailAddress', + ENTRYAGGREGATOR => 'OR', + VALUE => $restriction->{'VALUE'}, + OPERATOR => $restriction->{'OPERATOR'}, + CASESENSITIVE => 0 + ); + + + #If we only want a specific type of watchers, then limit it to that + if ($restriction->{'TYPE'}) { + $self->SUPER::Limit( ALIAS => $Watch, + FIELD => 'Type', + ENTRYAGGREGATOR => 'OR', + VALUE => $restriction->{'TYPE'}, + OPERATOR => '='); + } + } + + # }}} + # {{{ if it's a keyword + elsif ($TYPES{$restriction->{'FIELD'}} eq 'KEYWORDFIELD') { + + my $null_columns_ok; + + my $ObjKeywordsAlias; + $ObjKeywordsAlias = $self->{KeywordsAliases}{$restriction->{'KEYWORDSELECT'}} + if $restriction->{SingleValued}; + unless (defined $ObjKeywordsAlias) { + $ObjKeywordsAlias = $self->Join( + TYPE => 'left', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'ObjectKeywords', + FIELD2 => 'ObjectId' + ); + if ($restriction->{'SingleValued'}) { + $self->{KeywordsAliases}{$restriction->{'KEYWORDSELECT'}} + = $ObjKeywordsAlias; + } + } + + + $self->SUPER::Limit( + ALIAS => $ObjKeywordsAlias, + FIELD => 'Keyword', + OPERATOR => $restriction->{'OPERATOR'}, + VALUE => $restriction->{'KEYWORD'}, + QUOTEVALUE => $restriction->{'QUOTEVALUE'}, + ENTRYAGGREGATOR => 'OR', + ); + + if ( ($restriction->{'OPERATOR'} =~ /^IS$/i) or + ($restriction->{'OPERATOR'} eq '!=') ) { + + $null_columns_ok=1; + + } + + #If we're trying to find tickets where the keyword isn't somethng, also check ones where it _IS_ null + if ( $restriction->{'OPERATOR'} eq '!=') { + $self->SUPER::Limit( + ALIAS => $ObjKeywordsAlias, + FIELD => 'Keyword', + OPERATOR => 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'OR', + ); + } + + + $self->SUPER::Limit(LEFTJOIN => $ObjKeywordsAlias, + FIELD => 'KeywordSelect', + VALUE => $restriction->{'KEYWORDSELECT'}, + ENTRYAGGREGATOR => 'OR'); + + + + $self->SUPER::Limit( ALIAS => $ObjKeywordsAlias, + FIELD => 'ObjectType', + VALUE => 'Ticket', + ENTRYAGGREGATOR => 'AND'); + + if ($null_columns_ok) { + $self->SUPER::Limit(ALIAS => $ObjKeywordsAlias, + FIELD => 'ObjectType', + OPERATOR => 'IS', + VALUE => 'NULL', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'OR'); + } + + } + # }}} + + + } + + + # here, we make sure we don't get any tickets that have been merged into other tickets + # (Ticket Id == Ticket EffectiveId + # note that we _really_ don't want to do this if we're already looking at the effectiveid + if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) { + $self->SUPER::Limit( FIELD => 'EffectiveId', + OPERATOR => '=', + QUOTEVALUE => 0, + VALUE => 'main.id'); #TODO, we shouldn't be hard coding the tablename to main. + } + $self->{'RecalcTicketLimits'} = 0; +} + +# }}} + +# }}} + +# {{{ Deal with displaying rows of the listing + +# +# Everything in this section is stub code for 2.2 +# It's not part of the API. It's not for your use +# It's not for our use. +# + + +# {{{ sub SetListingFormat + +=head2 SetListingFormat + +Takes a single Format string as specified below. parses that format string and makes the various listing output +things DTRT. + +=item Format strings + +Format strings are made up of a chain of Elements delimited with vertical pipes (|). +Elements of a Format string + + +FormatString: Element[::FormatString] + +Element: AttributeName[;HREF=<URL>][;TITLE=<TITLE>] + +AttributeName Id | Subject | Status | Owner | Priority | InitialPriority | TimeWorked | TimeLeft | + + Keywords[;SELECT=<KeywordSelect>] | + + <Created|Starts|Started|Contacted|Due|Resolved>Date<AsString|AsISO|AsAge> + + +=cut + + + + +#accept a format string + + + +sub SetListingFormat { + my $self = shift; + my $listing_format = shift; + + my ($element, $attribs); + my $i = 0; + foreach $element (split (/::/,$listing_format)) { + if ($element =~ /^(.*?);(.*)$/) { + $element = $1; + $attribs = $2; + } + $self->{'format_string'}->[$i]->{'Element'} = $element; + foreach $attrib (split (/;/, $attribs)) { + my $value = ""; + if ($attrib =~ /^(.*?)=(.*)$/) { + $attrib = $1; + $value = $2; + } + $self->{'format_string'}->[$i]->{"$attrib"} = $val; + + } + + } + return(1); +} + +# }}} + +# {{{ sub HeaderAsHTML +sub HeaderAsHTML { + my $self = shift; + my $header = ""; + my $col; + foreach $col ( @{[ $self->{'format_string'} ]}) { + $header .= "<TH>" . $self->_ColumnTitle($self->{'format_string'}->[$col]) . "</TH>"; + + } + return ($header); +} +# }}} + +# {{{ sub HeaderAsText +#Print text header +sub HeaderAsText { + my $self = shift; + my ($header); + + return ($header); +} +# }}} + +# {{{ sub TicketAsHTMLRow +#Print HTML row +sub TicketAsHTMLRow { + my $self = shift; + my $Ticket = shift; + my ($row, $col); + foreach $col (@{[$self->{'format_string'}]}) { + $row .= "<TD>" . $self->_TicketColumnValue($ticket,$self->{'format_string'}->[$col]) . "</TD>"; + + } + return ($row); +} +# }}} + +# {{{ sub TicketAsTextRow +#Print text row +sub TicketAsTextRow { + my $self = shift; + my ($row); + + #TODO implement + + return ($row); +} +# }}} + +# {{{ _ColumnTitle { + +sub _ColumnTitle { + my $self = shift; + + # Attrib is a hash + my $attrib = shift; + + # return either attrib->{'TITLE'} or.. + if ($attrib->{'TITLE'}) { + return($attrib->{'TITLE'}); + } + # failing that, Look up the title in a hash + else { + #TODO create $self->{'ColumnTitles'}; + return ($self->{'ColumnTitles'}->{$attrib->{'Element'}}); + } + +} + +# }}} + +# {{{ _TicketColumnValue +sub _TicketColumnValue { + my $self = shift; + my $Ticket = shift; + my $attrib = shift; + + + my $out; + + SWITCH: { + /^id/i && do { + $out = $Ticket->id; + last SWITCH; + }; + /^subj/i && do { + last SWITCH; + $Ticket->Subject; + }; + /^status/i && do { + last SWITCH; + $Ticket->Status; + }; + /^prio/i && do { + last SWITCH; + $Ticket->Priority; + }; + /^finalprio/i && do { + + last SWITCH; + $Ticket->FinalPriority + }; + /^initialprio/i && do { + + last SWITCH; + $Ticket->InitialPriority; + }; + /^timel/i && do { + + last SWITCH; + $Ticket->TimeWorked; + }; + /^timew/i && do { + + last SWITCH; + $Ticket->TimeLeft; + }; + + /^(.*?)date(.*)$/i && do { + my $o = $1; + my $m = $2; + my ($obj); + #TODO: optimize + $obj = $Ticket->DueObj if $o =~ /due/i; + $obj = $Ticket->CreatedObj if $o =~ /created/i; + $obj = $Ticket->StartsObj if $o =~ /starts/i; + $obj = $Ticket->StartedObj if $o =~ /started/i; + $obj = $Ticket->ToldObj if $o =~ /told/i; + $obj = $Ticket->LastUpdatedObj if $o =~ /lastu/i; + + $method = 'ISO' if $m =~ /iso/i; + + $method = 'AsString' if $m =~ /asstring/i; + $method = 'AgeAsString' if $m =~ /age/i; + last SWITCH; + $obj->$method(); + + }; + + /^watcher/i && do { + last SWITCH; + $Ticket->WatchersAsString(); + }; + + /^requestor/i && do { + last SWITCH; + $Ticket->RequestorsAsString(); + }; + /^cc/i && do { + last SWITCH; + $Ticket->CCAsString(); + }; + + + /^admincc/i && do { + last SWITCH; + $Ticket->AdminCcAsString(); + }; + + /^keywords/i && do { + last SWITCH; + #Limit it to the keyword select we're talking about, if we've got one. + my $objkeys =$Ticket->KeywordsObj($attrib->{'SELECT'}); + $objkeys->KeywordRelativePathsAsString(); + }; + + } + +} + +# }}} + +# }}} + +# {{{ POD +=head2 notes +"Enum" Things that get Is, IsNot + + +"Int" Things that get Is LessThan and GreaterThan +id +InitialPriority +FinalPriority +Priority +TimeLeft +TimeWorked + +"Text" Things that get Is, Like +Subject +TransactionContent + + +"Link" OPERATORs + + +"Date" OPERATORs Is, Before, After + + =cut +# }}} +1; diff --git a/rt/lib/RT/Transaction.pm b/rt/lib/RT/Transaction.pm new file mode 100755 index 000000000..ee1f069b2 --- /dev/null +++ b/rt/lib/RT/Transaction.pm @@ -0,0 +1,783 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Transaction.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# Copyright 1999-2001 Jesse Vincent <jesse@fsck.com> +# Released under the terms of the GNU Public License + +=head1 NAME + + RT::Transaction - RT\'s transaction object + +=head1 SYNOPSIS + + use RT::Transaction; + + +=head1 DESCRIPTION + + +Each RT::Transaction describes an atomic change to a ticket object +or an update to an RT::Ticket object. +It can have arbitrary MIME attachments. + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Transaction); + +=end testing + +=cut + +package RT::Transaction; + +use RT::Record; +@ISA= qw(RT::Record); + +use RT::Attachments; + +# {{{ sub _Init +sub _Init { + my $self = shift; + $self->{'table'} = "Transactions"; + return ($self->SUPER::_Init(@_)); + +} +# }}} + +# {{{ sub Create + +=head2 Create + +Create a new transaction. + +This routine should _never_ be called anything other Than RT::Ticket. It should not be called +from client code. Ever. Not ever. If you do this, we will hunt you down. and break your kneecaps. +Then the unpleasant stuff will start. + +TODO: Document what gets passed to this + +=cut + +sub Create { + my $self = shift; + my %args = ( id => undef, + TimeTaken => 0, + Ticket => 0 , + Type => 'undefined', + Data => '', + Field => undef, + OldValue => undef, + NewValue => undef, + MIMEObj => undef, + ActivateScrips => 1, + @_ + ); + + #if we didn't specify a ticket, we need to bail + unless ( $args{'Ticket'} ) { + return(0, "RT::Transaction->Create couldn't, as you didn't specify a ticket id"); + } + + #lets create our transaction + my $id = $self->SUPER::Create(Ticket => $args{'Ticket'}, + TimeTaken => $args{'TimeTaken'}, + Type => $args{'Type'}, + Data => $args{'Data'}, + Field => $args{'Field'}, + OldValue => $args{'OldValue'}, + NewValue => $args{'NewValue'}, + Created => $args{'Created'} + ); + $self->Load($id); + $self->_Attach($args{'MIMEObj'}) + if defined $args{'MIMEObj'}; + + #Provide a way to turn off scrips if we need to + if ($args{'ActivateScrips'}) { + + #We're really going to need a non-acled ticket for the scrips to work + my $TicketAsSystem = RT::Ticket->new($RT::SystemUser); + $TicketAsSystem->Load($args{'Ticket'}) || + $RT::Logger->err("$self couldn't load ticket $args{'Ticket'}\n"); + + my $TransAsSystem = RT::Transaction->new($RT::SystemUser); + $TransAsSystem->Load($self->id) || + $RT::Logger->err("$self couldn't load a copy of itself as superuser\n"); + + # {{{ Deal with Scrips + + #Load a scripscopes object + use RT::Scrips; + my $PossibleScrips = RT::Scrips->new($RT::SystemUser); + + $PossibleScrips->LimitToQueue($TicketAsSystem->QueueObj->Id); #Limit it to $Ticket->QueueObj->Id + $PossibleScrips->LimitToGlobal(); # or to "global" + my $ConditionsAlias = $PossibleScrips->NewAlias('ScripConditions'); + + $PossibleScrips->Join(ALIAS1 => 'main', FIELD1 => 'ScripCondition', + ALIAS2 => $ConditionsAlias, FIELD2=> 'id'); + + + #We only want things where the scrip applies to this sort of transaction + $PossibleScrips->Limit(ALIAS=> $ConditionsAlias, + FIELD=>'ApplicableTransTypes', + OPERATOR => 'LIKE', + VALUE => $args{'Type'}, + ENTRYAGGREGATOR => 'OR', + ); + + # Or where the scrip applies to any transaction + $PossibleScrips->Limit(ALIAS=> $ConditionsAlias, + FIELD=>'ApplicableTransTypes', + OPERATOR => 'LIKE', + VALUE => "Any", + ENTRYAGGREGATOR => 'OR', + ); + + #Iterate through each script and check it's applicability. + + while (my $Scrip = $PossibleScrips->Next()) { + + #TODO: properly deal with errors raised in this scrip loop + + #$RT::Logger->debug("$self now dealing with ".$Scrip->Id. "\n"); + eval { + local $SIG{__DIE__} = sub { $RT::Logger->error($_[0])}; + + + #Load the scrip's Condition object + $Scrip->ConditionObj->LoadCondition(TicketObj => $TicketAsSystem, + TransactionObj => $TransAsSystem); + + + #If it's applicable, prepare and commit it + + $RT::Logger->debug ("$self: Checking condition ".$Scrip->ConditionObj->Name. "...\n"); + + if ( $Scrip->IsApplicable() ) { + + $RT::Logger->debug ("$self: Matches condition ".$Scrip->ConditionObj->Name. "...\n"); + #TODO: handle some errors here + + $Scrip->ActionObj->LoadAction(TicketObj => $TicketAsSystem, + TransactionObj => $TransAsSystem); + + + if ($Scrip->Prepare()) { + $RT::Logger->debug("$self: Prepared " . + $Scrip->ActionObj->Name . "\n"); + if ($Scrip->Commit()) { + $RT::Logger->debug("$self: Committed " . + $Scrip->ActionObj->Name . "\n"); + } + else { + $RT::Logger->info("$self: Failed to commit ". + $Scrip->ActionObj->Name . "\n"); + } + } + else { + $RT::Logger->info("$self: Failed to prepare " . + $Scrip->ActionObj->Name . "\n"); + } + + #We're done with it. lets clean up. + #TODO: something else isn't letting these get garbage collected. check em out. + $Scrip->ActionObj->DESTROY(); + $Scrip->ConditionObj->DESTROY; + } + + + else { + $RT::Logger->debug ("$self: Doesn't match condition ".$Scrip->ConditionObj->Name. "...\n"); + + # TODO: why doesn't this catch all the ScripObjs we create. + # and why do we explictly need to destroy them? + $Scrip->ConditionObj->DESTROY; + } + } + } + + # }}} + + } + + return ($id, "Transaction Created"); +} + +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + return (0, 'Deleting this object could break referential integrity'); +} + +# }}} + +# {{{ Routines dealing with Attachments + +# {{{ sub Message + +=head2 Message + + 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'}); +} +# }}} + +# {{{ sub Content + +=head2 Content PARAMHASH + +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. + + +=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 + +=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 Attachments + +=head2 Attachments + + Returns all the RT::Attachment objects which are attached +to this transaction. Takes an optional parameter, which is +a ContentType that Attachments should be restricted to. + +=cut + + +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); + +} + +# }}} + +# {{{ sub _Attach + +=head2 _Attach + +A private method used to attach a mime object to this transaction. + +=cut + +sub _Attach { + my $self = shift; + my $MIMEObject = shift; + + if (!defined($MIMEObject)) { + $RT::Logger->error("$self _Attach: We can't attach a mime object if you don't give us one.\n"); + return(0, "$self: no attachment specified"); + } + + + use RT::Attachment; + my $Attachment = new RT::Attachment ($self->CurrentUser); + $Attachment->Create(TransactionId => $self->Id, + Attachment => $MIMEObject); + return ($Attachment, "Attachment created"); + +} + +# }}} + +# }}} + +# {{{ Routines dealing with Transaction Attributes + +# {{{ sub TicketObj + +=head2 TicketObj + +Returns this transaction's ticket object. + +=cut + +sub TicketObj { + my $self = shift; + if (! exists $self->{'TicketObj'}) { + $self->{'TicketObj'} = new RT::Ticket($self->CurrentUser); + $self->{'TicketObj'}->Load($self->Ticket); + } + + return $self->{'TicketObj'}; +} +# }}} + +# {{{ sub Description + +=head2 Description + +Returns a text string which describes this transaction + +=cut + + +sub Description { + my $self = shift; + + #Check those ACLs + #If it's a comment, we need to be extra special careful + if ($self->__Value('Type') eq 'Comment') { + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + return (0, "Permission Denied"); + } + } + + #if they ain't got rights to see, don't let em + else { + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (0, "Permission Denied"); + } + } + + if (!defined($self->Type)) { + return("No transaction type specified"); + } + + return ($self->BriefDescription . " by " . $self->CreatorObj->Name); +} + +# }}} + +# {{{ sub BriefDescription + +=head2 BriefDescription + +Returns a text string which briefly describes this transaction + +=cut + + +sub BriefDescription { + my $self = shift; + + #Check those ACLs + #If it's a comment, we need to be extra special careful + if ($self->__Value('Type') eq 'Comment') { + unless ($self->CurrentUserHasRight('ShowTicketComments')) { + return (0, "Permission Denied"); + } + } + + #if they ain't got rights to see, don't let em + else { + unless ($self->CurrentUserHasRight('ShowTicket')) { + return (0, "Permission Denied"); + } + } + + if (!defined($self->Type)) { + return("No transaction type specified"); + } + + 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); + + } +} + +# }}} + +# {{{ Utility methods + +# {{{ sub IsInbound + +=head2 IsInbound + +Returns true if the creator of the transaction is a requestor of the ticket. +Returns false otherwise + +=cut + +sub IsInbound { + my $self=shift; + return ($self->TicketObj->IsRequestor($self->CreatorObj)); +} + +# }}} + +# }}} + +# {{{ sub _Accessible + +sub _Accessible { + my $self = shift; + my %Cols = ( + TimeTaken => 'read', + Ticket => 'read/public', + Type=> 'read', + Field => 'read', + Data => 'read', + NewValue => 'read', + OldValue => 'read', + Creator => 'read/auto', + Created => 'read/auto', + ); + return $self->SUPER::_Accessible(@_, %Cols); +} + +# }}} + +# }}} + +# {{{ sub _Set + +sub _Set { + my $self = shift; + return(0, 'Transactions are immutable'); +} + +# }}} + +# {{{ 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')) { + 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 CurrentUserHasRight + +=head2 CurrentUserHasRight RIGHT + +Calls $self->CurrentUser->HasQueueRight for the right passed in here. +passed in here. + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + return ($self->CurrentUser->HasQueueRight(Right => "$right", + TicketObj => $self->TicketObj)); +} + +# }}} + +1; diff --git a/rt/lib/RT/Transactions.pm b/rt/lib/RT/Transactions.pm new file mode 100755 index 000000000..2ae98f286 --- /dev/null +++ b/rt/lib/RT/Transactions.pm @@ -0,0 +1,78 @@ +#$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Transactions.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ + +=head1 NAME + + RT::Transactions - a collection of RT Transaction objects + +=head1 SYNOPSIS + + 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::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(@_)); +} +# }}} + +# {{{ sub NewItem +sub NewItem { + my $self = shift; + + return(RT::Transaction->new($self->CurrentUser)); +} +# }}} + + +=head2 example methods + + Queue RT::Queue or Queue Id + Ticket RT::Ticket or Ticket Id + + +LimitDate + +Type TRANSTYPE +Field STRING +OldValue OLDVAL +NewValue NEWVAL +Data DATA +TimeTaken +Actor USEROBJ/USERID +ContentMatches STRING + +=cut + + +1; + diff --git a/rt/lib/RT/User.pm b/rt/lib/RT/User.pm new file mode 100755 index 000000000..4e8554030 --- /dev/null +++ b/rt/lib/RT/User.pm @@ -0,0 +1,1222 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/User.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::User - RT User object + +=head1 SYNOPSIS + + use RT::User; + +=head1 DESCRIPTION + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::User); + +=end testing + + +=cut + + +package RT::User; +use RT::Record; +@ISA= qw(RT::Record); + +# {{{ sub _Init +sub _Init { + 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)); +} + +# }}} + +# {{{ 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'); +} + +# }}} + +# {{{ sub _BootstrapCreate + +#create a user without validating _any_ data. + +#To be used only on database init. + +sub _BootstrapCreate { + my $self = shift; + my %args = (@_); + + $args{'Password'} = "*NO-PASSWORD*"; + my $id = $self->SUPER::Create(%args); + + #If the create failed. + return (0, 'Could not create user') + unless ($id); + + return ($id, 'User created'); +} + +# }}} + +# {{{ sub Delete + +sub Delete { + my $self = shift; + + return(0, 'Deleting this object would violate referential integrity'); + +} + +# }}} + +# {{{ 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. + +=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); + } +} + +# }}} + + +# {{{ sub LoadByEmail + +=head2 LoadByEmail + +Tries to load this user object from the database by the user's email address. + + +=cut + +sub LoadByEmail { + my $self=shift; + my $address = shift; + + # Never load an empty address as an email address. + unless ($address) { + return(undef); + } + + $address = RT::CanonicalizeAddress($address); + #$RT::Logger->debug("Trying to load an email address: $address\n"); + return $self->LoadByCol("EmailAddress", $address); +} +# }}} + + +# {{{ sub ValidateEmailAddress + +=head2 ValidateEmailAddress ADDRESS + +Returns true if the email address entered is not in use by another user or is +undef or ''. Returns false if it's in use. + +=cut + +sub ValidateEmailAddress { + my $self = shift; + my $Value = shift; + + # if the email address is null, it's always valid + return (1) if(!$Value || $Value eq ""); + + my $TempUser = RT::User->new($RT::SystemUser); + $TempUser->LoadByEmail($Value); + + 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); + } +} + +# }}} + + + + +# {{{ sub SetRandomPassword + +=head2 SetRandomPassword + +Takes no arguments. Returns a status code and a new password or an error message. +If the status is 1, the second value returned is the new password. +If the status is anything else, the new value returned is the error code. + +=cut + +sub SetRandomPassword { + my $self = shift; + + + unless ($self->CurrentUserCanModify('Password')) { + return (0, "Permission Denied"); + } + + my $pass = $self->GenerateRandomPassword(6,8); + + # 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); + +} + +# }}} + + +# {{{ sub ResetPassword + +=head2 ResetPassword + +Returns status, [ERROR or new password]. Resets this user\'s password to +a randomly generated pronouncable password and emails them, using a +global template called "RT_PasswordChange", which can be overridden +with global templates "RT_PasswordChange_Privileged" or "RT_PasswordChange_NonPrivileged" +for privileged and Non-privileged users respectively. + +=cut + +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'); + } + +} + + +# }}} + +# {{{ sub GenerateRandomPassword + +=head2 GenerateRandomPassword MIN_LEN and MAX_LEN + +Returns a random password between MIN_LEN and MAX_LEN characters long. + +=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); + +} + + +#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 + +=head2 SetPassword + +Takes a string. Checks the string's length and sets this user's password +to that string. + +=cut + +sub SetPassword { + my $self = shift; + my $password = shift; + + unless ($self->CurrentUserCanModify('Password')) { + return(0, 'Permission Denied'); + } + + if (! $password) { + return(0, "No password set"); + } + elsif (length($password) < $RT::MinimumPasswordLength) { + return(0,"Password too short"); + } + else { + my $salt = join '', ('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]; + return ( $self->SUPER::SetPassword(crypt($password, $salt)) ); + } + +} + +# }}} + +# {{{ sub IsPassword + +=head2 IsPassword + +Returns true if the passed in value is this user's password. +Returns undef otherwise. + +=cut + +sub IsPassword { + my $self = shift; + my $value = shift; + + #TODO there isn't any apparent way to legitimately ACL this + + # RT does not allow null passwords + if ((!defined ($value)) or ($value eq '')) { + return(undef); + } + if ($self->Disabled) { + $RT::Logger->info("Disabled user ".$self->Name." tried to log in"); + return(undef); + } + + if ( ($self->__Value('Password') eq '') || + ($self->__Value('Password') eq undef) ) { + return(undef); + } + if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))) { + return (1); + } + else { + return (undef); + } +} + +# }}} + +# {{{ 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. + +=cut + +# }}} + +# {{{ ACL Related routines + +# {{{ GrantQueueRight + +=head2 GrantQueueRight + +Grant a queue right to this user. Takes a paramhash of which the elements +RightAppliesTo and RightName are important. + +=cut + +sub GrantQueueRight { + + my $self = shift; + my %args = ( RightScope => 'Queue', + RightName => undef, + RightAppliesTo => undef, + PrincipalType => 'User', + PrincipalId => $self->Id, + @_); + + #ACL check handled in ACE.pm + + require RT::ACE; + +# $RT::Logger->debug("$self ->GrantQueueRight right:". $args{'RightName'} . +# " applies to queue ".$args{'RightAppliesTo'}."\n"); + + my $ace = new RT::ACE($self->CurrentUser); + + return ($ace->Create(%args)); +} + +# }}} + +# {{{ GrantSystemRight + +=head2 GrantSystemRight + +Grant a system right to this user. +The only element that's important to set is RightName. + +=cut +sub GrantSystemRight { + + my $self = shift; + my %args = ( RightScope => 'System', + RightName => undef, + RightAppliesTo => 0, + PrincipalType => 'User', + PrincipalId => $self->Id, + @_); + + + #ACL check handled in ACE.pm + + require RT::ACE; + my $ace = new RT::ACE($self->CurrentUser); + + return ($ace->Create(%args)); +} + + +# }}} + +# {{{ 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' + + +Returns 1 if this user has the right specified in the paramhash. for the queue +passed in. + +Returns undef if they don't + +=cut + +sub HasQueueRight { + my $self = shift; + my %args = ( TicketObj => undef, + QueueObj => undef, + Queue => undef, + IsRequestor => undef, + Right => undef, + @_); + + my ($IsRequestor, $IsCc, $IsAdminCc, $IsOwner); + + if (defined $args{'Queue'}) { + $args{'QueueObj'} = new RT::Queue($self->CurrentUser); + $args{'QueueObj'}->Load($args{'Queue'}); + } + + if (defined $args{'TicketObj'}) { + $args{'QueueObj'} = $args{'TicketObj'}->QueueObj(); + } + + # {{{ Validate and load up the QueueId + unless ((defined $args{'QueueObj'}) and ($args{'QueueObj'}->Id)) { + require Carp; + $RT::Logger->debug(Carp::cluck ("$self->HasQueueRight Couldn't find a queue id")); + return undef; + } + + # }}} + + + # Figure out whether a user has the right we're asking about. + # first see if they have the right personally for the queue in question. + my $retval = $self->_HasRight(Scope => 'Queue', + AppliesTo => $args{'QueueObj'}->Id, + Right => $args{'Right'}, + IsOwner => $IsOwner); + + return ($retval) if (defined $retval); + + # then we see whether they have the right personally globally. + $retval = $self->HasSystemRight( $args{'Right'}); + + return ($retval) if (defined $retval); + + # now that we know they don't have the right personally, + + # {{{ Find out about whether the current user is a Requestor, Cc, AdminCc or Owner + + if (defined $args{'TicketObj'}) { + if ($args{'TicketObj'}->IsRequestor($self)) {#user is requestor + $IsRequestor = 1; + } + + if ($args{'TicketObj'}->IsCc($self)) { #If user is a cc + $IsCc = 1; + } + + if ($args{'TicketObj'}->IsAdminCc($self)) { #If user is an admin cc + $IsAdminCc = 1; + } + + if ($args{'TicketObj'}->IsOwner($self)) { #If user is an owner + $IsOwner = 1; + } + } + + if (defined $args{'QueueObj'}) { + if ($args{'QueueObj'}->IsCc($self)) { #If user is a cc + $IsCc = 1; + } + if ($args{'QueueObj'}->IsAdminCc($self)) { #If user is an admin cc + $IsAdminCc = 1; + } + + } + # }}} + + # then see whether they have the right for the queue as a member of a metagroup + + $retval = $self->_HasRight(Scope => 'Queue', + AppliesTo => $args{'QueueObj'}->Id, + Right => $args{'Right'}, + IsOwner => $IsOwner, + IsCc => $IsCc, + IsAdminCc => $IsAdminCc, + IsRequestor => $IsRequestor + ); + + return ($retval) if (defined $retval); + + # then we see whether they have the right globally as a member of a metagroup + $retval = $self->HasSystemRight( $args{'Right'}, + (IsOwner => $IsOwner, + IsCc => $IsCc, + IsAdminCc => $IsAdminCc, + IsRequestor => $IsRequestor + ) ); + + #If they haven't gotten it by now, they just lose. + return ($retval); + +} + +# }}} + +# {{{ sub HasSystemRight + +=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) + +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'}, + + ) + ); + +} + +# }}} + +# {{{ sub _HasRight + +=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: + +=item Right is a textual right name + +=item Scope is a textual scope name. (As of July these were Queue, Ticket and System + +=item AppliesTo is the numerical Id of the object identified in the scope. For tickets, this is the queue #. for queues, this is the queue # + +=item 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. + +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); + } +} + +# }}} + +# {{{ sub CurrentUserCanModify + +=head2 CurrentUserCanModify RIGHT + +If the user has rights for this object, either because +he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an +admin right) 'ModifySelf', return 1. otherwise, return undef. + +=cut + +sub CurrentUserCanModify { + my $self = shift; + my $right = shift; + + if ($self->CurrentUserHasRight('AdminUsers')) { + return (1); + } + #If the field is marked as an "administrators only" field, + # don\'t let the user touch it. + elsif ($self->_Accessible($right, 'admin')) { + return(undef); + } + + #If the current user is trying to modify themselves + elsif ( ($self->id == $self->CurrentUser->id) and + ($self->CurrentUserHasRight('ModifySelf'))) { + return(1); + } + + #If we don\'t have a good reason to grant them rights to modify + # by now, they lose + else { + return(undef); + } + +} + +# }}} + +# {{{ sub CurrentUserHasRight + +=head2 CurrentUserHasRight + + Takes a single argument. returns 1 if $Self->CurrentUser + has the requested right. returns undef otherwise + +=cut + +sub CurrentUserHasRight { + my $self = shift; + my $right = shift; + + return ($self->CurrentUser->HasSystemRight($right)); +} + +# }}} + + +# {{{ 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 + + if ($self->Privileged == 2) { + return (0, "Can not modify system users"); + } + unless ($self->CurrentUserCanModify($args{'Field'})) { + return (0, "Permission Denied"); + } + + + + #Set the new value + my ($ret, $msg)=$self->SUPER::_Set(Field => $args{'Field'}, + Value=> $args{'Value'}); + + 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 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); + } + + +} + +# }}} + +# }}} +1; + diff --git a/rt/lib/RT/Users.pm b/rt/lib/RT/Users.pm new file mode 100755 index 000000000..f4a97268c --- /dev/null +++ b/rt/lib/RT/Users.pm @@ -0,0 +1,281 @@ + +# $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 + +=head1 SYNOPSIS + + 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 + +Takes one argument. an email address. limits the returned set to +that email address + +=cut + +sub LimitToEmail { + 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 + +=cut + +sub LimitToPrivileged { + my $self = shift; + $self->Limit( FIELD => 'Privileged', + OPERATOR => '=', + VALUE => '1'); +} + +# }}} + + + +# {{{ LimitToSystem + +=head2 LimitToSystem + +Limits to users who can be granted rights, but who should +never have their rights modified by a user or be made members of groups. + +=cut + +sub LimitToSystem { + my $self = shift; + $self->Limit( FIELD => 'Privileged', + OPERATOR => '=', + VALUE => '2'); +} + +# }}} + +# {{{ 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 (@_); + + + 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 => 'RightAppliesTo', + OPERATOR => '=', + VALUE => "$queue"); + + + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightScope', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => 'Queue'); + + + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightScope', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + VALUE => 'Ticket'); + + + #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"); + + + }; + + +} + + + +# }}} + +# {{{ HasSystemRight + +=head2 HasSystemRight + +Takes one optional argument: + The name of a System level right. + +Limits the returned set to users who have been granted system rights, personally. If the optional argument is passed in, limits to users who have been granted the explicit right listed. Please see the note attached to LimitToQueueRights + +=cut + +sub HasSystemRight { + my $self = shift; + my $right = shift if (@_); + my $acl_alias = $self->NewAlias('ACL'); + + + $self->Join( ALIAS1 => 'main', FIELD1 => 'id', + ALIAS2 => $acl_alias, FIELD2 => 'PrincipalId'); + $self->Limit (ALIAS => $acl_alias, + FIELD => 'PrincipalType', + OPERATOR => '=', + VALUE => 'User'); + + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightScope', + OPERATOR => '=', + VALUE => 'System'); + + + #TODO: is this being initialized properly if the right isn't there? + if (defined ($right)) { + $self->Limit(ALIAS => $acl_alias, + FIELD => 'RightName', + OPERATOR => '=', + VALUE => "$right"); + + } + + +} + +# }}} + +1; + diff --git a/rt/lib/RT/Watcher.pm b/rt/lib/RT/Watcher.pm new file mode 100755 index 000000000..c7c6100cf --- /dev/null +++ b/rt/lib/RT/Watcher.pm @@ -0,0 +1,313 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Watcher.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2001 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Watcher - RT Watcher object + +=head1 SYNOPSIS + + use RT::Watcher; + + +=head1 DESCRIPTION + +This module should never be called directly by client code. it\'s an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Watcher); + +=end testing + +=cut + +package RT::Watcher; +use RT::Record; +@ISA= qw(RT::Record); + + +# {{{ sub _Init + +sub _Init { + my $self = shift; + + $self->{'table'} = "Watchers"; + return ($self->SUPER::_Init(@_)); + +} +# }}} + +# {{{ sub Create + +=head2 Create PARAMHASH + +Create a new watcher object with the following Attributes: + +Scope: Ticket or Queue +Value: Ticket or queue id +Type: Requestor, Cc or AdminCc. Requestor is not supported for a scope of \'Queue\' +Email: The email address of the watcher. If the email address maps to an RT User, this is resolved +to an Owner object instead. +Owner: The RT user id of the \'owner\' of this watcher object. + +=cut + +sub Create { + my $self = shift; + my %args = ( + Owner => undef, + Email => undef, + Value => undef, + Scope => undef, + Type => undef, + Quiet => 0, + @_ # get the real argumentlist + ); + + #Do we have someone this applies to? + unless (($args{'Owner'} =~ /^(\d+)$/) || ($args{'Email'} =~ /\@/)) { + return (0, "No user or email address specified"); + } + + #if we only have an email address, try to resolve it to an owner + if ($args{'Owner'} == 0) { + my $User = new RT::User($RT::SystemUser); + $User->LoadByEmail($args{'Email'}); + if ($User->id) { + $args{'Owner'} = $User->id; + delete $args{'Email'}; + } + } + + + if ($args{'Type'} eq "Requestor" and $args{'Owner'} == 0) { + # Requestors *MUST* have an account + + my $Address = RT::CanonicalizeAddress($args{'Email'}); + + my $NewUser = RT::User->new($RT::SystemUser); + my ($Val, $Message) = + $NewUser->Create(Name => $Address, + EmailAddress => $Address, + RealName => $Address, + Password => undef, + Privileged => 0, + Comments => 'Autocreated on ticket submission' + ); + return (0, "Could not create watcher for requestor") + unless $Val; + if ($NewUser->id) { + $args{'Owner'} = $NewUser->id; + delete $args{'Email'}; + } + } + + + + + #Make sure we\'ve got a valid type + #TODO --- move this to ValidateType + return (0, "Invalid Type") + unless ($args{'Type'} =~ /^(Requestor|Cc|AdminCc)$/i); + + my $id = $self->SUPER::Create(%args); + if ($id) { + return (1,"Interest noted"); + } + else { + return (0, "Error adding watcher"); + } +} +# }}} + +# {{{ sub Load + +=head2 Load ID + + Loads a watcher by the primary key of the watchers table ($Watcher->id) + +=cut + +sub Load { + my $self = shift; + my $identifier = shift; + + if ($identifier !~ /\D/) { + $self->SUPER::LoadById($identifier); + } + else { + return (0, "That's not a numerical id"); + } +} + +# }}} + +# {{{ sub LoadByValue + +=head2 LoadByValue PARAMHASH + +LoadByValue takes a parameter hash with the following attributes: + + Email, Owner, Scope, Type, Value + +The same rules enforced at create are enforced by Load. + +Returns a tuple of (retval, msg). Retval is 1 on success and 0 on failure. +msg describes what happened in a human readable form. + +=cut + +sub LoadByValue { + my $self = shift; + my %args = ( Email => undef, + Owner => undef, + Scope => undef, + Type => undef, + Value => undef, + @_); + + #TODO: all this code is being copied from Create. that\'s silly + + #Do we have someone this applies to? + unless (($args{'Owner'} =~ /^(\d*)$/) || ($args{'Email'} =~ /\@/)) { + return (0, "No user or email address specified"); + } + + #if we only have an email address, try to resolve it to an owner + unless ($args{'Owner'}) { + my $User = new RT::User($RT::SystemUser); + $User->LoadByEmail($args{'Email'}); + if ($User->id > 0) { + $args{'Owner'} = $User->id; + delete $args{'Email'}; + } + } + + if ((defined ($args{'Type'})) and + ($args{'Type'} !~ /^(Requestor|Cc|AdminCc)$/i)) { + return (0, "Invalid Type"); + } + if ($args{'Owner'}) { + $self->LoadByCols( Type => $args{'Type'}, + Value => $args{'Value'}, + Owner => $args{'Owner'}, + Scope => $args{'Scope'}, + ); + } + else { + $self->LoadByCols( Type => $args{'Type'}, + Email => $args{'Email'}, + Value => $args{'Value'}, + Scope => $args{'Scope'}, + ); + } + unless ($self->Id) { + return(0, "Couldn\'t find that watcher"); + } + return (1, "Watcher loaded"); +} + +# }}} + +# {{{ sub OwnerObj + +=head2 OwnerObj + +Return an RT Owner Object for this Watcher, if we have one + +=cut + +sub OwnerObj { + my $self = shift; + if (!defined $self->{'OwnerObj'}) { + require RT::User; + $self->{'OwnerObj'} = RT::User->new($self->CurrentUser); + if ($self->Owner) { + $self->{'OwnerObj'}->Load($self->Owner); + } else { + return $RT::Nobody->UserObj; + } + } + return ($self->{'OwnerObj'}); +} +# }}} + +# {{{ sub Email + +=head2 Email + +This custom data accessor does the right thing and returns +the 'Email' attribute of this Watcher object. If that's undefined, +it returns the 'EmailAddress' attribute of its 'Owner' object, which is +an RT::User object. + +=cut + +sub Email { + my $self = shift; + + # IF Email is defined, return that. Otherwise, return the Owner's email address + if (defined($self->__Value('Email'))) { + return ($self->__Value('Email')); + } + elsif ($self->Owner) { + return ($self->OwnerObj->EmailAddress); + } + else { + return ("Data error"); + } +} +# }}} + +# {{{ sub IsUser + +=head2 IsUser + +Returns true if this watcher object is tied to a user object. (IE it +isn't sending to some other email address). +Otherwise, returns undef + +=cut + +sub IsUser { + my $self = shift; + # if this watcher has an email address glued onto it, + # return undef + + if (defined($self->__Value('Email'))) { + return undef; + } + else { + return 1; + } +} + +# }}} + +# {{{ sub _Accessible +sub _Accessible { + my $self = shift; + my %Cols = ( + Email => 'read/write', + Scope => 'read/write', + Value => 'read/write', + Type => 'read/write', + Quiet => 'read/write', + Owner => 'read/write', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); + return($self->SUPER::_Accessible(@_, %Cols)); +} +# }}} + +1; + diff --git a/rt/lib/RT/Watchers.pm b/rt/lib/RT/Watchers.pm new file mode 100755 index 000000000..c55adda3f --- /dev/null +++ b/rt/lib/RT/Watchers.pm @@ -0,0 +1,226 @@ +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Watchers.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $ +# (c) 1996-2000 Jesse Vincent <jesse@fsck.com> +# This software is redistributable under the terms of the GNU GPL + +=head1 NAME + + RT::Watchers - Collection of RT Watcher objects + +=head1 SYNOPSIS + + use RT::Watchers; + my $watchers = new RT::Watchers($CurrentUser); + while (my $watcher = $watchers->Next()) { + print $watcher->Id . "is a watcher"; + } + +=head1 DESCRIPTION + +This module should never be called directly by client code. it's an internal module which +should only be accessed through exported APIs in Ticket, Queue and other similar objects. + + +=head1 METHODS + +=begin testing + +ok(require RT::TestHarness); +ok(require RT::Watchers); + +=end testing + +=cut + +package RT::Watchers; + +use strict; +use vars qw( @ISA ); + + +require RT::EasySearch; +require RT::Watcher; +@ISA= qw(RT::EasySearch); + + +# {{{ sub _Init +sub _Init { + my $self = shift; + + $self->{'table'} = "Watchers"; + $self->{'primary_key'} = "id"; + return($self->SUPER::_Init(@_)); +} +# }}} + +# {{{ sub Limit + +=head2 Limit + + A wrapper around RT::EasySearch::Limit which sets +the default entry aggregator to 'AND' + +=cut + +sub Limit { + my $self = shift; + my %args = ( ENTRYAGGREGATOR => 'AND', + @_); + + $self->SUPER::Limit(%args); +} +# }}} + +# {{{ sub LimitToTicket + +=head2 LimitToTicket + +Takes a single arg which is a ticket id +Limits to watchers of that ticket + +=cut + +sub LimitToTicket { + my $self = shift; + my $ticket = shift; + $self->Limit( ENTRYAGGREGATOR => 'OR', + FIELD => 'Value', + VALUE => $ticket); + $self->Limit (ENTRYAGGREGATOR => 'AND', + FIELD => 'Scope', + VALUE => 'Ticket'); +} +# }}} + +# {{{ sub LimitToQueue + +=head2 LimitToQueue + +Takes a single arg, which is a queue id +Limits to watchers of that queue. + +=cut + +sub LimitToQueue { + my $self = shift; + my $queue = shift; + $self->Limit (ENTRYAGGREGATOR => 'OR', + FIELD => 'Value', + VALUE => $queue); + $self->Limit (ENTRYAGGREGATOR => 'AND', + FIELD => 'Scope', + VALUE => 'Queue'); +} +# }}} + +# {{{ sub LimitToType + +=head2 LimitToType + +Takes a single string as its argument. That string is a watcher type +which is one of 'Requestor', 'Cc' or 'AdminCc' +Limits to watchers of that type + +=cut + + +sub LimitToType { + my $self = shift; + my $type = shift; + $self->Limit(FIELD => 'Type', + VALUE => "$type"); +} +# }}} + +# {{{ sub LimitToRequestors + +=head2 LimitToRequestors + +Limits to watchers of type 'Requestor' + +=cut + +sub LimitToRequestors { + my $self = shift; + $self->LimitToType("Requestor"); +} +# }}} + +# {{{ sub LimitToCc + +=head2 LimitToCc + +Limits to watchers of type 'Cc' + +=cut + +sub LimitToCc { + my $self = shift; + $self->LimitToType("Cc"); +} +# }}} + +# {{{ sub LimitToAdminCc + +=head2 LimitToAdminCc + +Limits to watchers of type AdminCc + +=cut + +sub LimitToAdminCc { + my $self = shift; + $self->LimitToType("AdminCc"); +} +# }}} + +# {{{ sub Emails + +=head2 Emails + +# Return a (reference to a) list of emails + +=cut + +sub Emails { + my $self = shift; + my @list; # List is a list of watcher email addresses + + # $watcher is an RT::Watcher object + while (my $watcher=$self->Next()) { + push(@list, $watcher->Email); + } + return \@list; +} +# }}} + +# {{{ sub EmailsAsString + +=head2 EmailsAsString + +# Returns the RT::Watchers->Emails as a comma seperated string + +=cut + +sub EmailsAsString { + my $self = shift; + return(join(", ",@{$self->Emails})); +} +# }}} + +# {{{ sub NewItem + + + +sub NewItem { + my $self = shift; + + use RT::Watcher; + my $item = new RT::Watcher($self->CurrentUser); + return($item); +} +# }}} +1; + + + + diff --git a/rt/lib/test.pl b/rt/lib/test.pl new file mode 100644 index 000000000..f0da5df27 --- /dev/null +++ b/rt/lib/test.pl @@ -0,0 +1,52 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use RT; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +use RT::Record; +use RT::EasySearch; +use RT::Handle; +use RT::Ticket; +use RT::Tickets; +use RT::ACE; +use RT::ACL; +use RT::Watcher; +use RT::Watchers; +use RT::Scrip; +use RT::Scrips; +use RT::ScripAction; +use RT::ScripCondition; +use RT::ScripActions; +use RT::ScripConditions; +use RT::Transaction; +use RT::Transactions; +use RT::Group; +use RT::GroupMembers; +use RT::User; +use RT::Users; +use RT::CurrentUser; +use RT::Attachment; +use RT::Attachments; +use RT::Keyword; +use RT::Keywords; +use RT::KeywordSelect; +use RT::KeywordSelects; +use RT::ObjectKeyword; +use RT::ObjectKeywords; +use RT::Date; + |