projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge branch 'patch-7' of https://github.com/gjones2/Freeside (#13854 as this bug...
[freeside.git] / rt / lib / RT / Record.pm
diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm
index c87626a..313888c 100755 (executable)
--- a/rt/lib/RT/Record.pm
+++ b/rt/lib/RT/Record.pm
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -66,6 +66,7 @@ package RT::Record;
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
+
 use RT::Date;
 use RT::I18N;
 use RT::User;
 use RT::Date;
 use RT::I18N;
 use RT::User;
@@ -73,17 +74,9 @@ use RT::Attributes;
 use Encode qw();
 
 our $_TABLE_ATTR = { };
 use Encode qw();
 
 our $_TABLE_ATTR = { };
+use base RT->Config->Get('RecordBaseClass');
+use base 'RT::Base';
 
 
-use RT::Base;
-my $base = 'DBIx::SearchBuilder::Record::Cachable';
-if ( $RT::Config && $RT::Config->Get('DontCacheSearchBuilderRecords') ) {
-    $base = 'DBIx::SearchBuilder::Record';
-}
-eval "require $base" or die $@;
-our @ISA = 'RT::Base';
-push @ISA, $base;
-
-# {{{ sub _Init 
 
 sub _Init {
     my $self = shift;
 
 sub _Init {
     my $self = shift;
@@ -91,9 +84,7 @@ sub _Init {
     $self->CurrentUser(@_);
 }
 
     $self->CurrentUser(@_);
 }
 
-# }}}
 
 
-# {{{ _PrimaryKeys
 
 =head2 _PrimaryKeys
 
 
 =head2 _PrimaryKeys
 
@@ -102,8 +93,23 @@ The primary keys for RT classes is 'id'
 =cut
 
 sub _PrimaryKeys { return ['id'] }
 =cut
 
 sub _PrimaryKeys { return ['id'] }
+# short circuit many, many thousands of calls from searchbuilder
+sub _PrimaryKey { 'id' }
 
 
-# }}}
+=head2 Id
+
+Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
+on a very common codepath
+
+C<id> is an alias to C<Id> and is the preferred way to call this method.
+
+=cut
+
+sub Id {
+    return shift->{'values'}->{id};
+}
+
+*id = \&Id;
 
 =head2 Delete
 
 
 =head2 Delete
 
@@ -147,13 +153,12 @@ Return this object's attributes as an RT::Attributes object
 
 sub Attributes {
     my $self = shift;
 
 sub Attributes {
     my $self = shift;
-    
     unless ($self->{'attributes'}) {
     unless ($self->{'attributes'}) {
-        $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);     
-       $self->{'attributes'}->LimitToObject($self); 
+        $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
+        $self->{'attributes'}->LimitToObject($self);
+        $self->{'attributes'}->OrderByCols({FIELD => 'id'});
     }
     }
-    return ($self->{'attributes'}); 
-
+    return ($self->{'attributes'});
 }
 
 
 }
 
 
@@ -220,17 +225,17 @@ Deletes all attributes with the matching name for this object.
 sub DeleteAttribute {
     my $self = shift;
     my $name = shift;
 sub DeleteAttribute {
     my $self = shift;
     my $name = shift;
-    return $self->Attributes->DeleteEntry( Name => $name );
+    my ($val,$msg) =  $self->Attributes->DeleteEntry( Name => $name );
+    $self->ClearAttributes;
+    return ($val,$msg);
 }
 
 =head2 FirstAttribute NAME
 
 Returns the first attribute with the matching name for this object (as an
 L<RT::Attribute> object), or C<undef> if no such attributes exist.
 }
 
 =head2 FirstAttribute NAME
 
 Returns the first attribute with the matching name for this object (as an
 L<RT::Attribute> object), or C<undef> if no such attributes exist.
-
-Note that if there is more than one attribute with the matching name on the
-object, the choice of which one to return is basically arbitrary.  This may be
-made well-defined in the future.
+If there is more than one attribute with the matching name on the
+object, the first value that was set is returned.
 
 =cut
 
 
 =cut
 
@@ -241,12 +246,15 @@ sub FirstAttribute {
 }
 
 
 }
 
 
-# {{{ sub _Handle 
+sub ClearAttributes {
+    my $self = shift;
+    delete $self->{'attributes'};
+
+}
+
 sub _Handle { return $RT::Handle }
 
 sub _Handle { return $RT::Handle }
 
-# }}}
 
 
-# {{{ sub Create 
 
 =head2  Create PARAMHASH
 
 
 =head2  Create PARAMHASH
 
