diff options
Diffstat (limited to 'rt/lib/RT/Keyword.pm')
-rw-r--r-- | rt/lib/RT/Keyword.pm | 446 |
1 files changed, 446 insertions, 0 deletions
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; + |