fix phantom customer links
[freeside.git] / rt / lib / RT / Record.pm
index a7598bf..8f1b5be 100755 (executable)
@@ -1,40 +1,40 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC 
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (Except where explicitly superseded by other copyright notices)
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
 # LICENSE:
-# 
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 # 02110-1301 or visit their web page on the internet at
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 # 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/copyleft/gpl.html.
-# 
-# 
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
 # CONTRIBUTION SUBMISSION POLICY:
 # CONTRIBUTION SUBMISSION POLICY:
-# 
+#
 # (The following paragraph is not intended to limit the rights granted
 # to you to modify and distribute this software under the terms of
 # the GNU General Public License and is only of importance to you if
 # you choose to contribute your changes and enhancements to the
 # community by submitting them to Best Practical Solutions, LLC.)
 # (The following paragraph is not intended to limit the rights granted
 # to you to modify and distribute this software under the terms of
 # the GNU General Public License and is only of importance to you if
 # you choose to contribute your changes and enhancements to the
 # community by submitting them to Best Practical Solutions, LLC.)
-# 
+#
 # By intentionally submitting any modifications, corrections or
 # derivatives to this work, or any other work intended for use with
 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
 # By intentionally submitting any modifications, corrections or
 # derivatives to this work, or any other work intended for use with
 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
@@ -43,8 +43,9 @@
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
-# 
+#
 # END BPS TAGGED BLOCK }}}
 # END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
   RT::Record - Base class for RT record objects
 =head1 NAME
 
   RT::Record - Base class for RT record objects
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
 
-=begin testing
-
-ok (require RT::Record);
-
-=end testing
 
 =head1 METHODS
 
 
 =head1 METHODS
 
@@ -70,36 +66,31 @@ package RT::Record;
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
-our @ISA;
-use base qw(RT::Base);
+use RT;
+use base RT->Config->Get('RecordBaseClass');
+use base 'RT::Base';
 
 
-use RT::Date;
-use RT::User;
-use RT::Attributes;
-use DBIx::SearchBuilder::Record::Cachable;
-use Encode qw();
+require RT::Date;
+require RT::User;
+require RT::Attributes;
+require RT::Transactions;
+require RT::Link;
+use RT::Shredder::Dependencies;
+use RT::Shredder::Constants;
+use RT::Shredder::Exceptions;
 
 our $_TABLE_ATTR = { };
 
 our $_TABLE_ATTR = { };
+use base RT->Config->Get('RecordBaseClass');
+use base 'RT::Base';
 
 
 
 
-if ( $RT::DontCacheSearchBuilderRecords ) {
-    push (@ISA, 'DBIx::SearchBuilder::Record');
-} else {
-    push (@ISA, 'DBIx::SearchBuilder::Record::Cachable');
-
-}
-
-# {{{ sub _Init 
-
 sub _Init {
     my $self = shift;
     $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
     $self->CurrentUser(@_);
 }
 
 sub _Init {
     my $self = shift;
     $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
     $self->CurrentUser(@_);
 }
 
-# }}}
 
 
-# {{{ _PrimaryKeys
 
 =head2 _PrimaryKeys
 
 
 =head2 _PrimaryKeys
 
@@ -107,12 +98,24 @@ The primary keys for RT classes is 'id'
 
 =cut
 
 
 =cut
 
-sub _PrimaryKeys {
-    my $self = shift;
-    return ( ['id'] );
+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
 
@@ -131,29 +134,39 @@ sub Delete {
     } 
 }
 
     } 
 }
 
-=head2 ObjectTypeStr
+=head2 RecordType
 
 
-Returns a string which is this object's type.  The type is the class,
-without the "RT::" prefix.
+Returns a string which is this record's type. It's not localized and by
+default last part (everything after last ::) of class name is returned.
+
+=cut
 
 
-=begin testing
+sub RecordType {
+    my $res = ref($_[0]) || $_[0];
+    $res =~ s/.*:://;
+    return $res;
+}
 
 
-my $ticket = RT::Ticket->new($RT::SystemUser);
-my $group = RT::Group->new($RT::SystemUser);
-is($ticket->ObjectTypeStr, 'Ticket', "Ticket returns correct typestring");
-is($group->ObjectTypeStr, 'Group', "Group returns correct typestring");
+=head2 ObjectTypeStr
 
 
-=end testing
+DEPRECATED. Stays here for backwards. Returns localized L</RecordType>.
 
 =cut
 
 
 =cut
 
+# we deprecate because of:
+# * ObjectType is used in several classes with ObjectId to store
+#   records of different types, for example transactions use those
+#   and it's unclear what this method should return 'Transaction'
+#   or type of referenced record
+# * returning localized thing is not good idea
+
 sub ObjectTypeStr {
     my $self = shift;
 sub ObjectTypeStr {
     my $self = shift;
-    if (ref($self) =~ /^.*::(\w+)$/) {
-       return $self->loc($1);
-    } else {
-       return $self->loc(ref($self));
-    }
+    RT->Deprecated(
+        Remove => "4.4",
+        Instead => "RecordType",
+    );
+    return $self->loc( $self->RecordType( @_ ) );
 }
 
 =head2 Attributes
 }
 
 =head2 Attributes
@@ -164,13 +177,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'});
 }
 
 
 }
 
 
@@ -237,17 +249,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
 
@@ -258,15 +270,15 @@ sub FirstAttribute {
 }
 
 
 }
 
 
-# {{{ sub _Handle 
-sub _Handle {
+sub ClearAttributes {
     my $self = shift;
     my $self = shift;
-    return ($RT::Handle);
+    delete $self->{'attributes'};
+
 }
 
 }
 
-# }}}
+sub _Handle { return $RT::Handle }
+
 
 
-# {{{ sub Create 
 
 =head2  Create PARAMHASH
 
 
 =head2  Create PARAMHASH
 
@@ -278,14 +290,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) );
             }
@@ -293,15 +317,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'
@@ -335,8 +366,6 @@ sub Create {
    }
 
     if  (UNIVERSAL::isa('errno',$id)) {
    }
 
     if  (UNIVERSAL::isa('errno',$id)) {
-        exit(0);
-       warn "It's here!";
         return(undef);
     }
 
         return(undef);
     }
 
@@ -353,9 +382,7 @@ sub Create {
 
 }
 
 
 }
 
-# }}}
 
 
-# {{{ sub LoadByCols
 
 =head2 LoadByCols
 
 
 =head2 LoadByCols
 
@@ -366,134 +393,98 @@ DB is case sensitive
 
 sub LoadByCols {
     my $self = shift;
 
 sub LoadByCols {
     my $self = shift;
-    my %hash = (@_);
 
     # We don't want to hang onto this
 
     # We don't want to hang onto this
-    delete $self->{'attributes'};
+    $self->ClearAttributes;
+
+    unless ( $self->_Handle->CaseSensitive ) {
+        my ( $ret, $msg ) = $self->SUPER::LoadByCols( @_ );
+        return wantarray ? ( $ret, $msg ) : $ret;
+    }
 
     # If this database is case sensitive we need to uncase objects for
     # explicit loading
 
     # If this database is case sensitive we need to uncase objects for
     # explicit loading
-    if ( $self->_Handle->CaseSensitive ) {
-        my %newhash;
-        foreach my $key ( keys %hash ) {
-
-            # If we've been passed an empty value, we can't do the lookup. 
-            # We don't need to explicitly downcase integers or an id.
-            if ( $key =~ '^id$'
-                || !defined( $hash{$key} )
-                || $hash{$key} =~ /^\d+$/
-                 )
-            {
-                $newhash{$key} = $hash{$key};
-            }
-            else {
-                my ($op, $val, $func);
-                ($key, $op, $val, $func) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key});
-                $newhash{$key}->{operator} = $op;
-                $newhash{$key}->{value} = $val;
-                $newhash{$key}->{function} = $func;
-            }
+    my %hash = (@_);
+    foreach my $key ( keys %hash ) {
+
+        # If we've been passed an empty value, we can't do the lookup. 
+        # We don't need to explicitly downcase integers or an id.
+        if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
+            my ($op, $val, $func);
+            ($key, $op, $val, $func) =
+                $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
+            $hash{$key}->{operator} = $op;
+            $hash{$key}->{value}    = $val;
+            $hash{$key}->{function} = $func;
         }
         }
-
-        # We've clobbered everything we care about. bash the old hash
-        # and replace it with the new hash
-        %hash = %newhash;
     }
     }
-    $self->SUPER::LoadByCols(%hash);
+    my ( $ret, $msg ) = $self->SUPER::LoadByCols( %hash );
+    return wantarray ? ( $ret, $msg ) : $ret;
 }
 
 }
 
-# }}}
 
 
-# {{{ 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
-#
+# B<DEPRECATED> and will be removed in 4.4
 sub AgeAsString {
     my $self = shift;
 sub AgeAsString {
     my $self = shift;
+    RT->Deprecated(
+        Remove => "4.4",
+        Instead => "->CreatedObj->AgeAsString",
+    );
     return ( $self->CreatedObj->AgeAsString() );
 }
 
     return ( $self->CreatedObj->AgeAsString() );
 }
 
-# }}}
-
-# {{{ LastUpdatedAsString
-
-# TODO this should be deprecated
+# B<DEPRECATED> and will be removed in 4.4
+sub LongSinceUpdateAsString {
+    my $self = shift;
+    RT->Deprecated(
+        Remove => "4.4",
+        Instead => "->LastUpdatedObj->AgeAsString",
+    );
+    if ( $self->LastUpdated ) {
+        return ( $self->LastUpdatedObj->AgeAsString() );
+    } else {
+        return "never";
+    }
+}
 
 sub LastUpdatedAsString {
     my $self = shift;
     if ( $self->LastUpdated ) {
         return ( $self->LastUpdatedObj->AsString() );
 
 sub LastUpdatedAsString {
     my $self = shift;
     if ( $self->LastUpdated ) {
         return ( $self->LastUpdatedObj->AsString() );
-
-    }
-    else {
+    } else {
         return "never";
     }
 }
 
         return "never";
     }
 }
 
-# }}}
-
-# {{{ CreatedAsString
-#
-# TODO This should be deprecated 
-#
 sub CreatedAsString {
     my $self = shift;
     return ( $self->CreatedObj->AsString() );
 }
 
 sub CreatedAsString {
     my $self = shift;
     return ( $self->CreatedObj->AsString() );
 }
 