@@ -258,14 +266,26 @@ an error.
 If this object's table has any of the following atetributes defined as
 'Auto', this routine will automatically fill in their values.
 
 If this object's table has any of the following atetributes defined as
 'Auto', this routine will automatically fill in their values.
 
+=over
+
+=item Created
+
+=item Creator
+
+=item LastUpdated
+
+=item LastUpdatedBy
+
+=back
+
 =cut
 
 sub Create {
     my $self    = shift;
     my %attribs = (@_);
     foreach my $key ( keys %attribs ) {
 =cut
 
 sub Create {
     my $self    = shift;
     my %attribs = (@_);
     foreach my $key ( keys %attribs ) {
-        my $method = "Validate$key";
-        unless ( $self->$method( $attribs{$key} ) ) {
+        if (my $method = $self->can("Validate$key")) {
+        if (! $method->( $self, $attribs{$key} ) ) {
             if (wantarray) {
                 return ( 0, $self->loc('Invalid value for [_1]', $key) );
             }
             if (wantarray) {
                 return ( 0, $self->loc('Invalid value for [_1]', $key) );
             }
@@ -273,15 +293,22 @@ sub Create {
                 return (0);
             }
         }
                 return (0);
             }
         }
+        }
     }
     }
-    my $now = RT::Date->new( $self->CurrentUser );
-    $now->Set( Format => 'unix', Value => time );
-    $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
+
+
+
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
+
+    my $now_iso =
+     sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
+
+    $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
 
     if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
          $attribs{'Creator'} = $self->CurrentUser->id || '0'; 
     }
 
     if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
          $attribs{'Creator'} = $self->CurrentUser->id || '0'; 
     }
-    $attribs{'LastUpdated'} = $now->ISO()
+    $attribs{'LastUpdated'} = $now_iso
       if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
 
     $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
       if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
 
     $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
@@ -331,9 +358,7 @@ sub Create {
 
 }
 
 
 }
 
-# }}}
 
 
-# {{{ sub LoadByCols
 
 =head2 LoadByCols
 
 
 =head2 LoadByCols
 
@@ -346,7 +371,7 @@ sub LoadByCols {
     my $self = shift;
 
     # We don't want to hang onto this
     my $self = shift;
 
     # We don't want to hang onto this
-    delete $self->{'attributes'};
+    $self->ClearAttributes;
 
     return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
 
 
     return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
 
@@ -369,38 +394,31 @@ sub LoadByCols {
     return $self->SUPER::LoadByCols( %hash );
 }
 
     return $self->SUPER::LoadByCols( %hash );
 }
 
-# }}}
 
 
-# {{{ Datehandling
 
 # There is room for optimizations in most of those subs:
 
 
 # There is room for optimizations in most of those subs:
 
-# {{{ LastUpdatedObj
 
 sub LastUpdatedObj {
     my $self = shift;
 
 sub LastUpdatedObj {
     my $self = shift;
-    my $obj  = new RT::Date( $self->CurrentUser );
+    my $obj  = RT::Date->new( $self->CurrentUser );
 
     $obj->Set( Format => 'sql', Value => $self->LastUpdated );
     return $obj;
 }
 
 
     $obj->Set( Format => 'sql', Value => $self->LastUpdated );
     return $obj;
 }
 
-# }}}
 
 
-# {{{ CreatedObj
 
 sub CreatedObj {
     my $self = shift;
 
 sub CreatedObj {
     my $self = shift;
-    my $obj  = new RT::Date( $self->CurrentUser );
+    my $obj  = RT::Date->new( $self->CurrentUser );
 
     $obj->Set( Format => 'sql', Value => $self->Created );
 
     return $obj;
 }
 
 
     $obj->Set( Format => 'sql', Value => $self->Created );
 
     return $obj;
 }
 
-# }}}
 
 
-# {{{ AgeAsString
 #
 # TODO: This should be deprecated
 #
 #
 # TODO: This should be deprecated
 #
@@ -409,9 +427,7 @@ sub AgeAsString {
     return ( $self->CreatedObj->AgeAsString() );
 }
 
     return ( $self->CreatedObj->AgeAsString() );
 }
 
-# }}}
 
 
-# {{{ LastUpdatedAsString
 
 # TODO this should be deprecated
 
 
 # TODO this should be deprecated
 
