rt/lib/RT/Record.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   7 # This work is made available to you under the terms of Version 2 of
   8 # the GNU General Public License. A copy of that license should have
   9 # been provided with this software, but in any event can be snarfed
  10 # from www.gnu.org.
  11 #
  12 # This work is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # Unless otherwise specified, all modifications, corrections or
  18 # extensions to this work which alter its source code become the
  19 # property of Best Practical Solutions, LLC when submitted for
  20 # inclusion in the work.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 =head1 NAME
  25
  26   RT::Record - Base class for RT record objects
  27
  28 =head1 SYNOPSIS
  29
  30
  31 =head1 DESCRIPTION
  32
  33
  34 =begin testing
  35
  36 ok (require RT::Record);
  37
  38 =end testing
  39
  40 =head1 METHODS
  41
  42 =cut
  43
  44 package RT::Record;
  45 use RT::Date;
  46 use RT::User;
  47
  48 use RT::Base;
  49 use DBIx::SearchBuilder::Record::Cachable;
  50
  51 use strict;
  52 use vars qw/@ISA/;
  53
  54 @ISA = qw(RT::Base);
  55
  56 if ($RT::DontCacheSearchBuilderRecords ) {
  57     push (@ISA, 'DBIx::SearchBuilder::Record');
  58 } else {
  59     push (@ISA, 'DBIx::SearchBuilder::Record::Cachable');
  60
  61 }
  62
  63 # {{{ sub _Init
  64
  65 sub _Init {
  66     my $self = shift;
  67     $self->CurrentUser(@_);
  68
  69 }
  70
  71 # }}}
  72
  73 # {{{ _PrimaryKeys
  74
  75 =head2 _PrimaryKeys
  76
  77 The primary keys for RT classes is 'id'
  78
  79 =cut
  80
  81 sub _PrimaryKeys {
  82     my $self = shift;
  83     return ( ['id'] );
  84 }
  85
  86 # }}}
  87
  88 # {{{ sub _Handle
  89 sub _Handle {
  90     my $self = shift;
  91     return ($RT::Handle);
  92 }
  93
  94 # }}}
  95
  96 # {{{ sub Create
  97
  98 =item  Create PARAMHASH
  99
 100 Takes a PARAMHASH of Column -> Value pairs.
 101 If any Column has a Validate$PARAMNAME subroutine defined and the
 102 value provided doesn't pass validation, this routine returns
 103 an error.
 104
 105 If this object's table has any of the following atetributes defined as
 106 'Auto', this routine will automatically fill in their values.
 107
 108 =cut
 109
 110 sub Create {
 111     my $self    = shift;
 112     my %attribs = (@_);
 113     foreach my $key ( keys %attribs ) {
 114         my $method = "Validate$key";
 115         unless ( $self->$method( $attribs{$key} ) ) {
 116             if (wantarray) {
 117                 return ( 0, $self->loc('Invalid value for [_1]', $key) );
 118             }
 119             else {
 120                 return (0);
 121             }
 122         }
 123     }
 124     my $now = RT::Date->new( $self->CurrentUser );
 125     $now->Set( Format => 'unix', Value => time );
 126     $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
 127
 128     if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
 129          $attribs{'Creator'} = $self->CurrentUser->id || '0';
 130     }
 131     $attribs{'LastUpdated'} = $now->ISO()
 132       if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
 133
 134     $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
 135       if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
 136
 137     my $id = $self->SUPER::Create(%attribs);
 138     if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
 139         if ( $id->errno ) {
 140             if (wantarray) {
 141                 return ( 0,
 142                     $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
 143             }
 144             else {
 145                 return (0);
 146             }
 147         }
 148     }
 149     # If the object was created in the database,
 150     # load it up now, so we're sure we get what the database
 151     # has.  Arguably, this should not be necessary, but there
 152     # isn't much we can do about it.
 153
 154    unless ($id) {
 155     if (wantarray) {
 156         return ( $id, $self->loc('Object could not be created') );
 157     }
 158     else {
 159         return ($id);
 160     }
 161
 162    }
 163
 164     if  (UNIVERSAL::isa('errno',$id)) {
 165         exit(0);
 166        warn "It's here!";
 167         return(undef);
 168     }
 169
 170     $self->Load($id) if ($id);
 171
 172
 173
 174     if (wantarray) {
 175         return ( $id, $self->loc('Object created') );
 176     }
 177     else {
 178         return ($id);
 179     }
 180
 181 }
 182
 183 # }}}
 184
 185 # {{{ sub LoadByCols
 186
 187 =head2 LoadByCols
 188
 189 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
 190 DB is case sensitive
 191
 192 =cut
 193
 194 sub LoadByCols {
 195     my $self = shift;
 196     my %hash = (@_);
 197
 198     # If this database is case sensitive we need to uncase objects for
 199     # explicit loading
 200     if ( $self->_Handle->CaseSensitive ) {
 201         my %newhash;
 202         foreach my $key ( keys %hash ) {
 203
 204             # If we've been passed an empty value, we can't do the lookup.
 205             # We don't need to explicitly downcase integers or an id.
 206             if ( $key =~ '^id$'
 207                 || !defined( $hash{$key} )
 208                 || $hash{$key} =~ /^\d+$/
 209                  )
 210             {
 211                 $newhash{$key} = $hash{$key};
 212             }
 213             else {
 214                 $newhash{ "lower(" . $key . ")" } = lc( $hash{$key} );
 215             }
 216         }
 217
 218         # We've clobbered everything we care about. bash the old hash
 219         # and replace it with the new hash
 220         %hash = %newhash;
 221     }
 222     $self->SUPER::LoadByCols(%hash);
 223 }
 224
 225 # }}}
 226
 227 # {{{ Datehandling
 228
 229 # There is room for optimizations in most of those subs:
 230
 231 # {{{ LastUpdatedObj
 232
 233 sub LastUpdatedObj {
 234     my $self = shift;
 235     my $obj  = new RT::Date( $self->CurrentUser );
 236
 237     $obj->Set( Format => 'sql', Value => $self->LastUpdated );
 238     return $obj;
 239 }
 240
 241 # }}}
 242
 243 # {{{ CreatedObj
 244
 245 sub CreatedObj {
 246     my $self = shift;
 247     my $obj  = new RT::Date( $self->CurrentUser );
 248
 249     $obj->Set( Format => 'sql', Value => $self->Created );
 250
 251     return $obj;
 252 }
 253
 254 # }}}
 255
 256 # {{{ AgeAsString
 257 #
 258 # TODO: This should be deprecated
 259 #
 260 sub AgeAsString {
 261     my $self = shift;
 262     return ( $self->CreatedObj->AgeAsString() );
 263 }
 264
 265 # }}}
 266
 267 # {{{ LastUpdatedAsString
 268
 269 # TODO this should be deprecated
 270
 271 sub LastUpdatedAsString {
 272     my $self = shift;
 273     if ( $self->LastUpdated ) {
 274         return ( $self->LastUpdatedObj->AsString() );
 275
 276     }
 277     else {
 278         return "never";
 279     }
 280 }
 281
 282 # }}}
 283
 284 # {{{ CreatedAsString
 285 #
 286 # TODO This should be deprecated
 287 #
 288 sub CreatedAsString {
 289     my $self = shift;
 290     return ( $self->CreatedObj->AsString() );
 291 }
 292
 293 # }}}
 294
 295 # {{{ LongSinceUpdateAsString
 296 #
 297 # TODO This should be deprecated
 298 #
 299 sub LongSinceUpdateAsString {
 300     my $self = shift;
 301     if ( $self->LastUpdated ) {
 302
 303         return ( $self->LastUpdatedObj->AgeAsString() );
 304
 305     }
 306     else {
 307         return "never";
 308     }
 309 }
 310
 311 # }}}
 312
 313 # }}} Datehandling
 314
 315 # {{{ sub _Set
 316 sub _Set {
 317     my $self = shift;
 318
 319     my %args = (
 320         Field => undef,
 321         Value => undef,
 322         IsSQL => undef,
 323         @_
 324     );
 325
 326     #if the user is trying to modify the record
 327     # TODO: document _why_ this code is here
 328
 329     if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
 330         $args{'Value'} = 0;
 331     }
 332
 333     $self->_SetLastUpdated();
 334     my ( $val, $msg ) = $self->SUPER::_Set(
 335         Field => $args{'Field'},
 336         Value => $args{'Value'},
 337         IsSQL => $args{'IsSQL'}
 338     );
 339 }
 340
 341 # }}}
 342
 343 # {{{ sub _SetLastUpdated
 344
 345 =head2 _SetLastUpdated
 346
 347 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
 348 It takes no options. Arguably, this is a bug
 349
 350 =cut
 351
 352 sub _SetLastUpdated {
 353     my $self = shift;
 354     use RT::Date;
 355     my $now = new RT::Date( $self->CurrentUser );
 356     $now->SetToNow();
 357
 358     if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
 359         my ( $msg, $val ) = $self->__Set(
 360             Field => 'LastUpdated',
 361             Value => $now->ISO
 362         );
 363     }
 364     if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
 365         my ( $msg, $val ) = $self->__Set(
 366             Field => 'LastUpdatedBy',
 367             Value => $self->CurrentUser->id
 368         );
 369     }
 370 }
 371
 372 # }}}
 373
 374 # {{{ sub CreatorObj
 375
 376 =head2 CreatorObj
 377
 378 Returns an RT::User object with the RT account of the creator of this row
 379
 380 =cut
 381
 382 sub CreatorObj {
 383     my $self = shift;
 384     unless ( exists $self->{'CreatorObj'} ) {
 385
 386         $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
 387         $self->{'CreatorObj'}->Load( $self->Creator );
 388     }
 389     return ( $self->{'CreatorObj'} );
 390 }
 391
 392 # }}}
 393
 394 # {{{ sub LastUpdatedByObj
 395
 396 =head2 LastUpdatedByObj
 397
 398   Returns an RT::User object of the last user to touch this object
 399
 400 =cut
 401
 402 sub LastUpdatedByObj {
 403     my $self = shift;
 404     unless ( exists $self->{LastUpdatedByObj} ) {
 405         $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
 406         $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
 407     }
 408     return $self->{'LastUpdatedByObj'};
 409 }
 410
 411 # }}}
 412
 413
 414 require Encode::compat if $] < 5.007001;
 415 require Encode;
 416
 417 sub __Value {
 418     my $self  = shift;
 419     my $field = shift;
 420     my %args = ( decode_utf8 => 1,
 421                  @_ );
 422
 423     unless (defined $field && $field) {
 424         $RT::Logger->error("$self __Value called with undef field");
 425     }
 426     my $value = $self->SUPER::__Value($field);
 427
 428     return('') if ( !defined($value) || $value eq '');
 429
 430     return Encode::decode_utf8($value) || $value if $args{'decode_utf8'};
 431     return $value;
 432 }
 433
 434 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
 435
 436 sub _CacheConfig {
 437   {
 438      'cache_p'        => 1,
 439      'fast_update_p'  => 1,
 440      'cache_for_sec'  => 30,
 441   }
 442 }
 443
 444 =head2 _DecodeUTF8
 445
 446  When passed a string will "decode" it int a proper UTF-8 string
 447
 448 =cut
 449
 450 eval "require RT::Record_Vendor";
 451 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
 452 eval "require RT::Record_Local";
 453 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});
 454
 455 1;