-# }}}
-
-# {{{ LongSinceUpdateAsString
-#
-# TODO This should be deprecated
-#
-sub LongSinceUpdateAsString {
-    my $self = shift;
-    if ( $self->LastUpdated ) {
-
-        return ( $self->LastUpdatedObj->AgeAsString() );
-
-    }
-    else {
-        return "never";
-    }
-}
-
-# }}}
-
-# }}} Datehandling
-
-# {{{ sub _Set 
-#
 sub _Set {
     my $self = shift;
 
 sub _Set {
     my $self = shift;
 
@@ -525,24 +516,27 @@ sub _Set {
     # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
     # we want to change the standard "success" message
     if ($status) {
     # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
     # we want to change the standard "success" message
     if ($status) {
-        $msg =
-          $self->loc(
-            "[_1] changed from [_2] to [_3]",
-            $args{'Field'},
-            ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
-            '"' . $self->__Value( $args{'Field'}) . '"' 
-          );
-      } else {
-
-          $msg = $self->CurrentUser->loc_fuzzy($msg);
+        if ($self->SQLType( $args{'Field'}) =~ /text/) {
+            $msg = $self->loc(
+                "[_1] updated",
+                $self->loc( $args{'Field'} ),
+            );
+        } else {
+            $msg = $self->loc(
+                "[_1] changed from [_2] to [_3]",
+                $self->loc( $args{'Field'} ),
+                ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
+                '"' . $self->__Value( $args{'Field'}) . '"',
+            );
+        }
+    } else {
+        $msg = $self->CurrentUser->loc_fuzzy($msg);
     }
     }
-    return wantarray ? ($status, $msg) : $ret;     
 
 
+    return wantarray ? ($status, $msg) : $ret;
 }
 
 }
 
-# }}}
 
 
-# {{{ sub _SetLastUpdated
 
 =head2 _SetLastUpdated
 
 
 =head2 _SetLastUpdated
 
@@ -553,8 +547,7 @@ It takes no options. Arguably, this is a bug
 
 sub _SetLastUpdated {
     my $self = shift;
 
 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' ) ) {
@@ -571,9 +564,7 @@ sub _SetLastUpdated {
     }
 }
 
     }
 }
 
-# }}}
 
 
-# {{{ sub CreatorObj 
 
 =head2 CreatorObj
 
 
 =head2 CreatorObj
 
@@ -591,9 +582,7 @@ sub CreatorObj {
     return ( $self->{'CreatorObj'} );
 }
 
     return ( $self->{'CreatorObj'} );
 }
 
-# }}}
 
 
-# {{{ sub LastUpdatedByObj
 
 =head2 LastUpdatedByObj
 
 
 =head2 LastUpdatedByObj
 
@@ -610,9 +599,7 @@ sub LastUpdatedByObj {
     return $self->{'LastUpdatedByObj'};
 }
 
     return $self->{'LastUpdatedByObj'};
 }
 
-# }}}
 
 
-# {{{ sub URI 
 
 =head2 URI
 
 
 =head2 URI
 
@@ -626,7 +613,6 @@ sub URI {
     return($uri->URIForObject($self));
 }
 
     return($uri->URIForObject($self));
 }
 
-# }}}
 
 =head2 ValidateName NAME
 
 
 =head2 ValidateName NAME
 
@@ -637,10 +623,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);
     }
 }
 
     }
 }
 
@@ -661,36 +647,43 @@ 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 (defined $field && $field) {
-        $RT::Logger->error("$self __Value called with undef field");
+    unless ($field) {
+        $RT::Logger->error("__Value called with undef field");
     }
     }
-    my $value = $self->SUPER::__Value($field);
 
 
-    return('') if ( !defined($value) || $value eq '');
-
-    if( $args{'decode_utf8'} ) {
-       # XXX: is_utf8 check should be here unless Encode bug would be fixed
-        # see http://rt.cpan.org/NoAuth/Bug.html?id=14559 
-        return Encode::decode_utf8($value) unless Encode::is_utf8($value);
+    my $value = $self->SUPER::__Value($field);
+    return $value if ref $value;
+
+    return undef if (!defined $value);
+
+    # Pg returns character columns as character strings; mysql and
+    # sqlite return them as bytes.  While mysql can be made to return
+    # characters, using the mysql_enable_utf8 flag, the "Content" column
+    # is bytes on mysql and characters on Postgres, making true
+    # consistency impossible.
+    if ( $args{'decode_utf8'} ) {
+        if ( !utf8::is_utf8($value) ) { # mysql/sqlite
+            utf8::decode($value);
+        }
     } else {
     } else {
-        # check is_utf8 here just to be shure
-        return Encode::encode_utf8($value) if Encode::is_utf8($value);
+        if ( utf8::is_utf8($value) ) {
+            utf8::encode($value);
+        }
     }
     }
+
     return $value;
     return $value;
+
 }
 
 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
 
 sub _CacheConfig {
   {
 }
 
 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
 
 sub _CacheConfig {
   {
-     'cache_p'        => 1,
      'cache_for_sec'  => 30,
   }
 }
      'cache_for_sec'  => 30,
   }
 }
@@ -699,6 +692,7 @@ sub _CacheConfig {
 
 sub _BuildTableAttributes {
     my $self = shift;
 
 sub _BuildTableAttributes {
     my $self = shift;
+    my $class = ref($self) || $self;
 
     my $attributes;
     if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
 
     my $attributes;
     if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
@@ -708,39 +702,21 @@ sub _BuildTableAttributes {
 
     }
 
 
     }
 
-    foreach my $column (%$attributes) {
-        foreach my $attr ( %{ $attributes->{$column} } ) {
-            $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
-        }
-    }
-    if ( UNIVERSAL::can( $self, '_OverlayAccessible' ) ) {
-        $attributes = $self->_OverlayAccessible();
-
-        foreach my $column (%$attributes) {
-            foreach my $attr ( %{ $attributes->{$column} } ) {
-                $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
-            }
-        }
-    }
-    if ( UNIVERSAL::can( $self, '_VendorAccessible' ) ) {
-        $attributes = $self->_VendorAccessible();
-
-        foreach my $column (%$attributes) {
-            foreach my $attr ( %{ $attributes->{$column} } ) {
-                $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
-            }
+    foreach my $column (keys %$attributes) {
+        foreach my $attr ( keys %{ $attributes->{$column} } ) {
+            $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
         }
     }
         }
     }
-    if ( UNIVERSAL::can( $self, '_LocalAccessible' ) ) {
-        $attributes = $self->_LocalAccessible();
+    foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
+        next unless UNIVERSAL::can( $self, $method );
+        $attributes = $self->$method();
 
 
-        foreach my $column (%$attributes) {
-            foreach my $attr ( %{ $attributes->{$column} } ) {
-                $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
+        foreach my $column ( keys %$attributes ) {
+            foreach my $attr ( keys %{ $attributes->{$column} } ) {
+                $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
             }
         }
     }
             }
         }
     }
-
 }
 
 
 }
 
 
@@ -753,7 +729,7 @@ DBIx::SearchBuilder::Record
 
 sub _ClassAccessible {
     my $self = shift;
 
 sub _ClassAccessible {
     my $self = shift;
-    return $_TABLE_ATTR->{ref($self)};
+    return $_TABLE_ATTR->{ref($self) || $self};
 }
 
 =head2 _Accessible COLUMN ATTRIBUTE
 }
 
 =head2 _Accessible COLUMN ATTRIBUTE
@@ -767,92 +743,155 @@ sub _Accessible  {
   my $self = shift;
   my $column = shift;
   my $attribute = lc(shift);
   my $self = shift;
   my $column = shift;
   my $attribute = lc(shift);
-  return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
-  return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
+
+  my $class =  ref($self) || $self;
+  $class->_BuildTableAttributes unless ($_TABLE_ATTR->{$class});
+
+  return 0 unless defined ($_TABLE_ATTR->{$class}->{$column});
+  return $_TABLE_ATTR->{$class}->{$column}->{$attribute} || 0;
 
 }
 
 
 }
 
-=head2 _EncodeLOB BODY MIME_TYPE
+=head2 _EncodeLOB BODY MIME_TYPE FILENAME
+
+Takes a potentially large attachment. Returns (ContentEncoding,
+EncodedBody, MimeType, Filename, NoteArgs) based on system configuration and
+selected database.  Returns a custom (short) text/plain message if
+DropLongAttachments causes an attachment to not be stored.
 
 
-Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
+Encodes your data as base64 or Quoted-Printable as needed based on your
+Databases's restrictions and the UTF-8ness of the data being passed in.  Since
+we are storing in columns marked UTF8, we must ensure that binary data is
+encoded on databases which are strict.
+
+This function expects to receive an octet string in order to properly
+evaluate and encode it.  It will return an octet string.
+
+NoteArgs is currently used to indicate caller that the message is too long and
+is truncated or dropped. It's a hashref which is expected to be passed to
+L<RT::Record/_NewTransaction>.
 
 =cut
 
 sub _EncodeLOB {
 
 =cut
 
 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';
+    my $note_args;
 
 
-        #get the max attachment length from RT
-        my $MaxSize = $RT::MaxAttachmentSize;
+    RT::Util::assert_bytes( $Body );
 
 
-        #if the current attachment contains nulls and the
-        #database doesn't support embedded nulls
+    #get the max attachment length from RT
+    my $MaxSize = RT->Config->Get('MaxAttachmentSize');
 
 
-        if ( $RT::AlwaysUseBase64 or
-             ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
+    #if the current attachment contains nulls and the
+    #database doesn't support embedded nulls
 
 
-            # set a flag telling us to mimencode the attachment
-            $ContentEncoding = 'base64';
+    if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
 
 
-            #cut the max attchment size by 25% (for mime-encoding overhead.
-            $RT::Logger->debug("Max size is $MaxSize\n");
-            $MaxSize = $MaxSize * 3 / 4;
-        # Some databases (postgres) can't handle non-utf8 data
-        } elsif (    !$RT::Handle->BinarySafeBLOBs
-                  && $MIMEType !~ /text\/plain/gi
-                  && !Encode::is_utf8( $Body, 1 ) ) {
-              $ContentEncoding = 'quoted-printable';
-        }
+        # set a flag telling us to mimencode the attachment
+        $ContentEncoding = 'base64';
 
 
-        #if the attachment is larger than the maximum size
-        if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
+        #cut the max attchment size by 25% (for mime-encoding overhead.
+        $RT::Logger->debug("Max size is $MaxSize");
+        $MaxSize = $MaxSize * 3 / 4;
+    # Some databases (postgres) can't handle non-utf8 data
+    } elsif (    !$RT::Handle->BinarySafeBLOBs
+              && $Body =~ /\P{ASCII}/
+              && !Encode::is_utf8( $Body, 1 ) ) {
+          $ContentEncoding = 'quoted-printable';
+    }
 
 
-            # if we're supposed to truncate large attachments
-            if ($RT::TruncateLongAttachments) {
+    #if the attachment is larger than the maximum size
+    if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
 
 
-                # truncate the attachment to that length.
-                $Body = substr( $Body, 0, $MaxSize );
+        my $size = length $Body;
+        # if we're supposed to truncate large attachments
+        if (RT->Config->Get('TruncateLongAttachments')) {
 
 
-            }
+            $RT::Logger->info("$self: Truncated an attachment of size $size");
 
 
-            # elsif we're supposed to drop large attachments on the floor,
-            elsif ($RT::DropLongAttachments) {
+            # truncate the attachment to that length.
+            $Body = substr( $Body, 0, $MaxSize );
+            $note_args = {
+                Type           => 'AttachmentTruncate',
+                Data           => $Filename,
+                OldValue       => $size,
+                NewValue       => $MaxSize,
+                ActivateScrips => 0,
+            };
 
 
-                # drop the attachment on the floor
-                $RT::Logger->info( "$self: Dropped an attachment of size "
-                                   . length($Body) . "\n"
-                                   . "It started: " . substr( $Body, 0, 60 ) . "\n"
-                                 );
-                return ("none", "Large attachment dropped" );
-            }
         }
 
         }
 
