rt/lib/RT/Keyword.pm

   1 #$Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Attic/Keyword.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
   2
   3 =head1 NAME
   4
   5  RT::Keyword - Manipulate an RT::Keyword record
   6
   7 =head1 SYNOPSIS
   8
   9   use RT::Keyword;
  10
  11   my $keyword = RT::Keyword->new($CurrentUser);
  12   $keyword->Create( Name => 'tofu',
  13                     Description => 'fermented soy beans',
  14                   );
  15
  16
  17   my $keyword2 = RT::Keyword->new($CurrentUser);
  18   $keyword2->Create( Name   => 'beast',
  19                     Description => 'a wild animal',
  20                     Parent => $keyword->id(),
  21                   );
  22
  23 =head1 DESCRIPTION
  24
  25 An B<RT::Keyword> object is an arbitrary string.
  26
  27 =head1 METHODS
  28
  29 =begin testing
  30
  31 ok (require RT::TestHarness);
  32 ok (require RT::Scrip);
  33
  34 =end testing
  35
  36
  37 =cut
  38 package RT::Keyword;
  39
  40 use strict;
  41 use vars qw(@ISA);
  42 use Tie::IxHash;
  43 use RT::Record;
  44 use RT::Keywords;
  45
  46 @ISA = qw(RT::Record);
  47
  48 # {{{ Core methods
  49
  50 sub _Init {
  51     my $self = shift;
  52     $self->{'table'} = "Keywords";
  53     $self->SUPER::_Init(@_);
  54 }
  55
  56 sub _Accessible {
  57     my $self = shift;
  58     my %cols = (
  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'
  63                );
  64     return ($self->SUPER::_Accessible( @_, %cols));
  65
  66 }
  67
  68 # }}}
  69
  70
  71 =over 4
  72
  73 =item new CURRENT_USER
  74
  75 Takes a single argument, an RT::CurrentUser object.  Instantiates a new
  76 (uncreated) RT::Keyword object.
  77
  78 =cut
  79
  80 # {{{ sub Create
  81
  82 =item Create KEY => VALUE, ...
  83
  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.
  86
  87 Keys are:
  88
  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.
  92
  93 =cut
  94
  95 sub Create {
  96     my $self = shift;
  97     my %args = (Name => undef,
  98                 Description => undef,
  99                 Parent => 0,
 100                 @_);
 101
 102     unless ($self->CurrentUserHasRight('AdminKeywords')) {
 103         return (0, 'Permission Denied');
 104     }
 105
 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');
 109     }
 110
 111     my $val = $self->SUPER::Create(Name => $args{'Name'},
 112                                    Description => $args{'Description'},
 113                                    Parent => $args{'Parent'}
 114                                   );
 115     if ($val) {
 116         return ($val, 'Keyword created');
 117     }
 118     else {
 119         return(0,'Could not create keyword');
 120     }
 121 }
 122
 123 # }}}
 124
 125 # {{{ sub Delete
 126
 127 sub Delete {
 128     my $self = shift;
 129
 130     return (0, 'Deleting this object would break referential integrity.');
 131 }
 132
 133 # }}}
 134
 135 # {{{ sub LoadByPath
 136
 137 =head2 LoadByPath STRING
 138
 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'.
 142
 143 =cut
 144
 145 sub LoadByPath {
 146     my $self = shift;
 147
 148     my $path = shift;
 149
 150     my $delimiter = substr($path,0,1);
 151     my @path_elements = split($delimiter, $path);
 152
 153     #throw awya the first bogus path element
 154     shift @path_elements;
 155
 156     my $parent = 0;
 157     my ($tempkey);
 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) {
 162
 163         $tempkey = new RT::Keyword($self->CurrentUser);
 164
 165         my $loaded = $tempkey->LoadByNameAndParentId($name, $parent);
 166
 167         #Set the new parent for loading its child.
 168         $parent = $tempkey->Id;
 169
 170         #If the parent Id is 0, then we're not recursing through the tree
 171         # time to bail
 172         return (0, "Couldn't find keyword") unless ($tempkey->id());
 173
 174     }
 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
 178
 179     $self->Load($tempkey->Id);
 180
 181     return (1, 'Keyword loaded');
 182 }
 183
 184
 185 # }}}
 186
 187 # {{{ sub LoadByNameAndParentId
 188
 189 =head2 LoadByNameAndParentId NAME PARENT_ID
 190
 191 Takes two arguments, a keyword name and a parent id. Loads a keyword into
 192   the current object.
 193
 194 =cut
 195
 196 sub LoadByNameAndParentId {
 197     my $self = shift;
 198     my $name = shift;
 199     my $parentid = shift;
 200
 201     my $val = $self->LoadByCols( Name => $name, Parent => $parentid);
 202     if ($self->Id) {
 203         return ($self->Id, 'Keyword loaded');
 204     }
 205     else {
 206         return (0, 'Keyword could not be found');
 207     }
 208   }
 209
 210 # }}}
 211
 212
 213 # {{{ sub Load
 214
 215 =head2 Load KEYWORD
 216
 217 Loads KEYWORD, either by id if it's an integer or by Path, otherwise
 218
 219 =cut
 220
 221 sub Load {
 222     my $self = shift;
 223     my $id = shift;
 224
 225     if (!$id) {
 226         return (0, 'No keyword defined');
 227     }
 228     if ($id =~ /^(\d+)$/) {
 229          return ($self->SUPER::Load($id));
 230     }
 231     else {
 232          return($self->LoadByPath($id));
 233     }
 234 }
 235
 236
 237 # }}}
 238
 239 # {{{ sub Path
 240
 241 =item Path
 242
 243   Returns this Keyword's full path going back to the root. (eg /OS/Unix/Linux/Redhat if
 244 this keyword is "Redhat" )
 245
 246 =cut
 247
 248 sub Path {
 249     my $self = shift;
 250
 251     if ($self->Parent == 0) {
 252         return ("/".$self->Name);
 253     }
 254     else {
 255         return ( $self->ParentObj->Path . "/" . $self->Name);
 256     }
 257
 258 }
 259
 260 # }}}
 261
 262 # {{{ sub RelativePath
 263
 264 =head2 RelativePath KEYWORD_OBJ
 265
 266 Takes a keyword object.  Returns this keyword's path relative to that
 267 keyword.
 268
 269 =item Bugs
 270
 271 Currently assumes that the "other" keyword is a predecessor of this keyword
 272
 273 =cut
 274
 275 sub RelativePath {
 276     my $self = shift;
 277     my $OtherKey = shift;
 278
 279     my $OtherPath = $OtherKey->Path();
 280     my $MyPath = $self->Path;
 281     $MyPath =~ s/^$OtherPath\///g;
 282     return ($MyPath);
 283 }
 284
 285
 286 # }}}
 287
 288 # {{{ sub ParentObj
 289
 290 =item ParentObj
 291
 292   Returns an RT::Keyword object of this Keyword's 'parents'
 293
 294 =cut
 295
 296 sub ParentObj {
 297     my $self = shift;
 298
 299     my $ParentObj = new RT::Keyword($self->CurrentUser);
 300     $ParentObj->Load($self->Parent);
 301     return ($ParentObj);
 302 }
 303
 304 # }}}
 305
 306 # {{{ sub Children
 307
 308 =item Children
 309
 310 Return an RT::Keywords object  this Object's children.
 311
 312 =cut
 313
 314 sub Children {
 315     my $self = shift;
 316
 317     my $Children = new RT::Keywords($self->CurrentUser);
 318     $Children->LimitToParent($self->id);
 319     return ($Children);
 320 }
 321
 322 # }}}
 323
 324 # {{{ sub Descendents
 325
 326 =item Descendents [ NUM_GENERATIONS [ EXCLUDE_HASHREF ]  ]
 327
 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.
 332
 333 =cut
 334
 335 sub Descendents {
 336     my $self = shift;
 337     my $generations = shift || 0;
 338     my $exclude = shift || {};
 339     my %results;
 340
 341
 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
 345
 346     while ( my $Keyword = $Keywords->Next ) {
 347
 348         next if defined $exclude->{ $Keyword->id };
 349         $results{ $Keyword->id } = $Keyword->Name;
 350
 351         if ( $generations == 0 || $generations > 1 ) {
 352             #if we're limiting to some number of generations,
 353             # decrement the number of generations
 354
 355             my $nextgen = $generations;
 356             $nextgen-- if ( $nextgen > 1 );
 357
 358             my $kids = $Keyword->Descendents($nextgen, \%results);
 359
 360             foreach my $kid ( keys %{$kids}) {
 361                 $results{"$kid"} = $Keyword->Name. "/". $kids->{"$kid"};
 362             }
 363         }
 364     }
 365     return(\%results);
 366 }
 367
 368 # }}}
 369
 370 # {{{ ACL related methods
 371
 372 # {{{ sub _Set
 373
 374 # does an acl check and then passes off the call
 375 sub _Set {
 376     my $self = shift;
 377
 378     unless ($self->CurrentUserHasRight('AdminKeywords')) {
 379         return (0,'Permission Denied');
 380     }
 381     return $self->SUPER::_Set(@_);
 382 }
 383
 384 # }}}
 385
 386 # {{{ sub CurrentUserHasRight
 387
 388 =head2 CurrentUserHasRight
 389
 390 Helper menthod for HasRight. Presets Principal to CurrentUser then
 391 calls HasRight.
 392
 393 =cut
 394
 395 sub CurrentUserHasRight {
 396     my $self = shift;
 397     my $right = shift;
 398     return ($self->HasRight( Principal => $self->CurrentUser->UserObj,
 399                              Right => $right ));
 400
 401 }
 402
 403 # }}}
 404
 405 # {{{ sub HasRight
 406
 407 =head2 HasRight
 408
 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.
 412
 413 =cut
 414
 415 sub HasRight {
 416     my $self = shift;
 417     my %args = ( Right => undef,
 418                  Principal => undef,
 419                  @_ );
 420
 421     return( $args{'Principal'}->HasSystemRight( $args{'Right'}) );
 422
 423 }
 424 # }}}
 425
 426 # }}}
 427
 428 =back
 429
 430 =head1 AUTHOR
 431
 432 Ivan Kohler <ivan-rt@420.am>
 433
 434 =head1 BUGS
 435
 436 Yes.
 437
 438 =head1 SEE ALSO
 439
 440 L<RT::Keywords>, L<RT::ObjectKeyword>, L<RT::ObjectKeywords>, L<RT::Ticket>,
 441 L<RT::Record>
 442
 443 [A=cut
 444
 445 1;
 446