1 #$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Keyword.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
5 RT::Keyword - Manipulate an RT::Keyword record
11 my $keyword = RT::Keyword->new($CurrentUser);
12 $keyword->Create( Name => 'tofu',
13 Description => 'fermented soy beans',
17 my $keyword2 = RT::Keyword->new($CurrentUser);
18 $keyword2->Create( Name => 'beast',
19 Description => 'a wild animal',
20 Parent => $keyword->id(),
25 An B<RT::Keyword> object is an arbitrary string.
31 ok (require RT::TestHarness);
32 ok (require RT::Scrip);
46 @ISA = qw(RT::Record);
52 $self->{'table'} = "Keywords";
53 $self->SUPER::_Init(@_);
59 Name => 'read/write', #the keyword itself
60 Description => 'read/write', #a description of the keyword
61 Parent => 'read/write', #optional id of another B<RT::Keyword>, allowing keywords to be arranged hierarchically
62 Disabled => 'read/write'
64 return ($self->SUPER::_Accessible( @_, %cols));
73 =item new CURRENT_USER
75 Takes a single argument, an RT::CurrentUser object. Instantiates a new
76 (uncreated) RT::Keyword object.
82 =item Create KEY => VALUE, ...
84 Takes a list of key/value pairs and creates a the object. Returns the id of
85 the newly created record, or false if there was an error.
89 Name - the keyword itself
90 Description - (not yet used)
91 Parent - optional link to another B<RT::Keyword>, allowing keyword to be arranged in a hierarchical fashion. Can be specified by id or Name.
97 my %args = (Name => undef,
102 unless ($self->CurrentUserHasRight('AdminKeywords')) {
103 return (0, 'Permission Denied');
106 if ( $args{'Parent'} && $args{'Parent'} !~ /^\d+$/ ) {
107 $RT::Logger->err( "can't yet specify parents by name, sorry: ". $args{'Parent'});
108 return(0,'Parent must be specified by id');
111 my $val = $self->SUPER::Create(Name => $args{'Name'},
112 Description => $args{'Description'},
113 Parent => $args{'Parent'}
116 return ($val, 'Keyword created');
119 return(0,'Could not create keyword');
130 return (0, 'Deleting this object would break referential integrity.');
137 =head2 LoadByPath STRING
139 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
140 described by that path. It returns a numerical status and a textual message.
141 A non-zero status means 'Success'.
150 my $delimiter = substr($path,0,1);
151 my @path_elements = split($delimiter, $path);
153 #throw awya the first bogus path element
154 shift @path_elements;
158 #iterate through all the path elements loading up a
159 #keyword object. when we're done, this object becomes
160 #whatever the last tempkey object was.
161 while (my $name = shift @path_elements) {
163 $tempkey = new RT::Keyword($self->CurrentUser);
165 my $loaded = $tempkey->LoadByNameAndParentId($name, $parent);
167 #Set the new parent for loading its child.
168 $parent = $tempkey->Id;
170 #If the parent Id is 0, then we're not recursing through the tree
172 return (0, "Couldn't find keyword") unless ($tempkey->id());
175 #Now that we're through with the loop, the last keyword loaded
176 # is the the one we wanted.
177 # we shouldn't need to explicitly load it like this. but we do. Thanks SQL
179 $self->Load($tempkey->Id);
181 return (1, 'Keyword loaded');
187 # {{{ sub LoadByNameAndParentId
189 =head2 LoadByNameAndParentId NAME PARENT_ID
191 Takes two arguments, a keyword name and a parent id. Loads a keyword into
196 sub LoadByNameAndParentId {
199 my $parentid = shift;
201 my $val = $self->LoadByCols( Name => $name, Parent => $parentid);
203 return ($self->Id, 'Keyword loaded');
206 return (0, 'Keyword could not be found');
217 Loads KEYWORD, either by id if it's an integer or by Path, otherwise
226 return (0, 'No keyword defined');
228 if ($id =~ /^(\d+)$/) {
229 return ($self->SUPER::Load($id));
232 return($self->LoadByPath($id));
243 Returns this Keyword's full path going back to the root. (eg /OS/Unix/Linux/Redhat if
244 this keyword is "Redhat" )
251 if ($self->Parent == 0) {
252 return ("/".$self->Name);
255 return ( $self->ParentObj->Path . "/" . $self->Name);
262 # {{{ sub RelativePath
264 =head2 RelativePath KEYWORD_OBJ
266 Takes a keyword object. Returns this keyword's path relative to that
271 Currently assumes that the "other" keyword is a predecessor of this keyword
277 my $OtherKey = shift;
279 my $OtherPath = $OtherKey->Path();
280 my $MyPath = $self->Path;
281 $MyPath =~ s/^$OtherPath\///g;
292 Returns an RT::Keyword object of this Keyword's 'parents'
299 my $ParentObj = new RT::Keyword($self->CurrentUser);
300 $ParentObj->Load($self->Parent);
310 Return an RT::Keywords object this Object's children.
317 my $Children = new RT::Keywords($self->CurrentUser);
318 $Children->LimitToParent($self->id);
324 # {{{ sub Descendents
326 =item Descendents [ NUM_GENERATIONS [ EXCLUDE_HASHREF ] ]
328 Returns an ordered (see L<Tie::IxHash>) hash reference of the descendents of
329 this keyword, possibly limited to a given number of generations. The keys
330 are B<RT::Keyword> I<id>s, and the values are strings containing the I<Name>s
331 of those B<RT::Keyword>s.
337 my $generations = shift || 0;
338 my $exclude = shift || {};
342 tie %results, 'Tie::IxHash';
343 my $Keywords = new RT::Keywords($self->CurrentUser);
344 $Keywords->LimitToParent($self->id || 0 ); #If we have no id, start at the top
346 while ( my $Keyword = $Keywords->Next ) {
348 next if defined $exclude->{ $Keyword->id };
349 $results{ $Keyword->id } = $Keyword->Name;
351 if ( $generations == 0 || $generations > 1 ) {
352 #if we're limiting to some number of generations,
353 # decrement the number of generations
355 my $nextgen = $generations;
356 $nextgen-- if ( $nextgen > 1 );
358 my $kids = $Keyword->Descendents($nextgen, \%results);
360 foreach my $kid ( keys %{$kids}) {
361 $results{"$kid"} = $Keyword->Name. "/". $kids->{"$kid"};
370 # {{{ ACL related methods
374 # does an acl check and then passes off the call
378 unless ($self->CurrentUserHasRight('AdminKeywords')) {
379 return (0,'Permission Denied');
381 return $self->SUPER::_Set(@_);
386 # {{{ sub CurrentUserHasRight
388 =head2 CurrentUserHasRight
390 Helper menthod for HasRight. Presets Principal to CurrentUser then
395 sub CurrentUserHasRight {
398 return ($self->HasRight( Principal => $self->CurrentUser->UserObj,
409 Takes a param-hash consisting of "Right" and "Principal" Principal is
410 an RT::User object or an RT::CurrentUser object. "Right" is a textual
411 Right string that applies to Keywords.
417 my %args = ( Right => undef,
421 return( $args{'Principal'}->HasSystemRight( $args{'Right'}) );
432 Ivan Kohler <ivan-rt@420.am>
440 L<RT::Keywords>, L<RT::ObjectKeyword>, L<RT::ObjectKeywords>, L<RT::Ticket>,