-        # if we need to mimencode the attachment
-        if ( $ContentEncoding eq 'base64' ) {
-
-            # base64 encode the attachment
-            Encode::_utf8_off($Body);
-            $Body = MIME::Base64::encode_base64($Body);
-
-        } elsif ($ContentEncoding eq 'quoted-printable') {
-            Encode::_utf8_off($Body);
-            $Body = MIME::QuotedPrint::encode($Body);
+        # elsif we're supposed to drop large attachments on the floor,
+        elsif (RT->Config->Get('DropLongAttachments')) {
+
+            # drop the attachment on the floor
+            $RT::Logger->info( "$self: Dropped an attachment of size $size" );
+            $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
+            $note_args = {
+                Type           => 'AttachmentDrop',
+                Data           => $Filename,
+                OldValue       => $size,
+                NewValue       => $MaxSize,
+                ActivateScrips => 0,
+            };
+            $Filename .= ".txt" if $Filename && $Filename !~ /\.txt$/;
+            return ("none", "Large attachment dropped", "text/plain", $Filename, $note_args );
         }
         }
+    }
+
+    # if we need to mimencode the attachment
+    if ( $ContentEncoding eq 'base64' ) {
+        # base64 encode the attachment
+        $Body = MIME::Base64::encode_base64($Body);
 
 
+    } elsif ($ContentEncoding eq 'quoted-printable') {
+        $Body = MIME::QuotedPrint::encode($Body);
+    }
 
 
-        return ($ContentEncoding, $Body);
 
 
+    return ($ContentEncoding, $Body, $MIMEType, $Filename, $note_args );
 }
 
 }
 
+=head2 _DecodeLOB C<ContentType>, C<ContentEncoding>, C<Content>
+
+Unpacks data stored in the database, which may be base64 or QP encoded
+because of our need to store binary and badly encoded data in columns
+marked as UTF-8.  Databases such as PostgreSQL and Oracle care that you
+are feeding them invalid UTF-8 and will refuse the content.  This
+function handles unpacking the encoded data.
+
+It returns textual data as a UTF-8 string which has been processed by Encode's
+PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see
+the invalid byte but won't run into problems treating the data as UTF-8 later.
+
+This is similar to how we filter all data coming in via the web UI in
+RT::Interface::Web::DecodeARGS. This filter should only end up being
+applied to old data from less UTF-8-safe versions of RT.
+
+If the passed C<ContentType> includes a character set, that will be used
+to decode textual data; the default character set is UTF-8.  This is
+necessary because while we attempt to store textual data as UTF-8, the
+definition of "textual" has migrated over time, and thus we may now need
+to attempt to decode data that was previously not trancoded on insertion.
+
+Important Note - This function expects an octet string and returns a
+character string for non-binary data.
+
+=cut
+
 sub _DecodeLOB {
     my $self            = shift;
 sub _DecodeLOB {
     my $self            = shift;
-    my $ContentType     = shift;
-    my $ContentEncoding = shift;
+    my $ContentType     = shift || '';
+    my $ContentEncoding = shift || 'none';
     my $Content         = shift;
 
     my $Content         = shift;
 
+    RT::Util::assert_bytes( $Content );
+
     if ( $ContentEncoding eq 'base64' ) {
         $Content = MIME::Base64::decode_base64($Content);
     }
     if ( $ContentEncoding eq 'base64' ) {
         $Content = MIME::Base64::decode_base64($Content);
     }
@@ -863,29 +902,17 @@ sub _DecodeLOB {
         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
     }
     if ( RT::I18N::IsTextualContentType($ContentType) ) {
         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
     }
     if ( RT::I18N::IsTextualContentType($ContentType) ) {
-       $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
+        my $entity = MIME::Entity->new();
+        $entity->head->add("Content-Type", $ContentType);
+        $entity->bodyhandle( MIME::Body::Scalar->new( $Content ) );
+        my $charset = RT::I18N::_FindOrGuessCharset($entity);
+        $charset = 'utf-8' if not $charset or not Encode::find_encoding($charset);
+
+        $Content = Encode::decode($charset,$Content,Encode::FB_PERLQQ);
     }
     }
-        return ($Content);
+    return ($Content);
 }
 
 }
 
-# {{{ LINKDIRMAP
-# A helper table for links mapping to make it easier
-# to build and parse links between tickets
-
-use vars '%LINKDIRMAP';
-
-%LINKDIRMAP = (
-    MemberOf => { Base => 'MemberOf',
-                  Target => 'HasMember', },
-    RefersTo => { Base => 'RefersTo',
-                Target => 'ReferredToBy', },
-    DependsOn => { Base => 'DependsOn',
-                   Target => 'DependedOnBy', },
-    MergedInto => { Base => 'MergedInto',
-                   Target => 'MergedInto', },
-
-);
-
 =head2 Update  ARGSHASH
 
 Updates fields on an object for you using the proper Set methods,
 =head2 Update  ARGSHASH
 
 Updates fields on an object for you using the proper Set methods,
@@ -913,8 +940,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} ) {
@@ -935,6 +963,7 @@ sub Update {
 
         $value =~ s/\r\n/\n/gs;
 
 
         $value =~ s/\r\n/\n/gs;
 
+        my $truncated_value = $self->TruncateValue($attribute, $value);
 
         # 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.
@@ -942,11 +971,44 @@ sub Update {
         # This is in an eval block because $object might not exist.
         # and might not have a Name method. But "can" won't find autoloaded
         # items. If it fails, we don't care
         # This is in an eval block because $object might not exist.
         # and might not have a Name method. But "can" won't find autoloaded
         # items. If it fails, we don't care
-        eval {
-            my $object = $attribute . "Obj";
-            next if ($self->$object->Name eq $value);
+        do {
+            no warnings "uninitialized";
+            local $@;
+            my $name = eval {
+                my $object = $attribute . "Obj";
+                $self->$object->Name;
+            };
+            unless ($@) {
+                next if $name eq $value || $name eq ($value || 0);
+            }
+
+            next if $truncated_value eq $self->$attribute();
+            next if ( $truncated_value || 0 ) eq $self->$attribute();
         };
         };
-        next if ( $value 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+)/;
@@ -954,13 +1016,24 @@ sub Update {
         # Default to $id, but use name if we can get it.
         my $label = $self->id;
         $label = $self->Name if (UNIVERSAL::can($self,'Name'));
         # Default to $id, but use name if we can get it.
         my $label = $self->id;
         $label = $self->Name if (UNIVERSAL::can($self,'Name'));
-        push @results, $self->loc( "$prefix [_1]", $label ) . ': '. $msg;
+        # this requires model names to be loc'ed.
+
+=for loc
+
+    "Ticket" # loc
+    "User" # loc
+    "Group" # loc
+    "Queue" # loc
+
+=cut
+
+        push @results, $self->loc( $prefix ) . " $label: ". $msg;
 
 =for loc
 
                                    "[_1] could not be set to [_2].",       # loc
                                    "That is already the current value",    # loc
 
 =for 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
@@ -978,11 +1051,8 @@ sub Update {
     return @results;
 }
 
     return @results;
 }
 
-# {{{ Routines dealing with Links
 
 
-# {{{ Link Collections
 
 
-# {{{ sub Members
 
 =head2 Members
 
 
 =head2 Members
 
@@ -996,9 +1066,7 @@ sub Members {
     return ( $self->_Links( 'Target', 'MemberOf' ) );
 }
 
     return ( $self->_Links( 'Target', 'MemberOf' ) );
 }
 
-# }}}
 
 
-# {{{ sub MemberOf
 
 =head2 MemberOf
 
 
 =head2 MemberOf
 
@@ -1012,9 +1080,7 @@ sub MemberOf {
     return ( $self->_Links( 'Base', 'MemberOf' ) );
 }
 
     return ( $self->_Links( 'Base', 'MemberOf' ) );
 }
 
-# }}}
 
 
-# {{{ RefersTo
 
 =head2 RefersTo
 
 
 =head2 RefersTo
 
@@ -1027,9 +1093,7 @@ sub RefersTo {
     return ( $self->_Links( 'Base', 'RefersTo' ) );
 }
 
     return ( $self->_Links( 'Base', 'RefersTo' ) );
 }
 
-# }}}
 
 
-# {{{ ReferredToBy
 
 =head2 ReferredToBy
 
 
 =head2 ReferredToBy
 
@@ -1042,9 +1106,7 @@ sub ReferredToBy {
     return ( $self->_Links( 'Target', 'RefersTo' ) );
 }
 
     return ( $self->_Links( 'Target', 'RefersTo' ) );
 }
 
-# }}}
 
 
-# {{{ DependedOnBy
 
 =head2 DependedOnBy
 
 
 =head2 DependedOnBy
 
@@ -1057,60 +1119,15 @@ sub DependedOnBy {
     return ( $self->_Links( 'Target', 'DependsOn' ) );
 }
 
     return ( $self->_Links( 'Target', 'DependsOn' ) );
 }
 
-# }}}
 
 
 
 =head2 HasUnresolvedDependencies
 
 
 
 
 =head2 HasUnresolvedDependencies
 
-  Takes a paramhash of Type (default to '__any').  Returns true if
-$self->UnresolvedDependencies returns an object with one or more members
-of that type.  Returns false otherwise
-
-
-=begin testing
-
-my $t1 = RT::Ticket->new($RT::SystemUser);
-my ($id, $trans, $msg) = $t1->Create(Subject => 'DepTest1', Queue => 'general');
-ok($id, "Created dep test 1 - $msg");
-
-my $t2 = RT::Ticket->new($RT::SystemUser);
-my ($id2, $trans, $msg2) = $t2->Create(Subject => 'DepTest2', Queue => 'general');
-ok($id2, "Created dep test 2 - $msg2");
-my $t3 = RT::Ticket->new($RT::SystemUser);
-my ($id3, $trans, $msg3) = $t3->Create(Subject => 'DepTest3', Queue => 'general', Type => 'approval');
-ok($id3, "Created dep test 3 - $msg3");
-my ($addid, $addmsg);
-ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t2->id));
-ok ($addid, $addmsg);
-ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t3->id));
-
-ok ($addid, $addmsg);
-my $link = RT::Link->new($RT::SystemUser);
-my ($rv, $msg) = $link->Load($addid);
-ok ($rv, $msg);
-ok ($link->LocalTarget == $t3->id, "Link LocalTarget is correct");
-ok ($link->LocalBase   == $t1->id, "Link LocalBase   is correct");
-
-ok ($t1->HasUnresolvedDependencies, "Ticket ".$t1->Id." has unresolved deps");
-ok (!$t1->HasUnresolvedDependencies( Type => 'blah' ), "Ticket ".$t1->Id." has no unresolved blahs");
-ok ($t1->HasUnresolvedDependencies( Type => 'approval' ), "Ticket ".$t1->Id." has unresolved approvals");
-ok (!$t2->HasUnresolvedDependencies, "Ticket ".$t2->Id." has no unresolved deps");
-;
-
-my ($rid, $rmsg)= $t1->Resolve();
-ok(!$rid, $rmsg);
-my ($rid2, $rmsg2) = $t2->Resolve();
-ok ($rid2, $rmsg2);
-($rid, $rmsg)= $t1->Resolve();
-ok(!$rid, $rmsg);
-my ($rid3,$rmsg3) = $t3->Resolve;
-ok ($rid3,$rmsg3);
-($rid, $rmsg)= $t1->Resolve();
-ok($rid, $rmsg);
-
-
-=end testing
+Takes a paramhash of Type (default to '__any').  Returns the number of
+unresolved dependencies, if $self->UnresolvedDependencies returns an
+object with one or more members of that type.  Returns false
+otherwise.
 
 =cut
 
 
 =cut
 