@@ -426,9 +442,7 @@ sub LastUpdatedAsString {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# {{{ CreatedAsString
 #
 # TODO This should be deprecated 
 #
 #
 # TODO This should be deprecated 
 #
@@ -437,9 +451,7 @@ sub CreatedAsString {
     return ( $self->CreatedObj->AsString() );
 }
 
     return ( $self->CreatedObj->AsString() );
 }
 
-# }}}
 
 
-# {{{ LongSinceUpdateAsString
 #
 # TODO This should be deprecated
 #
 #
 # TODO This should be deprecated
 #
@@ -455,11 +467,8 @@ sub LongSinceUpdateAsString {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# }}} Datehandling
 
 
-# {{{ sub _Set 
 #
 sub _Set {
     my $self = shift;
 #
 sub _Set {
     my $self = shift;
@@ -496,7 +505,7 @@ sub _Set {
           $self->loc(
             "[_1] changed from [_2] to [_3]",
             $self->loc( $args{'Field'} ),
           $self->loc(
             "[_1] changed from [_2] to [_3]",
             $self->loc( $args{'Field'} ),
-            ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
+            ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
             '"' . $self->__Value( $args{'Field'}) . '"' 
           );
       } else {
             '"' . $self->__Value( $args{'Field'}) . '"' 
           );
       } else {
@@ -507,9 +516,7 @@ sub _Set {
 
 }
 
 
 }
 
-# }}}
 
 
-# {{{ sub _SetLastUpdated
 
 =head2 _SetLastUpdated
 
 
 =head2 _SetLastUpdated
 
@@ -521,7 +528,7 @@ It takes no options. Arguably, this is a bug
 sub _SetLastUpdated {
     my $self = shift;
     use RT::Date;
 sub _SetLastUpdated {
     my $self = shift;
     use RT::Date;
-    my $now = new RT::Date( $self->CurrentUser );
+    my $now = RT::Date->new( $self->CurrentUser );
     $now->SetToNow();
 
     if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
     $now->SetToNow();
 
     if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
@@ -538,9 +545,7 @@ sub _SetLastUpdated {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# {{{ sub CreatorObj 
 
 =head2 CreatorObj
 
 
 =head2 CreatorObj
 
@@ -558,9 +563,7 @@ sub CreatorObj {
     return ( $self->{'CreatorObj'} );
 }
 
     return ( $self->{'CreatorObj'} );
 }
 
-# }}}
 
 
-# {{{ sub LastUpdatedByObj
 
 =head2 LastUpdatedByObj
 
 
 =head2 LastUpdatedByObj
 
@@ -577,9 +580,7 @@ sub LastUpdatedByObj {
     return $self->{'LastUpdatedByObj'};
 }
 
     return $self->{'LastUpdatedByObj'};
 }
 
-# }}}
 
 
-# {{{ sub URI 
 
 =head2 URI
 
 
 =head2 URI
 
@@ -593,7 +594,6 @@ sub URI {
     return($uri->URIForObject($self));
 }
 
     return($uri->URIForObject($self));
 }
 
-# }}}
 
 =head2 ValidateName NAME
 
 
 =head2 ValidateName NAME
 
@@ -604,10 +604,10 @@ Validate the name of the record we're creating. Mostly, just make sure it's not
 sub ValidateName {
     my $self = shift;
     my $value = shift;
 sub ValidateName {
     my $self = shift;
     my $value = shift;
-    if ($value && $value=~ /^\d+$/) {
+    if (defined $value && $value=~ /^\d+$/) {
         return(0);
     } else  {
         return(0);
     } else  {
-         return (1);
+        return(1);
     }
 }
 
     }
 }
 
@@ -631,19 +631,29 @@ sub SQLType {
 sub __Value {
     my $self  = shift;
     my $field = shift;
 sub __Value {
     my $self  = shift;
     my $field = shift;
-    my %args = ( decode_utf8 => 1, @_ );
+    my %args  = ( decode_utf8 => 1, @_ );
 
 
-    unless ( $field ) {
+    unless ($field) {
         $RT::Logger->error("__Value called with undef field");
     }
 
         $RT::Logger->error("__Value called with undef field");
     }
 
-    my $value = $self->SUPER::__Value( $field );
-    if( $args{'decode_utf8'} ) {
-        return Encode::decode_utf8( $value ) unless Encode::is_utf8( $value );
-    } else {
-        return Encode::encode_utf8( $value ) if Encode::is_utf8( $value );
+    my $value = $self->SUPER::__Value($field);
+
+    return undef if (!defined $value);
+
+    if ( $args{'decode_utf8'} ) {
+        if ( !utf8::is_utf8($value) ) {
+            utf8::decode($value);
+        }
     }
     }
+    else {
+        if ( utf8::is_utf8($value) ) {
+            utf8::encode($value);
+        }
+    }
+
     return $value;
     return $value;
+
 }
 
 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
 }
 
 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
@@ -669,8 +679,8 @@ sub _BuildTableAttributes {
 
     }
 
 
     }
 
-    foreach my $column (%$attributes) {
-        foreach my $attr ( %{ $attributes->{$column} } ) {
+    foreach my $column (keys %$attributes) {
+        foreach my $attr ( keys %{ $attributes->{$column} } ) {
             $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
         }
     }
             $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
         }
     }
@@ -678,8 +688,8 @@ sub _BuildTableAttributes {
         next unless UNIVERSAL::can( $self, $method );
         $attributes = $self->$method();
 
         next unless UNIVERSAL::can( $self, $method );
         $attributes = $self->$method();
 
-        foreach my $column (%$attributes) {
-            foreach my $attr ( %{ $attributes->{$column} } ) {
+        foreach my $column ( keys %$attributes ) {
+            foreach my $attr ( keys %{ $attributes->{$column} } ) {
                 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
             }
         }
                 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
             }
         }
@@ -725,6 +735,7 @@ sub _EncodeLOB {
         my $self = shift;
         my $Body = shift;
         my $MIMEType = shift || '';
         my $self = shift;
         my $Body = shift;
         my $MIMEType = shift || '';
+        my $Filename = shift;
 
         my $ContentEncoding = 'none';
 
 
         my $ContentEncoding = 'none';
 
@@ -734,8 +745,7 @@ sub _EncodeLOB {
         #if the current attachment contains nulls and the
         #database doesn't support embedded nulls
 
         #if the current attachment contains nulls and the
         #database doesn't support embedded nulls
 
-        if ( RT->Config->Get('AlwaysUseBase64') or
-             ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
+        if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
 
             # set a flag telling us to mimencode the attachment
             $ContentEncoding = 'base64';
 
             # set a flag telling us to mimencode the attachment
             $ContentEncoding = 'base64';
@@ -768,7 +778,8 @@ sub _EncodeLOB {
                 $RT::Logger->info( "$self: Dropped an attachment of size "
                                    . length($Body));
                 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
                 $RT::Logger->info( "$self: Dropped an attachment of size "
                                    . length($Body));
                 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
-                return ("none", "Large attachment dropped" );
+                $Filename .= ".txt" if $Filename;
+                return ("none", "Large attachment dropped", "plain/text", $Filename );
             }
         }
 
             }
         }
 
@@ -785,7 +796,7 @@ sub _EncodeLOB {
         }
 
 
         }
 
 
-        return ($ContentEncoding, $Body);
+        return ($ContentEncoding, $Body, $MIMEType, $Filename );
 
 }
 
 
 }
 
@@ -804,7 +815,6 @@ sub _DecodeLOB {
     elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
     }
     elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
     }
