import rt 2.0.14
[freeside.git] / rt / lib / RT / Keyword.pm
diff --git a/rt/lib/RT/Keyword.pm b/rt/lib/RT/Keyword.pm
new file mode 100644 (file)
index 0000000..a41e0a5
--- /dev/null
@@ -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;
+