@@ -1124,16 +1141,13 @@ sub HasUnresolvedDependencies {
     my $deps = $self->UnresolvedDependencies;
 
     if ($args{Type}) {
     my $deps = $self->UnresolvedDependencies;
 
     if ($args{Type}) {
-        $deps->Limit( FIELD => 'Type', 
-              OPERATOR => '=',
-              VALUE => $args{Type}); 
-    }
-    else {
-           $deps->IgnoreType;
+        $deps->LimitType( VALUE => $args{Type} );
+    } else {
+        $deps->IgnoreType;
     }
 
     if ($deps->Count > 0) {
     }
 
     if ($deps->Count > 0) {
-        return 1;
+        return $deps->Count;
     }
     else {
         return (undef);
     }
     else {
         return (undef);
@@ -1141,7 +1155,6 @@ sub HasUnresolvedDependencies {
 }
 
 
 }
 
 
-# {{{ UnresolvedDependencies 
 
 =head2 UnresolvedDependencies
 
 
 =head2 UnresolvedDependencies
 
@@ -1156,19 +1169,14 @@ sub UnresolvedDependencies {
     my $self = shift;
     my $deps = RT::Tickets->new($self->CurrentUser);
 
     my $self = shift;
     my $deps = RT::Tickets->new($self->CurrentUser);
 
-    my @live_statuses = RT::Queue->ActiveStatusArray();
-    foreach my $status (@live_statuses) {
-        $deps->LimitStatus(VALUE => $status);
-    }
+    $deps->LimitToActiveStatus;
     $deps->LimitDependedOnBy($self->Id);
 
     return($deps);
 
 }
 
     $deps->LimitDependedOnBy($self->Id);
 
     return($deps);
 
 }
 
-# }}}
 
 
-# {{{ AllDependedOnBy
 
 =head2 AllDependedOnBy
 
 
 =head2 AllDependedOnBy
 
@@ -1182,41 +1190,66 @@ dependency search.
 
 sub AllDependedOnBy {
     my $self = shift;
 
 sub AllDependedOnBy {
     my $self = shift;
-    my $dep = $self->DependedOnBy;
+    return $self->_AllLinkedTickets( LinkType => 'DependsOn',
+                                     Direction => 'Target', @_ );
+}
+
+=head2 AllDependsOn
+
+Returns an array of RT::Ticket objects which this ticket (directly or
+indirectly) depends on; takes an optional 'Type' argument in the param
+hash, which will limit returned tickets to that type, as well as cause
+tickets with that type to serve as 'leaf' nodes that stops the
+recursive dependency search.
+
+=cut
+
+sub AllDependsOn {
+    my $self = shift;
+    return $self->_AllLinkedTickets( LinkType => 'DependsOn',
+                                     Direction => 'Base', @_ );
+}
+
+sub _AllLinkedTickets {
+    my $self = shift;
+
     my %args = (
     my %args = (
+        LinkType  => undef,
+        Direction => undef,
         Type   => undef,
         Type   => undef,
-       _found => {},
-       _top   => 1,
+        _found => {},
+        _top   => 1,
         @_
     );
 
         @_
     );
 
+    my $dep = $self->_Links( $args{Direction}, $args{LinkType});
     while (my $link = $dep->Next()) {
     while (my $link = $dep->Next()) {
-       next unless ($link->BaseURI->IsLocal());
-       next if $args{_found}{$link->BaseObj->Id};
-
-       if (!$args{Type}) {
-           $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
-           $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
-       }
-       elsif ($link->BaseObj->Type eq $args{Type}) {
-           $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
-       }
-       else {
-           $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
-       }
+        my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
+        next unless ($uri->IsLocal());
+        my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
+        next if $args{_found}{$obj->Id};
+
+        if (!$args{Type}) {
+            $args{_found}{$obj->Id} = $obj;
+            $obj->_AllLinkedTickets( %args, _top => 0 );
+        }
+        elsif ($obj->Type and $obj->Type eq $args{Type}) {
+            $args{_found}{$obj->Id} = $obj;
+        }
+        else {
+            $obj->_AllLinkedTickets( %args, _top => 0 );
+        }
     }
 
     if ($args{_top}) {
     }
 
     if ($args{_top}) {
-       return map { $args{_found}{$_} } sort keys %{$args{_found}};
+        return map { $args{_found}{$_} } sort keys %{$args{_found}};
     }
     else {
     }
     else {
-       return 1;
+        return 1;
     }
 }
 
     }
 }
 
-# }}}
 
 
-# {{{ DependsOn
 
 =head2 DependsOn
 
 
 =head2 DependsOn
 
@@ -1231,77 +1264,199 @@ sub DependsOn {
 
 # }}}
 
 
 # }}}
 
+# {{{ Customers
 
 
+=head2 Customers
 
 
+  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.
 
 
-# {{{ sub _Links 
-
-=head2 Links DIRECTION [TYPE]
+=cut
 
 
-Return links (L<RT::Links>) to/from this object.
+sub Customers {
+    my( $self, %opt ) = @_;
+    my $Debug = $opt{'Debug'};
 
 
-DIRECTION is either 'Base' or 'Target'.
+    unless ( $self->{'Customers'} ) {
 
 
-TYPE is a type of links to return, it can be omitted to get
-links of any type.
+      $self->{'Customers'} = $self->MemberOf->Clone;
 
 
-=cut
+      $self->{'Customers'}->Limit( FIELD    => 'Base',
+                                   OPERATOR => 'STARTSWITH',
+                                   VALUE    => 'fsck.com-rt://%/ticket/',
+                                 );
 
 
-*Links = \&_Links;
+      for my $fstable (qw(cust_main cust_svc)) {
 
 
-sub _Links {
-    my $self = shift;
+        $self->{'Customers'}->Limit(
+                                     FIELD    => 'Target',
+                                     OPERATOR => 'STARTSWITH',
+                                     VALUE    => "freeside://freeside/$fstable",
+                                     ENTRYAGGREGATOR => 'OR',
+                                     SUBCLAUSE => 'customers',
+                                   );
+      }
+    }
 
 
-    #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
-    #tobias meant by $f
-    my $field = shift;
-    my $type  = shift || "";
+    warn "->Customers method called on $self; returning ".
+         ref($self->{'Customers'}). ' object'
+      if $Debug;
 
 
-    unless ( $self->{"$field$type"} ) {
-        $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
-            # at least to myself
-            $self->{"$field$type"}->Limit( FIELD => $field,
-                                           VALUE => $self->URI,
-                                           ENTRYAGGREGATOR => 'OR' );
-            $self->{"$field$type"}->Limit( FIELD => 'Type',
-                                           VALUE => $type )
-              if ($type);
-    }
-    return ( $self->{"$field$type"} );
+    return $self->{'Customers'};
 }
 
 # }}}
 
 }
 
 # }}}
 
-# }}}
+# {{{ Services
 
 
-# {{{ sub _AddLink
+=head2 Services
 
 
-=head2 _AddLink
+  This returns an RT::Links object which references all the services this 
+  object is a member of.
 
 
-Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
+=cut
 
 
-Returns C<link id>, C<message> and C<exist> flag.
+sub Services {
+    my( $self, %opt ) = @_;
 
 
+    unless ( $self->{'Services'} ) {
 
 
-=cut
+      $self->{'Services'} = $self->MemberOf->Clone;
 
 
+      $self->{'Services'}->Limit(
+                                   FIELD    => 'Target',
+                                   OPERATOR => 'STARTSWITH',
+                                   VALUE    => "freeside://freeside/cust_svc",
+                                 );
+    }
 
 
-sub _AddLink {
+    return $self->{'Services'};
+}
+
+
+
+
+
+
+=head2 Links DIRECTION [TYPE]
+
+Return links (L<RT::Links>) to/from this object.
+
+DIRECTION is either 'Base' or 'Target'.
+
+TYPE is a type of links to return, it can be omitted to get
+links of any type.
+
+=cut
+
+sub Links { shift->_Links(@_) }
+
+sub _Links {
     my $self = shift;
     my $self = shift;
-    my %args = ( Target => '',
-                 Base   => '',
-                 Type   => '',
-                 Silent => undef,
-                 @_ );
+
+    #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
+    #tobias meant by $f
+    my $field = shift;
+    my $type  = shift || "";
+
+    unless ( $self->{"$field$type"} ) {
+        $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
+            # at least to myself
+            $self->{"$field$type"}->Limit( FIELD => $field,
+                                           VALUE => $self->URI,
+                                           ENTRYAGGREGATOR => 'OR' );
+            $self->{"$field$type"}->Limit( FIELD => 'Type',
+                                           VALUE => $type )
+              if ($type);
+    }
+    return ( $self->{"$field$type"} );
+}
+
 
 
 
 
+
+=head2 FormatType
+
+Takes a Type and returns a string that is more human readable.
+
+=cut
+
+sub FormatType{
+    my $self = shift;
+    my %args = ( Type => '',
+                 @_
+               );
+    $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
+    $args{Type} =~ s/^\s+//;
+    return $args{Type};
+}
+
+
+
+
+=head2 FormatLink
+
+Takes either a Target or a Base and returns a string of human friendly text.
+
+=cut
+
+sub FormatLink {
+    my $self = shift;
+    my %args = ( Object => undef,
+                 FallBack => '',
+                 @_
+               );
+    my $text = "URI " . $args{FallBack};
+    if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
+        $text = "Ticket " . $args{Object}->id;
+    }
+    return $text;
+}
+
+=head2 _AddLink
+
+Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
+
+If Silent is true then no transactions will be recorded.  You can individually
+control transactions on both base and target and with SilentBase and
+SilentTarget respectively. By default both transactions are created.
+
+If the link destination is a local object and does the
+L<RT::Record::Role::Status> role, this method ensures object Status is not
+"deleted".  Linking to deleted objects is forbidden.
+
+If the link destination (i.e. not C<$self>) is a local object and the
+C<$StrictLinkACL> option is enabled, this method checks the appropriate right
+on the destination object (if any, as returned by the L</ModifyLinkRight>
+method).  B<< The subclass is expected to check the appropriate right on the
+source object (i.e.  C<$self>) before calling this method. >>  This allows a
+different right to be used on the source object during creation, for example.
+
+Returns a tuple of (link ID, message, flag if link already existed).
+
+=cut
+
+sub _AddLink {
+    my $self = shift;
+    my %args = (
+        Target       => '',
+        Base         => '',
+        Type         => '',
+        Silent       => undef,
+        Silent       => undef,
+        SilentBase   => undef,
+        SilentTarget => undef,
+        @_
+    );
+
     # Remote_link is the URI of the object that is not this ticket
     my $remote_link;
     my $direction;
 
     if ( $args{'Base'} and $args{'Target'} ) {
     # Remote_link is the URI of the object that is not this ticket
     my $remote_link;
     my $direction;
 
     if ( $args{'Base'} and $args{'Target'} ) {
-        $RT::Logger->debug( "$self tried to create a link. both base and target were specified\n" );
-        return ( 0, $self->loc("Can't specifiy both base and target") );
+        $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
+        return ( 0, $self->loc("Can't specify both base and target") );
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
@@ -1317,8 +1472,30 @@ 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
-    use RT::Link;
+    my $remote_uri = RT::URI->new( $self->CurrentUser );
+    if ($remote_uri->FromURI( $remote_link )) {
+        my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef;
+        if ($remote_obj and $remote_obj->id) {
+            # Enforce the remote end of StrictLinkACL
+            if (RT->Config->Get("StrictLinkACL")) {
+                my $right = $remote_obj->ModifyLinkRight;
+
+                return (0, $self->loc("Permission denied"))
+                    if $right and
+                   not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj );
+            }
+
+            # Prevent linking to deleted objects
+            if ($remote_obj->DOES("RT::Record::Role::Status")
+                and $remote_obj->Status eq "deleted") {
+                return (0, $self->loc("Linking to a deleted [_1] is not allowed", $self->loc(lc($remote_obj->RecordType))));
+            }
+        }
+    } else {
+        return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link));
+    }
+
+    # Check if the link already exists - we don't want duplicates
     my $old_link = RT::Link->new( $self->CurrentUser );
     $old_link->LoadByParams( Base   => $args{'Base'},
                              Type   => $args{'Type'},
     my $old_link = RT::Link->new( $self->CurrentUser );
     $old_link->LoadByParams( Base   => $args{'Base'},
                              Type   => $args{'Type'},
@@ -1328,101 +1505,222 @@ sub _AddLink {
         return ( $old_link->id, $self->loc("Link already exists"), 1 );
     }
 
         return ( $old_link->id, $self->loc("Link already exists"), 1 );
     }
 
-    # }}}
+    if ( $args{'Type'} =~ /^(?:DependsOn|MemberOf)$/ ) {
 
 
+        my @tickets = $self->_AllLinkedTickets(
+            LinkType  => $args{'Type'},
+            Direction => $direction eq 'Target' ? 'Base' : 'Target',
+        );
+        if ( grep { $_->id == ( $direction eq 'Target' ? $args{'Base'} : $args{'Target'} ) } @tickets ) {
+            return ( 0, $self->loc("Refused to add link which would create a circular relationship") );
+        }
+    }
 
     # Storing the link in the DB.
     my $link = RT::Link->new( $self->CurrentUser );
     my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
 
     # Storing the link in the DB.
     my $link = RT::Link->new( $self->CurrentUser );
     my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
-                                  Base   => $args{Base},
-                                  Type   => $args{Type} );
+                                            Base   => $args{Base},
+                                            Type   => $args{Type} );
 
     unless ($linkid) {
         $RT::Logger->error("Link could not be created: ".$linkmsg);
 
     unless ($linkid) {
         $RT::Logger->error("Link could not be created: ".$linkmsg);
-        return ( 0, $self->loc("Link could not be created") );
+        return ( 0, $self->loc("Link could not be created: [_1]", $linkmsg) );
     }
 
     }
 
-    my $TransString =
-      "Record $args{'Base'} $args{Type} record $args{'Target'}.";
+    my $basetext = $self->FormatLink(Object   => $link->BaseObj,
+                                     FallBack => $args{Base});
+    my $targettext = $self->FormatLink(Object   => $link->TargetObj,
+                                       FallBack => $args{Target});
+    my $typetext = $self->FormatType(Type => $args{Type});
+    my $TransString = "$basetext $typetext $targettext.";
 
 
-    return ( $linkid, $self->loc( "Link created ([_1])", $TransString ) );
-}
+    # No transactions for you!
+    return ($linkid, $TransString) if $args{'Silent'};
 
 
-# }}}
+    my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target';
 
 
-# {{{ sub _DeleteLink 
+    # Some transactions?
+    unless ( $args{ 'Silent'. $direction } ) {
+        my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
+            Type      => 'AddLink',
+            Field     => $RT::Link::DIRMAP{$args{'Type'}}->{$direction},
+            NewValue  => $remote_uri->URI || $remote_link,
+            TimeTaken => 0
+        );
+        $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
+    }
+
+    if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) {
+        my $OtherObj = $remote_uri->Object;
+        my ( $val, $msg ) = $OtherObj->_NewTransaction(
+            Type           => 'AddLink',
+            Field          => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction},
+            NewValue       => $self->URI,
+            TimeTaken      => 0,
+        );
+        $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
+    }
+
+    return ($linkid, $TransString);
+}
 
 =head2 _DeleteLink
 
 
 =head2 _DeleteLink
 