-
     if ( RT::I18N::IsTextualContentType($ContentType) ) {
        $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
     }
     if ( RT::I18N::IsTextualContentType($ContentType) ) {
        $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
     }
@@ -855,8 +865,9 @@ sub Update {
 
     my $attributes = $args{'AttributesRef'};
     my $ARGSRef    = $args{'ARGSRef'};
 
     my $attributes = $args{'AttributesRef'};
     my $ARGSRef    = $args{'ARGSRef'};
-    my @results;
+    my %new_values;
 
 
+    # gather all new values
     foreach my $attribute (@$attributes) {
         my $value;
         if ( defined $ARGSRef->{$attribute} ) {
     foreach my $attribute (@$attributes) {
         my $value;
         if ( defined $ARGSRef->{$attribute} ) {
@@ -877,7 +888,6 @@ sub Update {
 
         $value =~ s/\r\n/\n/gs;
 
 
         $value =~ s/\r\n/\n/gs;
 
-
         # If Queue is 'General', we want to resolve the queue name for
         # the object.
 
         # If Queue is 'General', we want to resolve the queue name for
         # the object.
 
@@ -896,6 +906,29 @@ sub Update {
             next if ($value || 0) eq $self->$attribute();
         };
 
             next if ($value || 0) eq $self->$attribute();
         };
 
+        $new_values{$attribute} = $value;
+    }
+
+    return $self->_UpdateAttributes(
+        Attributes => $attributes,
+        NewValues  => \%new_values,
+    );
+}
+
+sub _UpdateAttributes {
+    my $self = shift;
+    my %args = (
+        Attributes => [],
+        NewValues  => {},
+        @_,
+    );
+
+    my @results;
+
+    foreach my $attribute (@{ $args{Attributes} }) {
+        next if !exists($args{NewValues}{$attribute});
+
+        my $value = $args{NewValues}{$attribute};
         my $method = "Set$attribute";
         my ( $code, $msg ) = $self->$method($value);
         my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
         my $method = "Set$attribute";
         my ( $code, $msg ) = $self->$method($value);
         my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
@@ -911,6 +944,7 @@ sub Update {
     "User" # loc
     "Group" # loc
     "Queue" # loc
     "User" # loc
     "Group" # loc
     "Queue" # loc
+
 =cut
 
         push @results, $self->loc( $prefix ) . " $label: ". $msg;
 =cut
 
         push @results, $self->loc( $prefix ) . " $label: ". $msg;
@@ -919,7 +953,7 @@ sub Update {
 
                                    "[_1] could not be set to [_2].",       # loc
                                    "That is already the current value",    # loc
 
                                    "[_1] could not be set to [_2].",       # loc
                                    "That is already the current value",    # loc
-                                   "No value sent to _Set!\n",             # loc
+                                   "No value sent to _Set!",               # loc
                                    "Illegal value for [_1]",               # loc
                                    "The new value has been set.",          # loc
                                    "No column specified",                  # loc
                                    "Illegal value for [_1]",               # loc
                                    "The new value has been set.",          # loc
                                    "No column specified",                  # loc
@@ -937,11 +971,8 @@ sub Update {
     return @results;
 }
 
     return @results;
 }
 
-# {{{ Routines dealing with Links
 
 
-# {{{ Link Collections
 
 
-# {{{ sub Members
 
 =head2 Members
 
 
 =head2 Members
 
@@ -955,9 +986,7 @@ sub Members {
     return ( $self->_Links( 'Target', 'MemberOf' ) );
 }
 
     return ( $self->_Links( 'Target', 'MemberOf' ) );
 }
 
-# }}}
 
 
-# {{{ sub MemberOf
 
 =head2 MemberOf
 
 
 =head2 MemberOf
 
@@ -971,9 +1000,7 @@ sub MemberOf {
     return ( $self->_Links( 'Base', 'MemberOf' ) );
 }
 
     return ( $self->_Links( 'Base', 'MemberOf' ) );
 }
 
-# }}}
 
 
-# {{{ RefersTo
 
 =head2 RefersTo
 
 
 =head2 RefersTo
 
@@ -986,9 +1013,7 @@ sub RefersTo {
     return ( $self->_Links( 'Base', 'RefersTo' ) );
 }
 
     return ( $self->_Links( 'Base', 'RefersTo' ) );
 }
 
-# }}}
 
 
-# {{{ ReferredToBy
 
 =head2 ReferredToBy
 
 
 =head2 ReferredToBy
 
@@ -1001,9 +1026,7 @@ sub ReferredToBy {
     return ( $self->_Links( 'Target', 'RefersTo' ) );
 }
 
     return ( $self->_Links( 'Target', 'RefersTo' ) );
 }
 
-# }}}
 
 
-# {{{ DependedOnBy
 
 =head2 DependedOnBy
 
 
 =head2 DependedOnBy
 
@@ -1016,7 +1039,6 @@ sub DependedOnBy {
     return ( $self->_Links( 'Target', 'DependsOn' ) );
 }
 
     return ( $self->_Links( 'Target', 'DependsOn' ) );
 }
 
-# }}}
 
 
 
 
 
 
@@ -1056,7 +1078,6 @@ sub HasUnresolvedDependencies {
 }
 
 
 }
 
 
