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                 my ($op, $val);
 215                 ($key, $op, $val) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key});
 216                 $newhash{$key}->{operator} = $op;
 217                 $newhash{$key}->{value} = $val;
 218             }
 219         }
 220
 221         # We've clobbered everything we care about. bash the old hash
 222         # and replace it with the new hash
 223         %hash = %newhash;
 224     }
 225     $self->SUPER::LoadByCols(%hash);
 226 }
 227
 228 # }}}
 229
 230 # {{{ Datehandling
 231
 232 # There is room for optimizations in most of those subs:
 233
 234 # {{{ LastUpdatedObj
 235
 236 sub LastUpdatedObj {
 237     my $self = shift;
 238     my $obj  = new RT::Date( $self->CurrentUser );
 239
 240     $obj->Set( Format => 'sql', Value => $self->LastUpdated );
 241     return $obj;
 242 }
 243
 244 # }}}
 245
 246 # {{{ CreatedObj
 247
 248 sub CreatedObj {
 249     my $self = shift;
 250     my $obj  = new RT::Date( $self->CurrentUser );
 251
 252     $obj->Set( Format => 'sql', Value => $self->Created );
 253
 254     return $obj;
 255 }
 256
 257 # }}}
 258
 259 # {{{ AgeAsString
 260 #
 261 # TODO: This should be deprecated
 262 #
 263 sub AgeAsString {
 264     my $self = shift;
 265     return ( $self->CreatedObj->AgeAsString() );
 266 }
 267
 268 # }}}
 269
 270 # {{{ LastUpdatedAsString
 271
 272 # TODO this should be deprecated
 273
 274 sub LastUpdatedAsString {
 275     my $self = shift;
 276     if ( $self->LastUpdated ) {
 277         return ( $self->LastUpdatedObj->AsString() );
 278
 279     }
 280     else {
 281         return "never";
 282     }
 283 }
 284
 285 # }}}
 286
 287 # {{{ CreatedAsString
 288 #
 289 # TODO This should be deprecated
 290 #
 291 sub CreatedAsString {
 292     my $self = shift;
 293     return ( $self->CreatedObj->AsString() );
 294 }
 295
 296 # }}}
 297
 298 # {{{ LongSinceUpdateAsString
 299 #
 300 # TODO This should be deprecated
 301 #
 302 sub LongSinceUpdateAsString {
 303     my $self = shift;
 304     if ( $self->LastUpdated ) {
 305
 306         return ( $self->LastUpdatedObj->AgeAsString() );
 307
 308     }
 309     else {
 310         return "never";
 311     }
 312 }
 313
 314 # }}}
 315
 316 # }}} Datehandling
 317
 318 # {{{ sub _Set
 319 sub _Set {
 320     my $self = shift;
 321
 322     my %args = (
 323         Field => undef,
 324         Value => undef,
 325         IsSQL => undef,
 326         @_
 327     );
 328
 329     #if the user is trying to modify the record
 330     # TODO: document _why_ this code is here
 331
 332     if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
 333         $args{'Value'} = 0;
 334     }
 335
 336     $self->_SetLastUpdated();
 337     my ( $val, $msg ) = $self->SUPER::_Set(
 338         Field => $args{'Field'},
 339         Value => $args{'Value'},
 340         IsSQL => $args{'IsSQL'}
 341     );
 342 }
 343
 344 # }}}
 345
 346 # {{{ sub _SetLastUpdated
 347
 348 =head2 _SetLastUpdated
 349
 350 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
 351 It takes no options. Arguably, this is a bug
 352
 353 =cut
 354
 355 sub _SetLastUpdated {
 356     my $self = shift;
 357     use RT::Date;
 358     my $now = new RT::Date( $self->CurrentUser );
 359     $now->SetToNow();
 360
 361     if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
 362         my ( $msg, $val ) = $self->__Set(
 363             Field => 'LastUpdated',
 364             Value => $now->ISO
 365         );
 366     }
 367     if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
 368         my ( $msg, $val ) = $self->__Set(
 369             Field => 'LastUpdatedBy',
 370             Value => $self->CurrentUser->id
 371         );
 372     }
 373 }
 374
 375 # }}}
 376
 377 # {{{ sub CreatorObj
 378
 379 =head2 CreatorObj
 380
 381 Returns an RT::User object with the RT account of the creator of this row
 382
 383 =cut
 384
 385 sub CreatorObj {
 386     my $self = shift;
 387     unless ( exists $self->{'CreatorObj'} ) {
 388
 389         $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
 390         $self->{'CreatorObj'}->Load( $self->Creator );
 391     }
 392     return ( $self->{'CreatorObj'} );
 393 }
 394
 395 # }}}
 396
 397 # {{{ sub LastUpdatedByObj
 398
 399 =head2 LastUpdatedByObj
 400
 401   Returns an RT::User object of the last user to touch this object
 402
 403 =cut
 404
 405 sub LastUpdatedByObj {
 406     my $self = shift;
 407     unless ( exists $self->{LastUpdatedByObj} ) {
 408         $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
 409         $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
 410     }
 411     return $self->{'LastUpdatedByObj'};
 412 }
 413
 414 # }}}
 415
 416
 417 require Encode::compat if $] < 5.007001;
 418 require Encode;
 419
 420 sub __Value {
 421     my $self  = shift;
 422     my $field = shift;
 423     my %args = ( decode_utf8 => 1,
 424                  @_ );
 425
 426     unless (defined $field && $field) {
 427         $RT::Logger->error("$self __Value called with undef field");
 428     }
 429     my $value = $self->SUPER::__Value($field);
 430
 431     return('') if ( !defined($value) || $value eq '');
 432
 433     return Encode::decode_utf8($value) || $value if $args{'decode_utf8'};
 434     return $value;
 435 }
 436
 437 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
 438
 439 sub _CacheConfig {
 440   {
 441      'cache_p'        => 1,
 442      'fast_update_p'  => 1,
 443      'cache_for_sec'  => 30,
 444   }
 445 }
 446
 447 =head2 _DecodeUTF8
 448
 449  When passed a string will "decode" it int a proper UTF-8 string
 450
 451 =cut
 452
 453 eval "require RT::Record_Vendor";
 454 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
 455 eval "require RT::Record_Local";
 456 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});
 457
 458 1;