-Delete a link. takes a paramhash of Base, Target and Type.
-Either Base or Target must be null. The null value will 
-be replaced with this ticket\'s id
+Takes a paramhash of Type and one of Base or Target. Removes that link from this object.
+
+If Silent is true then no transactions will be recorded.  You can individually
+control transactions on both base and target and with SilentBase and
+SilentTarget respectively. By default both transactions are created.
+
+If the link destination (i.e. not C<$self>) is a local object and the
+C<$StrictLinkACL> option is enabled, this method checks the appropriate right
+on the destination object (if any, as returned by the L</ModifyLinkRight>
+method).  B<< The subclass is expected to check the appropriate right on the
+source object (i.e.  C<$self>) before calling this method. >>
+
+Returns a tuple of (status flag, message).
 
 =cut 
 
 sub _DeleteLink {
     my $self = shift;
     my %args = (
 
 =cut 
 
 sub _DeleteLink {
     my $self = shift;
     my %args = (
-        Base   => undef,
-        Target => undef,
-        Type   => undef,
+        Base         => undef,
+        Target       => undef,
+        Type         => undef,
+        Silent       => undef,
+        SilentBase   => undef,
+        SilentTarget => undef,
         @_
     );
 
         @_
     );
 
-    #we want one of base and target. we don't care which
-    #but we only want _one_
-
+    # We want one of base and target. We don't care which but we only want _one_.
     my $direction;
     my $remote_link;
 
     if ( $args{'Base'} and $args{'Target'} ) {
     my $direction;
     my $remote_link;
 
     if ( $args{'Base'} and $args{'Target'} ) {
-        $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n");
-        return ( 0, $self->loc("Can't specifiy both base and target") );
+        $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
+        return ( 0, $self->loc("Can't specify both base and target") );
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
-       $remote_link = $args{'Base'};
-       $direction = 'Target';
+        $remote_link    = $args{'Base'};
+        $direction      = 'Target';
     }
     elsif ( $args{'Target'} ) {
         $args{'Base'} = $self->URI();
     }
     elsif ( $args{'Target'} ) {
         $args{'Base'} = $self->URI();
-       $remote_link = $args{'Target'};
-        $direction='Base';
+        $remote_link  = $args{'Target'};
+        $direction    = 'Base';
     }
     else {
     }
     else {
-        $RT::Logger->error("Base or Target must be specified\n");
+        $RT::Logger->error("Base or Target must be specified");
         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 );
-    $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} . "\n" );
+    my $remote_uri = RT::URI->new( $self->CurrentUser );
+    if ($remote_uri->FromURI( $remote_link )) {
+        # Enforce the remote end of StrictLinkACL
+        my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef;
+        if ($remote_obj and $remote_obj->id and RT->Config->Get("StrictLinkACL")) {
+            my $right = $remote_obj->ModifyLinkRight;
 
 
+            return (0, $self->loc("Permission denied"))
+                if $right and
+               not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj );
+        }
+    } else {
+        return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link));
+    }
 
 
-    $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=>  $args{'Target'} );
-    #it's a real link. 
-    if ( $link->id ) {
+    my $link = RT::Link->new( $self->CurrentUser );
+    $RT::Logger->debug( "Trying to load link: "
+            . $args{'Base'} . " "
+            . $args{'Type'} . " "
+            . $args{'Target'} );
+
+    $link->LoadByParams(
+        Base   => $args{'Base'},
+        Type   => $args{'Type'},
+        Target => $args{'Target'}
+    );
 
 
-        my $linkid = $link->id;
-        $link->Delete();
+    unless ($link->id) {
+        $RT::Logger->debug("Couldn't find that link");
+        return ( 0, $self->loc("Link not found") );
+    }
+
+    my $basetext = $self->FormatLink(Object   => $link->BaseObj,
+                                     FallBack => $args{Base});
+    my $targettext = $self->FormatLink(Object   => $link->TargetObj,
+                                       FallBack => $args{Target});
+    my $typetext = $self->FormatType(Type => $args{Type});
+    my $TransString = "$basetext no longer $typetext $targettext.";
 
 
-        my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}.";
-        return ( 1, $self->loc("Link deleted ([_1])", $TransString));
+    my ($ok, $msg) = $link->Delete();
+    unless ($ok) {
+        RT->Logger->error("Link could not be deleted: $msg");
+        return ( 0, $self->loc("Link could not be deleted: [_1]", $msg) );
     }
 
     }
 
-    #if it's not a link we can find
-    else {
-        $RT::Logger->debug("Couldn't find that link\n");
-        return ( 0, $self->loc("Link not found") );
+    # No transactions for you!
+    return (1, $TransString) if $args{'Silent'};
+
+    my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target';
+
+    # Some transactions?
+    unless ( $args{ 'Silent'. $direction } ) {
+        my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
+            Type      => 'DeleteLink',
+            Field     => $RT::Link::DIRMAP{$args{'Type'}}->{$direction},
+            OldValue  => $remote_uri->URI || $remote_link,
+            TimeTaken => 0
+        );
+        $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
+    }
+
+    if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) {
+        my $OtherObj = $remote_uri->Object;
+        my ( $val, $msg ) = $OtherObj->_NewTransaction(
+            Type           => 'DeleteLink',
+            Field          => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction},
+            OldValue       => $self->URI,
+            TimeTaken      => 0,
+        );
+        $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
     }
     }
+
+    return (1, $TransString);
 }
 
 }
 
