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; + | 
