--- /dev/null
+#$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;
+