-# }}}
+=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 _NewTransaction
+sub LockForUpdate {
+    my $self = shift;
+
+    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
 
@@ -1445,27 +1743,34 @@ 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'};
     if ($old_ref or $new_ref) {
     my $old_ref = $args{'OldReference'};
     my $new_ref = $args{'NewReference'};
     my $ref_type = $args{'ReferenceType'};
     if ($old_ref or $new_ref) {
-       $ref_type ||= ref($old_ref) || ref($new_ref);
-       if (!$ref_type) {
-           $RT::Logger->error("Reference type not specified for transaction");
-           return;
-       }
-       $old_ref = $old_ref->Id if ref($old_ref);
-       $new_ref = $new_ref->Id if ref($new_ref);
+        $ref_type ||= ref($old_ref) || ref($new_ref);
+        if (!$ref_type) {
+            $RT::Logger->error("Reference type not specified for transaction");
+            return;
+        }
+        $old_ref = $old_ref->Id if ref($old_ref);
+        $new_ref = $new_ref->Id if ref($new_ref);
     }
 
     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(
     my ( $transaction, $msg ) = $trans->Create(
-       ObjectId  => $self->Id,
-       ObjectType => ref($self),
+        ObjectId  => $self->Id,
+        ObjectType => ref($self),
         TimeTaken => $args{'TimeTaken'},
         Type      => $args{'Type'},
         Data      => $args{'Data'},
         TimeTaken => $args{'TimeTaken'},
         Type      => $args{'Type'},
         Data      => $args{'Data'},
@@ -1478,6 +1783,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.
@@ -1488,31 +1795,29 @@ sub _NewTransaction {
     $self->_SetLastUpdated;
 
     if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
     $self->_SetLastUpdated;
 
     if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
-        $self->_UpdateTimeTaken( $args{'TimeTaken'} );
+        $self->_UpdateTimeTaken( $args{'TimeTaken'}, Transaction => $trans );
     }
     }
-    if ( $RT::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
 
-  Returns an RT::Transactions object of all transactions on this record object
+Returns an L<RT::Transactions> object of all transactions on this record object
 
 =cut
 
 sub Transactions {
     my $self = shift;
 
 
 =cut
 
 sub Transactions {
     my $self = shift;
 
-    use RT::Transactions;
     my $transactions = RT::Transactions->new( $self->CurrentUser );
     my $transactions = RT::Transactions->new( $self->CurrentUser );
-
-    #If the user has no rights, return an empty object
     $transactions->Limit(
         FIELD => 'ObjectId',
         VALUE => $self->id,
     $transactions->Limit(
         FIELD => 'ObjectId',
         VALUE => $self->id,
@@ -1522,40 +1827,177 @@ sub Transactions {
         VALUE => ref($self),
     );
 
         VALUE => ref($self),
     );
 
-    return ($transactions);
+    return $transactions;
 }
 
 }
 
-# }}}
-# }}}
-#
-# {{{ Routines dealing with custom fields
+=head2 SortedTransactions
+
+Returns the result of L</Transactions> ordered per the
+I<OldestTransactionsFirst> preference/option.
+
+=cut
+
+sub SortedTransactions {
+    my $self  = shift;
+    my $txns  = $self->Transactions;
+    my $order = RT->Config->Get("OldestTransactionsFirst", $self->CurrentUser)
+        ? 'ASC' : 'DESC';
+    $txns->OrderByCols(
+        { FIELD => 'Created',   ORDER => $order },
+        { FIELD => 'id',        ORDER => $order },
+    );
+    return $txns;
+}
+
+our %TRANSACTION_CLASSIFICATION = (
+    Create     => 'message',
+    Correspond => 'message',
+    Comment    => 'message',
+
+    AddWatcher => 'people',
+    DelWatcher => 'people',
+
+    Take       => 'people',
+    Untake     => 'people',
+    Force      => 'people',
+    Steal      => 'people',
+    Give       => 'people',
+
+    AddLink    => 'links',
+    DeleteLink => 'links',
+
+    Status     => 'basics',
+    Set        => {
+        __default => 'basics',
+        map( { $_ => 'dates' } qw(
+            Told Starts Started Due LastUpdated Created LastUpdated
+        ) ),
+        map( { $_ => 'people' } qw(
+            Owner Creator LastUpdatedBy
+        ) ),
+    },
+    SystemError => 'error',
+    AttachmentTruncate => 'attachment-truncate',
+    AttachmentDrop => 'attachment-drop',
+    AttachmentError => 'error',
+    __default => 'other',
+);
+
+sub ClassifyTransaction {
+    my $self = shift;
+    my $txn = shift;
+
+    my $type = $txn->Type;
+
+    my $res = $TRANSACTION_CLASSIFICATION{ $type };
+    return $res || $TRANSACTION_CLASSIFICATION{ '__default' }
+        unless ref $res;
+
+    return $res->{ $txn->Field } || $res->{'__default'}
+        || $TRANSACTION_CLASSIFICATION{ '__default' }; 
+}
+
+=head2 Attachments
+
+Returns an L<RT::Attachments> object of all attachments on this record object
+(for all its L</Transactions>).
+
+By default Content and Headers of attachments are not fetched right away from
+database. Use C<WithContent> and C<WithHeaders> options to override this.
+
+=cut
+
+sub Attachments {
+    my $self = shift;
+    my %args = (
+        WithHeaders => 0,
+        WithContent => 0,
+        @_
+    );
+    my @columns = grep { not /^(Headers|Content)$/ }
+                       RT::Attachment->ReadableAttributes;
+    push @columns, 'Headers' if $args{'WithHeaders'};
+    push @columns, 'Content' if $args{'WithContent'};
+
+    my $res = RT::Attachments->new( $self->CurrentUser );
+    $res->Columns( @columns );
+    my $txn_alias = $res->TransactionAlias;
+    $res->Limit(
+        ALIAS => $txn_alias,
+        FIELD => 'ObjectType',
+        VALUE => ref($self),
+    );
+    $res->Limit(
+        ALIAS => $txn_alias,
+        FIELD => 'ObjectId',
+        VALUE => $self->id,
+    );
+    return $res;
+}
+
+=head2 TextAttachments
+
+Returns an L<RT::Attachments> object of all attachments, like L<Attachments>,
+but only those that are text.
+
+By default Content and Headers are fetched. Use C<WithContent> and
+C<WithHeaders> options to override this.
+
+=cut
+
+sub TextAttachments {
+    my $self = shift;
+    my $res = $self->Attachments(
+        WithHeaders => 1,
+        WithContent => 1,
+        @_
+    );
+    $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text/plain');
+    $res->Limit( FIELD => 'ContentType', OPERATOR => 'STARTSWITH', VALUE => 'message/');
+    $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text');
+    $res->Limit( FIELD => 'Filename', OPERATOR => 'IS', VALUE => 'NULL')
+        if RT->Config->Get( 'SuppressInlineTextFiles', $self->CurrentUser );
+    return $res;
+}
 
 sub CustomFields {
     my $self = shift;
     my $cfs  = RT::CustomFields->new( $self->CurrentUser );
 
 sub CustomFields {
     my $self = shift;
     my $cfs  = RT::CustomFields->new( $self->CurrentUser );
-
+    
+    $cfs->SetContextObject( $self );
     # XXX handle multiple types properly
     $cfs->LimitToLookupType( $self->CustomFieldLookupType );
     # XXX handle multiple types properly
     $cfs->LimitToLookupType( $self->CustomFieldLookupType );
-    $cfs->LimitToGlobalOrObjectId(
-        $self->_LookupId( $self->CustomFieldLookupType ) );
+    $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId );
+    $cfs->ApplySortOrder;
 
     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::Foo classes. it doesn't work, for
+# example, for RT::IR::Foo classes.
 
 
-sub _LookupId {
+sub CustomFieldLookupId {
     my $self = shift;
     my $self = shift;
-    my $lookup = shift;
+    my $lookup = shift || $self->CustomFieldLookupType;
     my @classes = ($lookup =~ /RT::(\w+)-/g);
 
     my @classes = ($lookup =~ /RT::(\w+)-/g);
 
+    # Work on "RT::Queue", for instance
+    return $self->Id unless @classes;
+
     my $object = $self;
     my $object = $self;
+    # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
+    my $final = shift @classes;
     foreach my $class (reverse @classes) {
     foreach my $class (reverse @classes) {
-       my $method = "${class}Obj";
-       $object = $object->$method;
+        my $method = "${class}Obj";
+        $object = $object->$method;
     }
 
     }
 
-    return $object->Id;
+    my $id = $object->$final;
+    unless (defined $id) {
+        my $method = "${final}Obj";
+        $id = $object->$method->Id;
+    }
+    return $id;
 }
 
 
 }
 
 
@@ -1567,30 +2009,20 @@ Returns the path RT uses to figure out which custom fields apply to this object.
 
 sub CustomFieldLookupType {
     my $self = shift;
 
 sub CustomFieldLookupType {
     my $self = shift;
-    return ref($self);
+    return ref($self) || $self;
 }
 
 }
 
-#TODO Deprecated API. Destroy in 3.6
-sub _LookupTypes { 
-    my  $self = shift;
-    $RT::Logger->warning("_LookupTypes call is deprecated at (". join(":",caller)."). Replace with CustomFieldLookupType");
-
-    return($self->CustomFieldLookupType);
-
-}
-
-# {{{ AddCustomFieldValue
 
 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
 
 
 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
 
-VALUE should be a string.
-FIELD can be a CustomField object OR a CustomField ID.
-
+VALUE should be a string. FIELD can be any identifier of a CustomField
+supported by L</LoadCustomFieldByIdentifier> method.
 
 
-Adds VALUE as a value of CustomField FIELD.  If this is a single-value custom field,
-deletes the old value. 
+Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
+deletes the old value.
 If VALUE is not a valid value for the custom field, returns 
 If VALUE is not a valid value for the custom field, returns 
-(0, 'Error message' ) otherwise, returns (1, 'Success Message')
+(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
+$id is ID of created L<ObjectCustomFieldValue> object.
 
 =cut
 
 
 =cut
 
@@ -1604,12 +2036,13 @@ sub _AddCustomFieldValue {
     my %args = (
         Field             => undef,
         Value             => undef,
     my %args = (
         Field             => undef,
         Value             => undef,
+        LargeContent      => undef,
+        ContentType       => undef,
         RecordTransaction => 1,
         @_
     );
 
     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
         RecordTransaction => 1,
         @_
     );
 
     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
-
     unless ( $cf->Id ) {
         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
     }
     unless ( $cf->Id ) {
         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
     }
@@ -1621,12 +2054,15 @@ 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'}
             )
         );
     }
             )
         );
     }
-    # Load up a ObjectCustomFieldValues object for this custom field and this ticket
-    my $values = $cf->ValuesForObject($self);
+
+    # empty string is not correct value of any CF, so undef it
+    foreach ( qw(Value LargeContent) ) {
+        $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
+    }
 
     unless ( $cf->ValidateValue( $args{'Value'} ) ) {
         return ( 0, $self->loc("Invalid value for custom field") );
 
     unless ( $cf->ValidateValue( $args{'Value'} ) ) {
         return ( 0, $self->loc("Invalid value for custom field") );
@@ -1634,11 +2070,14 @@ sub _AddCustomFieldValue {
 
     # If the custom field only accepts a certain # of values, delete the existing
     # value and record a "changed from foo to bar" transaction
 
     # If the custom field only accepts a certain # of values, delete the existing
     # value and record a "changed from foo to bar" transaction
-    unless ( $cf->UnlimitedValues) {
+    unless ( $cf->UnlimitedValues ) {
 
 
- # We need to whack any old values here.  In most cases, the custom field should
- # only have one value to delete.  In the pathalogical case, this custom field
- # used to be a multiple and we have many values to whack....
+        # Load up a ObjectCustomFieldValues object for this custom field and this ticket
+        my $values = $cf->ValuesForObject($self);
+
+        # We need to whack any old values here.  In most cases, the custom field should
+        # only have one value to delete.  In the pathalogical case, this custom field
+        # used to be a multiple and we have many values to whack....
         my $cf_values = $values->Count;
 
         if ( $cf_values > $cf->MaxValues ) {
         my $cf_values = $values->Count;
 
         if ( $cf_values > $cf->MaxValues ) {
@@ -1648,8 +2087,8 @@ sub _AddCustomFieldValue {
                 $i++;
                 if ( $i < $cf_values ) {
                     my ( $val, $msg ) = $cf->DeleteValueForObject(
                 $i++;
                 if ( $i < $cf_values ) {
                     my ( $val, $msg ) = $cf->DeleteValueForObject(
-                        Object  => $self,
-                        Content => $value->Content
+                        Object => $self,
+                        Id     => $value->id,
                     );
                     unless ($val) {
                         return ( 0, $msg );
                     );
                     unless ($val) {
                         return ( 0, $msg );
@@ -1665,12 +2104,14 @@ sub _AddCustomFieldValue {
             $values->RedoSearch if $i; # redo search if have deleted at least one value
         }
 
             $values->RedoSearch if $i; # redo search if have deleted at least one value
         }
 
-        my ( $old_value, $old_content );
-        if ( $old_value = $values->First ) {
-            $old_content = $old_value->Content();
-            return (1) if( $old_content eq $args{'Value'} && $old_value->LargeContent eq $args{'LargeContent'});;
+        if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
+            return $entry->id;
         }
 
         }
 
+        my $old_value = $values->First;
+        my $old_content;
+        $old_content = $old_value->Content if $old_value;
+
         my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
             Object       => $self,
             Content      => $args{'Value'},
         my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
             Object       => $self,
             Content      => $args{'Value'},
@@ -1678,19 +2119,17 @@ sub _AddCustomFieldValue {
             ContentType  => $args{'ContentType'},
         );
 
             ContentType  => $args{'ContentType'},
         );
 
-        unless ($new_value_id) {
-            return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) );
+        unless ( $new_value_id ) {
+            return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
         }
 
         my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
         }
 
         my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
-        $new_value->Load($new_value_id);
+        $new_value->Load( $new_value_id );
 
         # now that adding the new value was successful, delete the old one
 
         # now that adding the new value was successful, delete the old one
-        if ($old_value) {
+        if ( $old_value ) {
             my ( $val, $msg ) = $old_value->Delete();
             my ( $val, $msg ) = $old_value->Delete();
-            unless ($val) {
-                return ( 0, $msg );
-            }
+            return ( 0, $msg ) unless $val;
         }
 
         if ( $args{'RecordTransaction'} ) {
         }
 
         if ( $args{'RecordTransaction'} ) {
@@ -1703,52 +2142,73 @@ sub _AddCustomFieldValue {
               );
         }
 
               );
         }
 
-        if ( $old_value eq '' ) {
-            return ( 1, $self->loc( "[_1] [_2] added", $cf->Name, $new_value->Content ));
+        my $new_content = $new_value->Content;
+
+        # 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,
+            );
+            $new_content = $DateObj->AsString;
+
+            if ( defined $old_content && length $old_content ) {
+                $DateObj->Set(
+                    Format => 'ISO',
+                    Value  => $old_content,
+                );
+                $old_content = $DateObj->AsString;
+            }
         }
         }
-        elsif ( $new_value->Content eq '' ) {
-            return ( 1,
-                $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) );
+
+        unless ( defined $old_content && length $old_content ) {
+            return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
+        }
+        elsif ( !defined $new_content || !length $new_content ) {
+            return ( $new_value_id,
+                $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
         }
         else {
         }
         else {
-            return ( 1, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content,                $new_value->Content));
+            return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
         }
 
     }
 
     # otherwise, just add a new value and record "new value added"
     else {
         }
 
     }
 
     # otherwise, just add a new value and record "new value added"
     else {
-        my ($new_value_id, $value_msg) = $cf->AddValueForObject(
+        my $values = $cf->ValuesForObject($self);
+        if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
+            return $entry->id;
+        }
+
+        my ($new_value_id, $msg) = $cf->AddValueForObject(
             Object       => $self,
             Content      => $args{'Value'},
             LargeContent => $args{'LargeContent'},
             ContentType  => $args{'ContentType'},
         );
 
             Object       => $self,
             Content      => $args{'Value'},
             LargeContent => $args{'LargeContent'},
             ContentType  => $args{'ContentType'},
         );
 
-        unless ($new_value_id) {
-            return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) );
+        unless ( $new_value_id ) {
+            return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
         }
         if ( $args{'RecordTransaction'} ) {
         }
         if ( $args{'RecordTransaction'} ) {
-            my ( $TransactionId, $Msg, $TransactionObj ) =
-              $self->_NewTransaction(
+            my ( $tid, $msg ) = $self->_NewTransaction(
                 Type          => 'CustomField',
                 Field         => $cf->Id,
                 NewReference  => $new_value_id,
                 ReferenceType => 'RT::ObjectCustomFieldValue',
                 Type          => 'CustomField',
                 Field         => $cf->Id,
                 NewReference  => $new_value_id,
                 ReferenceType => 'RT::ObjectCustomFieldValue',
-              );
-            unless ($TransactionId) {
-                return ( 0,
-                    $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
+            );
+            unless ( $tid ) {
+                return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
             }
         }
             }
         }
-        return ( 1, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name));
+        return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
     }
     }
