path: root/rt/lib/RT/Keyword.pm

#$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;