-# {{{ UnresolvedDependencies 
 
 =head2 UnresolvedDependencies
 
 
 =head2 UnresolvedDependencies
 
@@ -1081,9 +1102,7 @@ sub UnresolvedDependencies {
 
 }
 
 
 }
 
-# }}}
 
 
-# {{{ AllDependedOnBy
 
 =head2 AllDependedOnBy
 
 
 =head2 AllDependedOnBy
 
@@ -1140,7 +1159,7 @@ sub _AllLinkedTickets {
            $args{_found}{$obj->Id} = $obj;
            $obj->_AllLinkedTickets( %args, _top => 0 );
        }
            $args{_found}{$obj->Id} = $obj;
            $obj->_AllLinkedTickets( %args, _top => 0 );
        }
-       elsif ($obj->Type eq $args{Type}) {
+       elsif ($obj->Type and $obj->Type eq $args{Type}) {
            $args{_found}{$obj->Id} = $obj;
        }
        else {
            $args{_found}{$obj->Id} = $obj;
        }
        else {
@@ -1156,9 +1175,7 @@ sub _AllLinkedTickets {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# {{{ DependsOn
 
 =head2 DependsOn
 
 
 =head2 DependsOn
 
@@ -1177,7 +1194,9 @@ sub DependsOn {
 
 =head2 Customers
 
 
 =head2 Customers
 
-  This returns an RT::Links object which references all the customers that this object is a member of.
+  This returns an RT::Links object which references all the customers that 
+  this object is a member of.  This includes both explicitly linked customers
+  and links implied by services.
 
 =cut
 
 
 =cut
 
@@ -1189,11 +1208,16 @@ sub Customers {
 
       $self->{'Customers'} = $self->MemberOf->Clone;
 
 
       $self->{'Customers'} = $self->MemberOf->Clone;
 
-      $self->{'Customers'}->Limit(
-                                   FIELD    => 'Target',
-                                   OPERATOR => 'STARTSWITH',
-                                   VALUE    => 'freeside://freeside/cust_main/',
-                                 );
+      for my $fstable (qw(cust_main cust_svc)) {
+
+        $self->{'Customers'}->Limit(
+                                     FIELD    => 'Target',
+                                     OPERATOR => 'STARTSWITH',
+                                     VALUE    => "freeside://freeside/$fstable",
+                                     ENTRYAGGREGATOR => 'OR',
+                                     SUBCLAUSE => 'customers',
+                                   );
+      }
     }
 
     warn "->Customers method called on $self; returning ".
     }
 
     warn "->Customers method called on $self; returning ".
@@ -1205,7 +1229,36 @@ sub Customers {
 
 # }}}
 
 
 # }}}
 
-# {{{ sub _Links 
+# {{{ Services
+
+=head2 Services
+
+  This returns an RT::Links object which references all the services this 
+  object is a member of.
+
+=cut
+
+sub Services {
+    my( $self, %opt ) = @_;
+
+    unless ( $self->{'Services'} ) {
+
+      $self->{'Services'} = $self->MemberOf->Clone;
+
+      $self->{'Services'}->Limit(
+                                   FIELD    => 'Target',
+                                   OPERATOR => 'STARTSWITH',
+                                   VALUE    => "freeside://freeside/cust_svc",
+                                 );
+    }
+
+    return $self->{'Services'};
+}
+
+
+
+
+
 
 =head2 Links DIRECTION [TYPE]
 
 
 =head2 Links DIRECTION [TYPE]
 
@@ -1218,7 +1271,7 @@ links of any type.
 
 =cut
 
 
 =cut
 
-*Links = \&_Links;
+sub Links { shift->_Links(@_) }
 
 sub _Links {
     my $self = shift;
 
 sub _Links {
     my $self = shift;
@@ -1229,7 +1282,7 @@ sub _Links {
     my $type  = shift || "";
 
     unless ( $self->{"$field$type"} ) {
     my $type  = shift || "";
 
     unless ( $self->{"$field$type"} ) {
-        $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
+        $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
             # at least to myself
             $self->{"$field$type"}->Limit( FIELD => $field,
                                            VALUE => $self->URI,
             # at least to myself
             $self->{"$field$type"}->Limit( FIELD => $field,
                                            VALUE => $self->URI,
@@ -1241,11 +1294,8 @@ sub _Links {
     return ( $self->{"$field$type"} );
 }
 
     return ( $self->{"$field$type"} );
 }
 
-# }}}
 
 
-# }}}
 
 
-# {{{ sub FormatType
 
 =head2 FormatType
 
 
 =head2 FormatType
 
@@ -1264,9 +1314,7 @@ sub FormatType{
 }
 
 
 }
 
 
-# }}}
 
 
-# {{{ sub FormatLink
 
 =head2 FormatLink
 
 
 =head2 FormatLink
 
@@ -1287,9 +1335,7 @@ sub FormatLink {
     return $text;
 }
 
     return $text;
 }
 
-# }}}
 
 
-# {{{ sub _AddLink
 
 =head2 _AddLink
 
 
 =head2 _AddLink
 
@@ -1331,7 +1377,7 @@ sub _AddLink {
         return ( 0, $self->loc('Either base or target must be specified') );
     }
 
         return ( 0, $self->loc('Either base or target must be specified') );
     }
 
-    # {{{ Check if the link already exists - we don't want duplicates
+    # Check if the link already exists - we don't want duplicates
     use RT::Link;
     my $old_link = RT::Link->new( $self->CurrentUser );
     $old_link->LoadByParams( Base   => $args{'Base'},
     use RT::Link;
     my $old_link = RT::Link->new( $self->CurrentUser );
     $old_link->LoadByParams( Base   => $args{'Base'},
@@ -1366,9 +1412,7 @@ sub _AddLink {
     return ( $linkid, $TransString ) ;
 }
 
     return ( $linkid, $TransString ) ;
 }
 
-# }}}
 
 
-# {{{ sub _DeleteLink 
 
 =head2 _DeleteLink
 
 
 =head2 _DeleteLink
 
@@ -1412,7 +1456,7 @@ sub _DeleteLink {
         return ( 0, $self->loc('Either base or target must be specified') );
     }
 
         return ( 0, $self->loc('Either base or target must be specified') );
     }
 
-    my $link = new RT::Link( $self->CurrentUser );
+    my $link = RT::Link->new( $self->CurrentUser );
     $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
 
 
     $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
 
 
@@ -1438,13 +1482,36 @@ sub _DeleteLink {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# }}}
+=head1 LockForUpdate
+
+In a database transaction, gains an exclusive lock on the row, to
+prevent race conditions.  On SQLite, this is a "RESERVED" lock on the
+entire database.
 
 
-# {{{ Routines dealing with transactions
+=cut
+
+sub LockForUpdate {
+    my $self = shift;
 
 
-# {{{ sub _NewTransaction
+    my $pk = $self->_PrimaryKey;
+    my $id = @_ ? $_[0] : $self->$pk;
+    $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
+    if (RT->Config->Get('DatabaseType') eq "SQLite") {
+        # SQLite does DB-level locking, upgrading the transaction to
+        # "RESERVED" on the first UPDATE/INSERT/DELETE.  Do a no-op
+        # UPDATE to force the upgade.
+        return RT->DatabaseHandle->dbh->do(
+            "UPDATE " .$self->Table.
+                " SET $pk = $pk WHERE 1 = 0");
+    } else {
+        return $self->_LoadFromSQL(
+            "SELECT * FROM ".$self->Table
+                ." WHERE $pk = ? FOR UPDATE",
+            $id,
+        );
+    }
+}
 
 =head2 _NewTransaction  PARAMHASH
 
 
 =head2 _NewTransaction  PARAMHASH
 
@@ -1467,9 +1534,16 @@ sub _NewTransaction {
         MIMEObj   => undef,
         ActivateScrips => 1,
         CommitScrips => 1,
         MIMEObj   => undef,
         ActivateScrips => 1,
         CommitScrips => 1,
+        SquelchMailTo => undef,
+        CustomFields => {},
         @_
     );
 
         @_
     );
 
+    my $in_txn = RT->DatabaseHandle->TransactionDepth;
+    RT->DatabaseHandle->BeginTransaction unless $in_txn;
+
+    $self->LockForUpdate;
+
     my $old_ref = $args{'OldReference'};
     my $new_ref = $args{'NewReference'};
     my $ref_type = $args{'ReferenceType'};
     my $old_ref = $args{'OldReference'};
     my $new_ref = $args{'NewReference'};
     my $ref_type = $args{'ReferenceType'};
@@ -1484,7 +1558,7 @@ sub _NewTransaction {
     }
 
     require RT::Transaction;
     }
 
     require RT::Transaction;
-    my $trans = new RT::Transaction( $self->CurrentUser );
+    my $trans = RT::Transaction->new( $self->CurrentUser );
     my ( $transaction, $msg ) = $trans->Create(
        ObjectId  => $self->Id,
        ObjectType => ref($self),
     my ( $transaction, $msg ) = $trans->Create(
        ObjectId  => $self->Id,
        ObjectType => ref($self),
@@ -1500,6 +1574,8 @@ sub _NewTransaction {
         MIMEObj   => $args{'MIMEObj'},
         ActivateScrips => $args{'ActivateScrips'},
         CommitScrips => $args{'CommitScrips'},
         MIMEObj   => $args{'MIMEObj'},
         ActivateScrips => $args{'ActivateScrips'},
         CommitScrips => $args{'CommitScrips'},
+        SquelchMailTo => $args{'SquelchMailTo'},
+        CustomFields => $args{'CustomFields'},
     );
 
     # Rationalize the object since we may have done things to it during the caching.
     );
 
     # Rationalize the object since we may have done things to it during the caching.
@@ -1515,12 +1591,13 @@ sub _NewTransaction {
     if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
            push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
     }
     if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
            push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
     }
+
+    RT->DatabaseHandle->Commit unless $in_txn;
+
     return ( $transaction, $msg, $trans );
 }
 
     return ( $transaction, $msg, $trans );
 }
 
-# }}}
 
 
-# {{{ sub Transactions 
 
 =head2 Transactions
 
 
 =head2 Transactions
 
@@ -1547,10 +1624,7 @@ sub Transactions {
     return ($transactions);
 }
 
     return ($transactions);
 }
 
-# }}}
-# }}}
 #
 #
-# {{{ Routines dealing with custom fields
 
 sub CustomFields {
     my $self = shift;
 
 sub CustomFields {
     my $self = shift;
@@ -1567,7 +1641,8 @@ sub CustomFields {
     return $cfs;
 }
 
     return $cfs;
 }
 
-# TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
+# TODO: This _only_ works for RT::Class classes. it doesn't work, for example,
+# for RT::IR classes.
 
 sub _LookupId {
     my $self = shift;
 
 sub _LookupId {
     my $self = shift;
@@ -1595,7 +1670,6 @@ sub CustomFieldLookupType {
     return ref($self);
 }
 
     return ref($self);
 }
 
-# {{{ AddCustomFieldValue
 
 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
 
 
 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
 
@@ -1638,7 +1712,7 @@ sub _AddCustomFieldValue {
             0,
             $self->loc(
                 "Custom field [_1] does not apply to this object",
             0,
             $self->loc(
                 "Custom field [_1] does not apply to this object",
-                $args{'Field'}
+                ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
             )
         );
     }
             )
         );
     }
@@ -1745,9 +1819,10 @@ sub _AddCustomFieldValue {
 
         my $new_content = $new_value->Content;
 
 
         my $new_content = $new_value->Content;
 
-        # For date, we need to display them in "human" format in result message
-        if ($cf->Type eq 'Date') {
-            my $DateObj = new RT::Date( $self->CurrentUser );
+        # For datetime, we need to display them in "human" format in result message
+        #XXX TODO how about date without time?
+        if ($cf->Type eq 'DateTime') {
+            my $DateObj = RT::Date->new( $self->CurrentUser );
             $DateObj->Set(
                 Format => 'ISO',
                 Value  => $new_content,
             $DateObj->Set(
                 Format => 'ISO',
                 Value  => $new_content,
@@ -1803,9 +1878,7 @@ sub _AddCustomFieldValue {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# {{{ DeleteCustomFieldValue
 
 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
 
 
 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
 
@@ -1852,9 +1925,9 @@ sub DeleteCustomFieldValue {
     }
 
     my $old_value = $TransactionObj->OldValue;
     }
 
     my $old_value = $TransactionObj->OldValue;
-    # For date, we need to display them in "human" format in result message
-    if ( $cf->Type eq 'Date' ) {
-        my $DateObj = new RT::Date( $self->CurrentUser );
+    # For datetime, we need to display them in "human" format in result message
+    if ( $cf->Type eq 'DateTime' ) {
+        my $DateObj = RT::Date->new( $self->CurrentUser );
         $DateObj->Set(
             Format => 'ISO',
             Value  => $old_value,
         $DateObj->Set(
             Format => 'ISO',
             Value  => $old_value,
@@ -1870,9 +1943,7 @@ sub DeleteCustomFieldValue {
     );
 }
 
     );
 }
 
-# }}}
 
 
-# {{{ FirstCustomFieldValue
 
 =head2 FirstCustomFieldValue FIELD
 
 
 =head2 FirstCustomFieldValue FIELD
 
@@ -1914,7 +1985,6 @@ sub CustomFieldValuesAsString {
 }
 
 
 }
 
 
-# {{{ CustomFieldValues
 
 =head2 CustomFieldValues FIELD
 
 
 =head2 CustomFieldValues FIELD
 
@@ -1986,9 +2056,6 @@ sub WikiBase {
     return RT->Config->Get('WebPath'). "/index.html?q=";
 }
 
     return RT->Config->Get('WebPath'). "/index.html?q=";
 }
 
-eval "require RT::Record_Vendor";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
-eval "require RT::Record_Local";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});
+RT::Base->_ImportOverlays();
 
 1;
 
 1;
Freeside billing, trouble ticketing, network monitoring and provisioning