-
 }
 
 }
 
-# }}}
 
 
-# {{{ DeleteCustomFieldValue
 
 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
 
 
 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
 
@@ -1771,10 +2231,10 @@ sub DeleteCustomFieldValue {
     );
 
     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
     );
 
     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
-
     unless ( $cf->Id ) {
         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
     }
     unless ( $cf->Id ) {
         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
     }
+
     my ( $val, $msg ) = $cf->DeleteValueForObject(
         Object  => $self,
         Id      => $args{'ValueId'},
     my ( $val, $msg ) = $cf->DeleteValueForObject(
         Object  => $self,
         Id      => $args{'ValueId'},
@@ -1783,6 +2243,7 @@ sub DeleteCustomFieldValue {
     unless ($val) {
         return ( 0, $msg );
     }
     unless ($val) {
         return ( 0, $msg );
     }
+
     my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
         Type          => 'CustomField',
         Field         => $cf->Id,
     my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
         Type          => 'CustomField',
         Field         => $cf->Id,
@@ -1793,18 +2254,26 @@ sub DeleteCustomFieldValue {
         return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
     }
 
         return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
     }
 
+    my $old_value = $TransactionObj->OldValue;
+    # 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,
+        );
+        $old_value = $DateObj->AsString;
+    }
     return (
         $TransactionId,
         $self->loc(
             "[_1] is no longer a value for custom field [_2]",
     return (
         $TransactionId,
         $self->loc(
             "[_1] is no longer a value for custom field [_2]",
-            $TransactionObj->OldValue, $cf->Name
+            $old_value, $cf->Name
         )
     );
 }
 
         )
     );
 }
 
-# }}}
 
 
-# {{{ FirstCustomFieldValue
 
 =head2 FirstCustomFieldValue FIELD
 
 
 =head2 FirstCustomFieldValue FIELD
 
@@ -1816,18 +2285,36 @@ Takes a field id or name
 sub FirstCustomFieldValue {
     my $self = shift;
     my $field = shift;
 sub FirstCustomFieldValue {
     my $self = shift;
     my $field = shift;
-    my $values = $self->CustomFieldValues($field);
-    if ($values->First) {
-        return $values->First->Content;
-    } else {
-        return undef;
-    }
 
 
+    my $values = $self->CustomFieldValues( $field );
+    return undef unless my $first = $values->First;
+    return $first->Content;
 }
 
 }
 
+=head2 CustomFieldValuesAsString FIELD
+
+Return the content of the CustomField FIELD for this ticket.
+If this is a multi-value custom field, values will be joined with newlines.
+
+Takes a field id or name as the first argument
+
+Takes an optional Separator => "," second and third argument
+if you want to join the values using something other than a newline
+
+=cut
+
+sub CustomFieldValuesAsString {
+    my $self  = shift;
+    my $field = shift;
+    my %args  = @_;
+    my $separator = $args{Separator} || "\n";
+
+    my $values = $self->CustomFieldValues( $field );
+    return join ($separator, grep { defined $_ }
+                 map { $_->Content } @{$values->ItemsArrayRef});
+}
 
 
 
 
-# {{{ CustomFieldValues
 
 =head2 CustomFieldValues FIELD
 
 
 =head2 CustomFieldValues FIELD
 
@@ -1842,11 +2329,12 @@ sub CustomFieldValues {
     my $self  = shift;
     my $field = shift;
 
     my $self  = shift;
     my $field = shift;
 
-    if ($field) {
-        my $cf = $self->LoadCustomFieldByIdentifier($field);
+    if ( $field ) {
+        my $cf = $self->LoadCustomFieldByIdentifier( $field );
 
 
-        # we were asked to search on a custom field we couldn't fine
+        # we were asked to search on a custom field we couldn't find
         unless ( $cf->id ) {
         unless ( $cf->id ) {
+            $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
             return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
         }
         return ( $cf->ValuesForObject($self) );
             return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
         }
         return ( $cf->ValuesForObject($self) );
@@ -1854,12 +2342,11 @@ sub CustomFieldValues {
 
     # we're not limiting to a specific custom field;
     my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
 
     # we're not limiting to a specific custom field;
     my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
-    $ocfs->LimitToObject($self);
+    $ocfs->LimitToObject( $self );
     return $ocfs;
     return $ocfs;
-
 }
 
 }
 
-=head2 CustomField IDENTIFER
+=head2 LoadCustomFieldByIdentifier IDENTIFER
 
 Find the custom field has id or name IDENTIFIER for this object.
 
 
 Find the custom field has id or name IDENTIFIER for this object.
 
@@ -1871,40 +2358,381 @@ sub LoadCustomFieldByIdentifier {
     my $self = shift;
     my $field = shift;
     
     my $self = shift;
     my $field = shift;
     
-    my $cf = RT::CustomField->new($self->CurrentUser);
-
+    my $cf;
     if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
     if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
+        $cf = RT::CustomField->new($self->CurrentUser);
+        $cf->SetContextObject( $self );
         $cf->LoadById( $field->id );
     }
     elsif ($field =~ /^\d+$/) {
         $cf = RT::CustomField->new($self->CurrentUser);
         $cf->LoadById( $field->id );
     }
     elsif ($field =~ /^\d+$/) {
         $cf = RT::CustomField->new($self->CurrentUser);
-        $cf->Load($field); 
+        $cf->SetContextObject( $self );
+        $cf->LoadById($field);
     } else {
 
         my $cfs = $self->CustomFields($self->CurrentUser);
     } else {
 
         my $cfs = $self->CustomFields($self->CurrentUser);
+        $cfs->SetContextObject( $self );
         $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
         $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
     }
     return $cf;
 }
 
         $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
         $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
     }
     return $cf;
 }
 
+sub ACLEquivalenceObjects { } 
 
 
-# }}}
+=head2 HasRight
 
 
-# }}}
+ Takes a paramhash with the attributes 'Right' and 'Principal'
+  'Right' is a ticket-scoped textual right from RT::ACE 
+  'Principal' is an RT::User object
 
 
-# }}}
+  Returns 1 if the principal has the right. Returns undef if not.
+
+=cut
+
+sub HasRight {
+    my $self = shift;
+    my %args = (
+        Right     => undef,
+        Principal => undef,
+        @_
+    );
+
+    $args{Principal} ||= $self->CurrentUser->PrincipalObj;
+
+    return $args{'Principal'}->HasRight(
+        Object => $self->Id ? $self : $RT::System,
+        Right  => $args{'Right'}
+    );
+}
+
+sub CurrentUserHasRight {
+    my $self = shift;
+    return $self->HasRight( Right => @_ );
+}
+
+sub ModifyLinkRight { }
 
 
-sub BasicColumns {
+=head2 ColumnMapClassName
+
+ColumnMap needs a massaged collection class name to load the correct list
+display.  Equivalent to L<RT::SearchBuilder/ColumnMapClassName>, but provided
+for a record instead of a collection.
+
+Returns a string.  May be called as a package method.
+
+=cut
+
+sub ColumnMapClassName {
+    my $self  = shift;
+    my $Class = ref($self) || $self;
+       $Class =~ s/:/_/g;
+    return $Class;
 }
 
 }
 
+sub BasicColumns { }
+
 sub WikiBase {
 sub WikiBase {
-  return $RT::WebPath. "/index.html?q=";
+    return RT->Config->Get('WebPath'). "/index.html?q=";
+}
+
+sub UID {
+    my $self = shift;
+    return undef unless defined $self->Id;
+    return "@{[ref $self]}-$RT::Organization-@{[$self->Id]}";
+}
+
+sub FindDependencies {
+    my $self = shift;
+    my ($walker, $deps) = @_;
+    for my $col (qw/Creator LastUpdatedBy/) {
+        if ( $self->_Accessible( $col, 'read' ) ) {
+            next unless $self->$col;
+            my $obj = RT::Principal->new( $self->CurrentUser );
+            $obj->Load( $self->$col );
+            $deps->Add( out => $obj->Object );
+        }
+    }
+
+    # Object attributes, we have to check on every object
+    my $objs = $self->Attributes;
+    $deps->Add( in => $objs );
+
+    # Transactions
+    if (   $self->isa("RT::Ticket")
+        or $self->isa("RT::User")
+        or $self->isa("RT::Group")
+        or $self->isa("RT::Article")
+        or $self->isa("RT::Queue") )
+    {
+        $objs = RT::Transactions->new( $self->CurrentUser );
+        $objs->Limit( FIELD => 'ObjectType', VALUE => ref $self );
+        $objs->Limit( FIELD => 'ObjectId', VALUE => $self->id );
+        $deps->Add( in => $objs );
+    }
+
+    # Object custom field values
+    if ((   $self->isa("RT::Transaction")
+         or $self->isa("RT::Ticket")
+         or $self->isa("RT::User")
+         or $self->isa("RT::Group")
+         or $self->isa("RT::Queue")
+         or $self->isa("RT::Article") )
+            and $self->can("CustomFieldValues") )
+    {
+        $objs = $self->CustomFieldValues; # Actually OCFVs
+        $objs->{find_expired_rows} = 1;
+        $deps->Add( in => $objs );
+    }
+
+    # ACE records
+    if (   $self->isa("RT::Group")
+        or $self->isa("RT::Class")
+        or $self->isa("RT::Queue")
+        or $self->isa("RT::CustomField") )
+    {
+        $objs = RT::ACL->new( $self->CurrentUser );
+        $objs->LimitToObject( $self );
+        $deps->Add( in => $objs );
+    }
+}
+
+sub Serialize {
+    my $self = shift;
+    my %args = (
+        Methods => {},
+        UIDs    => 1,
+        @_,
+    );
+    my %methods = (
+        Creator       => "CreatorObj",
+        LastUpdatedBy => "LastUpdatedByObj",
+        %{ $args{Methods} || {} },
+    );
+
+    my %values = %{$self->{values}};
+
+    my %ca = %{ $self->_ClassAccessible };
+    my @cols = grep {exists $values{lc $_} and defined $values{lc $_}} keys %ca;
+
+    my %store;
+    $store{$_} = $values{lc $_} for @cols;
+    $store{id} = $values{id}; # Explicitly necessary in some cases
+
+    # Un-apply the _transfer_ encoding, but don't mess with the octets
+    # themselves.  Calling ->Content directly would, in some cases,
+    # decode from some mostly-unknown character set -- which reversing
+    # on the far end would be complicated.
+    if ($ca{ContentEncoding} and $ca{ContentType}) {
+        my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/;
+        $store{$content_col} = $self->_DecodeLOB(
+            "application/octet-stream", # Lie so that we get bytes, not characters
+            $self->ContentEncoding,
+            $self->_Value( $content_col, decode_utf8 => 0 )
+        );
+        delete $store{ContentEncoding};
+    }
+    return %store unless $args{UIDs};
+
+    # Use FooObj to turn Foo into a reference to the UID
+    for my $col ( grep {$store{$_}} @cols ) {
+        my $method = $methods{$col};
+        if (not $method) {
+            $method = $col;
+            $method =~ s/(Id)?$/Obj/;
+        }
+        next unless $self->can($method);
+
+        my $obj = $self->$method;
+        next unless $obj and $obj->isa("RT::Record");
+        $store{$col} = \($obj->UID);
+    }
+
+    # Anything on an object should get the UID stored instead
+    if ($store{ObjectType} and $store{ObjectId} and $self->can("Object")) {
+        delete $store{$_} for qw/ObjectType ObjectId/;
+        $store{Object} = \($self->Object->UID);
+    }
+
+    return %store;
+}
+
+sub PreInflate {
+    my $class = shift;
+    my ($importer, $uid, $data) = @_;
+
+    my $ca = $class->_ClassAccessible;
+    my %ca = %{ $ca };
+
+    if ($ca{ContentEncoding} and $ca{ContentType}) {
+        my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/;
+        if (defined $data->{$content_col}) {
+            my ($ContentEncoding, $Content) = $class->_EncodeLOB(
+                $data->{$content_col}, $data->{ContentType},
+            );
+            $data->{ContentEncoding} = $ContentEncoding;
+            $data->{$content_col} = $Content;
+        }
+    }
+
+    if ($data->{Object} and not $ca{Object}) {
+        my $ref_uid = ${ delete $data->{Object} };
+        my $ref = $importer->Lookup( $ref_uid );
+        if ($ref) {
+            my ($class, $id) = @{$ref};
+            $data->{ObjectId} = $id;
+            $data->{ObjectType} = $class;
+        } else {
+            $data->{ObjectId} = 0;
+            $data->{ObjectType} = "";
+            $importer->Postpone(
+                for => $ref_uid,
+                uid => $uid,
+                column => "ObjectId",
+                classcolumn => "ObjectType",
+            );
+        }
+    }
+
+    for my $col (keys %{$data}) {
+        if (ref $data->{$col}) {
+            my $ref_uid = ${ $data->{$col} };
+            my $ref = $importer->Lookup( $ref_uid );
+            if ($ref) {
+                my (undef, $id) = @{$ref};
+                $data->{$col} = $id;
+            } else {
+                $data->{$col} = 0;
+                $importer->Postpone(
+                    for => $ref_uid,
+                    uid => $uid,
+                    column => $col,
+                );
+            }
+        }
+    }
+
+    return 1;
+}
+
+sub PostInflate {
+}
+
+=head2 _AsInsertQuery
+
+Returns INSERT query string that duplicates current record and
+can be used to insert record back into DB after delete.
+
+=cut
+
+sub _AsInsertQuery
+{
+    my $self = shift;
+
+    my $dbh = $RT::Handle->dbh;
+
+    my $res = "INSERT INTO ". $dbh->quote_identifier( $self->Table );
+    my $values = $self->{'values'};
+    $res .= "(". join( ",", map { $dbh->quote_identifier( $_ ) } sort keys %$values ) .")";
+    $res .= " VALUES";
+    $res .= "(". join( ",", map { $dbh->quote( $values->{$_} ) } sort keys %$values ) .")";
+    $res .= ";";
+
+    return $res;
+}
+
+sub BeforeWipeout { return 1 }
+
+=head2 Dependencies
+
+Returns L<RT::Shredder::Dependencies> object.
+
+=cut
+
+sub Dependencies
+{
+    my $self = shift;
+    my %args = (
+            Shredder => undef,
+            Flags => RT::Shredder::Constants::DEPENDS_ON,
+            @_,
+           );
+
+    unless( $self->id ) {
+        RT::Shredder::Exception->throw('Object is not loaded');
+    }
+
+    my $deps = RT::Shredder::Dependencies->new();
+    if( $args{'Flags'} & RT::Shredder::Constants::DEPENDS_ON ) {
+        $self->__DependsOn( %args, Dependencies => $deps );
+    }
+    return $deps;
+}
+
+sub __DependsOn
+{
+    my $self = shift;
+    my %args = (
+            Shredder => undef,
+            Dependencies => undef,
+            @_,
+           );
+    my $deps = $args{'Dependencies'};
+    my $list = [];
+
+# Object custom field values
+    my $objs = $self->CustomFieldValues;
+    $objs->{'find_expired_rows'} = 1;
+    push( @$list, $objs );
+
+# Object attributes
+    $objs = $self->Attributes;
+    push( @$list, $objs );
+
+# Transactions
+    $objs = RT::Transactions->new( $self->CurrentUser );
+    $objs->Limit( FIELD => 'ObjectType', VALUE => ref $self );
+    $objs->Limit( FIELD => 'ObjectId', VALUE => $self->id );
+    push( @$list, $objs );
+
+# Links
+    if ( $self->can('Links') ) {
+        # make sure we don't skip any record
+        no warnings 'redefine';
+        local *RT::Links::IsValidLink = sub { 1 };
+
+        foreach ( qw(Base Target) ) {
+            my $objs = $self->Links( $_ );
+            $objs->_DoSearch;
+            push @$list, $objs->ItemsArrayRef;
+        }
+    }
+
+# ACE records
+    $objs = RT::ACL->new( $self->CurrentUser );
+    $objs->LimitToObject( $self );
+    push( @$list, $objs );
+
+    $deps->_PushDependencies(
+            BaseObject => $self,
+            Flags => RT::Shredder::Constants::DEPENDS_ON,
+            TargetObjects => $list,
+            Shredder => $args{'Shredder'}
+        );
+    return;
+}
+
+# implement proxy method because some RT classes
+# override Delete method
+sub __Wipeout
+{
+    my $self = shift;
+    my $msg = $self->UID ." wiped out";
+    $self->SUPER::Delete;
+    $RT::Logger->info( $msg );
+    return;
 }
 
 }
 
-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;