X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FRecord.pm;h=8f1b5be5ed1ad29d39481859303d856ffdc98731;hp=8664e2867dfd0dc98c52fa77144ec245dabbafcd;hb=07bf36bccc4979b12db49b0f71524de4296f3717;hpb=63a268637b2d51a8766412617724b9436439deb6

diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm
index 8664e2867..8f1b5be5e 100755
--- a/rt/lib/RT/Record.pm
+++ b/rt/lib/RT/Record.pm
@@ -1,40 +1,40 @@
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 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)
-# 
-# 
+#
+#
 # 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 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
 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-# 
-# 
+#
+#
 # 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.)
-# 
+#
 # 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.
-# 
+#
 # END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
   RT::Record - Base class for RT record objects
@@ -55,11 +56,6 @@
 =head1 DESCRIPTION
 
 
-=begin testing
-
-ok (require RT::Record);
-
-=end testing
 
 =head1 METHODS
 
@@ -70,37 +66,31 @@ package RT::Record;
 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::I18N;
-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 = { };
+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(@_);
 }
 
-# }}}
 
-# {{{ _PrimaryKeys
 
 =head2 _PrimaryKeys
 
@@ -108,12 +98,24 @@ The primary keys for RT classes is 'id'
 
 =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
 
@@ -132,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
 
+# 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;
-    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
@@ -165,13 +177,12 @@ Return this object's attributes as an RT::Attributes object
 
 sub Attributes {
     my $self = shift;
-    
     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'});
 }
 
 
@@ -238,17 +249,17 @@ Deletes all attributes with the matching name for this object.
 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.
-
-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
 
@@ -259,15 +270,15 @@ sub FirstAttribute {
 }
 
 
-# {{{ sub _Handle 
-sub _Handle {
+sub ClearAttributes {
     my $self = shift;
-    return ($RT::Handle);
+    delete $self->{'attributes'};
+
 }
 
-# }}}
+sub _Handle { return $RT::Handle }
+
 
-# {{{ sub Create 
 
 =head2  Create PARAMHASH
 
@@ -279,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.
 
+=over
+
+=item Created
+
+=item Creator
+
+=item LastUpdated
+
+=item LastUpdatedBy
+
+=back
+
 =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) );
             }
@@ -294,15 +317,22 @@ sub Create {
                 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'; 
     }
-    $attribs{'LastUpdated'} = $now->ISO()
+    $attribs{'LastUpdated'} = $now_iso
       if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
 
     $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
@@ -336,8 +366,6 @@ sub Create {
    }
 
     if  (UNIVERSAL::isa('errno',$id)) {
-        exit(0);
-       warn "It's here!";
         return(undef);
     }
 
@@ -354,9 +382,7 @@ sub Create {
 
 }
 
-# }}}
 
-# {{{ sub LoadByCols
 
 =head2 LoadByCols
 
@@ -367,134 +393,98 @@ DB is case sensitive
 
 sub LoadByCols {
     my $self = shift;
-    my %hash = (@_);
 
     # 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 ( $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:
 
-# {{{ LastUpdatedObj
 
 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;
 }
 
-# }}}
 
-# {{{ CreatedObj
 
 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;
 }
 
-# }}}
 
-# {{{ AgeAsString
-#
-# TODO: This should be deprecated
-#
+# B<DEPRECATED> and will be removed in 4.4
 sub AgeAsString {
     my $self = shift;
+    RT->Deprecated(
+        Remove => "4.4",
+        Instead => "->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() );
-
-    }
-    else {
+    } else {
         return "never";
     }
 }
 
-# }}}
-
-# {{{ CreatedAsString
-#
-# TODO This should be deprecated 
-#
 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;
 
@@ -526,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) {
-        $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
 
@@ -554,8 +547,7 @@ It takes no options. Arguably, this is a bug
 
 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' ) ) {
@@ -572,9 +564,7 @@ sub _SetLastUpdated {
     }
 }
 
-# }}}
 
-# {{{ sub CreatorObj 
 
 =head2 CreatorObj
 
@@ -592,9 +582,7 @@ sub CreatorObj {
     return ( $self->{'CreatorObj'} );
 }
 
-# }}}
 
-# {{{ sub LastUpdatedByObj
 
 =head2 LastUpdatedByObj
 
@@ -611,9 +599,7 @@ sub LastUpdatedByObj {
     return $self->{'LastUpdatedByObj'};
 }
 
-# }}}
 
-# {{{ sub URI 
 
 =head2 URI
 
@@ -627,7 +613,6 @@ sub URI {
     return($uri->URIForObject($self));
 }
 
-# }}}
 
 =head2 ValidateName NAME
 
@@ -638,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;
-    if ($value && $value=~ /^\d+$/) {
+    if (defined $value && $value=~ /^\d+$/) {
         return(0);
     } else  {
-         return (1);
+        return(1);
     }
 }
 
@@ -662,36 +647,43 @@ sub SQLType {
 
 }
 
-
 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 {
-        # 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;
+
 }
 
 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
 
 sub _CacheConfig {
   {
-     'cache_p'        => 1,
      'cache_for_sec'  => 30,
   }
 }
@@ -700,6 +692,7 @@ sub _CacheConfig {
 
 sub _BuildTableAttributes {
     my $self = shift;
+    my $class = ref($self) || $self;
 
     my $attributes;
     if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
@@ -709,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};
             }
         }
     }
-
 }
 
 
@@ -754,7 +729,7 @@ DBIx::SearchBuilder::Record
 
 sub _ClassAccessible {
     my $self = shift;
-    return $_TABLE_ATTR->{ref($self)};
+    return $_TABLE_ATTR->{ref($self) || $self};
 }
 
 =head2 _Accessible COLUMN ATTRIBUTE
@@ -768,92 +743,155 @@ sub _Accessible  {
   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 {
-        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;
-    my $ContentType     = shift;
-    my $ContentEncoding = shift;
+    my $ContentType     = shift || '';
+    my $ContentEncoding = shift || 'none';
     my $Content         = shift;
 
+    RT::Util::assert_bytes( $Content );
+
     if ( $ContentEncoding eq 'base64' ) {
         $Content = MIME::Base64::decode_base64($Content);
     }
@@ -863,31 +901,18 @@ sub _DecodeLOB {
     elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
     }
-
     if ( RT::I18N::IsTextualContentType($ContentType) ) {
-       $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
+        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,
@@ -915,8 +940,9 @@ sub Update {
 
     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} ) {
@@ -937,6 +963,7 @@ sub Update {
 
         $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.
@@ -944,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
-        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+)/;
@@ -956,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'));
-        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
-                                   "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
@@ -980,11 +1051,8 @@ sub Update {
     return @results;
 }
 
-# {{{ Routines dealing with Links
 
-# {{{ Link Collections
 
-# {{{ sub Members
 
 =head2 Members
 
@@ -998,9 +1066,7 @@ sub Members {
     return ( $self->_Links( 'Target', 'MemberOf' ) );
 }
 
-# }}}
 
-# {{{ sub MemberOf
 
 =head2 MemberOf
 
@@ -1014,9 +1080,7 @@ sub MemberOf {
     return ( $self->_Links( 'Base', 'MemberOf' ) );
 }
 
-# }}}
 
-# {{{ RefersTo
 
 =head2 RefersTo
 
@@ -1029,9 +1093,7 @@ sub RefersTo {
     return ( $self->_Links( 'Base', 'RefersTo' ) );
 }
 
-# }}}
 
-# {{{ ReferredToBy
 
 =head2 ReferredToBy
 
@@ -1044,9 +1106,7 @@ sub ReferredToBy {
     return ( $self->_Links( 'Target', 'RefersTo' ) );
 }
 
-# }}}
 
-# {{{ DependedOnBy
 
 =head2 DependedOnBy
 
@@ -1059,60 +1119,15 @@ sub DependedOnBy {
     return ( $self->_Links( 'Target', 'DependsOn' ) );
 }
 
-# }}}
 
 
 
 =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
 
@@ -1126,16 +1141,13 @@ sub HasUnresolvedDependencies {
     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) {
-        return 1;
+        return $deps->Count;
     }
     else {
         return (undef);
@@ -1143,7 +1155,6 @@ sub HasUnresolvedDependencies {
 }
 
 
-# {{{ UnresolvedDependencies 
 
 =head2 UnresolvedDependencies
 
@@ -1158,19 +1169,14 @@ sub UnresolvedDependencies {
     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);
 
 }
 
-# }}}
 
-# {{{ AllDependedOnBy
 
 =head2 AllDependedOnBy
 
@@ -1184,41 +1190,66 @@ dependency search.
 
 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 = (
+        LinkType  => undef,
+        Direction => undef,
         Type   => undef,
-	_found => {},
-	_top   => 1,
+        _found => {},
+        _top   => 1,
         @_
     );
 
+    my $dep = $self->_Links( $args{Direction}, $args{LinkType});
     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}) {
-	return map { $args{_found}{$_} } sort keys %{$args{_found}};
+        return map { $args{_found}{$_} } sort keys %{$args{_found}};
     }
     else {
-	return 1;
+        return 1;
     }
 }
 
-# }}}
 
-# {{{ DependsOn
 
 =head2 DependsOn
 
@@ -1237,7 +1268,9 @@ sub DependsOn {
 
 =head2 Customers
 
-  This returns an RT::Links object which references all the customers that this object is a member of.
+  This returns an RT::Links object which references all the customers that 
+  this object is a member of.  This includes both explicitly linked customers
+  and links implied by services.
 
 =cut
 
@@ -1249,11 +1282,21 @@ sub Customers {
 
       $self->{'Customers'} = $self->MemberOf->Clone;
 
-      $self->{'Customers'}->Limit(
-                                   FIELD    => 'Target',
+      $self->{'Customers'}->Limit( FIELD    => 'Base',
                                    OPERATOR => 'STARTSWITH',
-                                   VALUE    => 'freeside://freeside/cust_main/',
+                                   VALUE    => 'fsck.com-rt://%/ticket/',
                                  );
+
+      for my $fstable (qw(cust_main cust_svc)) {
+
+        $self->{'Customers'}->Limit(
+                                     FIELD    => 'Target',
+                                     OPERATOR => 'STARTSWITH',
+                                     VALUE    => "freeside://freeside/$fstable",
+                                     ENTRYAGGREGATOR => 'OR',
+                                     SUBCLAUSE => 'customers',
+                                   );
+      }
     }
 
     warn "->Customers method called on $self; returning ".
@@ -1265,7 +1308,36 @@ sub Customers {
 
 # }}}
 
-# {{{ sub _Links 
+# {{{ Services
+
+=head2 Services
+
+  This returns an RT::Links object which references all the services this 
+  object is a member of.
+
+=cut
+
+sub Services {
+    my( $self, %opt ) = @_;
+
+    unless ( $self->{'Services'} ) {
+
+      $self->{'Services'} = $self->MemberOf->Clone;
+
+      $self->{'Services'}->Limit(
+                                   FIELD    => 'Target',
+                                   OPERATOR => 'STARTSWITH',
+                                   VALUE    => "freeside://freeside/cust_svc",
+                                 );
+    }
+
+    return $self->{'Services'};
+}
+
+
+
+
+
 
 =head2 Links DIRECTION [TYPE]
 
@@ -1278,7 +1350,7 @@ links of any type.
 
 =cut
 
-*Links = \&_Links;
+sub Links { shift->_Links(@_) }
 
 sub _Links {
     my $self = shift;
@@ -1289,7 +1361,7 @@ sub _Links {
     my $type  = shift || "";
 
     unless ( $self->{"$field$type"} ) {
-        $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
+        $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
             # at least to myself
             $self->{"$field$type"}->Limit( FIELD => $field,
                                            VALUE => $self->URI,
@@ -1301,38 +1373,90 @@ sub _Links {
     return ( $self->{"$field$type"} );
 }
 
-# }}}
-
-# }}}
-
-# {{{ sub _AddLink
 
-=head2 _AddLink
 
-Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
 
-Returns C<link id>, C<message> and C<exist> flag.
+=head2 FormatType
 
+Takes a Type and returns a string that is more human readable.
 
 =cut
 
-
-sub _AddLink {
+sub FormatType{
     my $self = shift;
-    my %args = ( Target => '',
-                 Base   => '',
-                 Type   => '',
-                 Silent => undef,
-                 @_ );
+    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'} ) {
-        $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();
@@ -1348,8 +1472,30 @@ sub _AddLink {
         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'},
@@ -1359,101 +1505,222 @@ sub _AddLink {
         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},
-                                  Base   => $args{Base},
-                                  Type   => $args{Type} );
+                                            Base   => $args{Base},
+                                            Type   => $args{Type} );
 
     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';
+
+    # 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;
+    }
 
-# {{{ sub _DeleteLink 
+    return ($linkid, $TransString);
+}
 
 =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 = (
-        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'} ) {
-        $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();
-	$remote_link = $args{'Base'};
-    	$direction = 'Target';
+        $remote_link    = $args{'Base'};
+        $direction      = 'Target';
     }
     elsif ( $args{'Target'} ) {
         $args{'Base'} = $self->URI();
-	$remote_link = $args{'Target'};
-        $direction='Base';
+        $remote_link  = $args{'Target'};
+        $direction    = 'Base';
     }
     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') );
     }
 
-    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 LockForUpdate {
+    my $self = shift;
 
-# {{{ sub _NewTransaction
+    my $pk = $self->_PrimaryKey;
+    my $id = @_ ? $_[0] : $self->$pk;
+    $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
+    if (RT->Config->Get('DatabaseType') eq "SQLite") {
+        # SQLite does DB-level locking, upgrading the transaction to
+        # "RESERVED" on the first UPDATE/INSERT/DELETE.  Do a no-op
+        # UPDATE to force the upgade.
+        return RT->DatabaseHandle->dbh->do(
+            "UPDATE " .$self->Table.
+                " SET $pk = $pk WHERE 1 = 0");
+    } else {
+        return $self->_LoadFromSQL(
+            "SELECT * FROM ".$self->Table
+                ." WHERE $pk = ? FOR UPDATE",
+            $id,
+        );
+    }
+}
 
 =head2 _NewTransaction  PARAMHASH
 
@@ -1476,27 +1743,34 @@ sub _NewTransaction {
         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) {
-	$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;
-    my $trans = new RT::Transaction( $self->CurrentUser );
+    my $trans = RT::Transaction->new( $self->CurrentUser );
     my ( $transaction, $msg ) = $trans->Create(
-	ObjectId  => $self->Id,
-	ObjectType => ref($self),
+        ObjectId  => $self->Id,
+        ObjectType => ref($self),
         TimeTaken => $args{'TimeTaken'},
         Type      => $args{'Type'},
         Data      => $args{'Data'},
@@ -1509,6 +1783,8 @@ sub _NewTransaction {
         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.
@@ -1519,31 +1795,29 @@ sub _NewTransaction {
     $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 );
 }
 
-# }}}
 
-# {{{ sub 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;
 
-    use RT::Transactions;
     my $transactions = RT::Transactions->new( $self->CurrentUser );
-
-    #If the user has no rights, return an empty object
     $transactions->Limit(
         FIELD => 'ObjectId',
         VALUE => $self->id,
@@ -1553,40 +1827,177 @@ sub Transactions {
         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 );
-
+    
+    $cfs->SetContextObject( $self );
     # XXX handle multiple types properly
     $cfs->LimitToLookupType( $self->CustomFieldLookupType );
-    $cfs->LimitToGlobalOrObjectId(
-        $self->_LookupId( $self->CustomFieldLookupType ) );
+    $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId );
+    $cfs->ApplySortOrder;
 
     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 $lookup = shift;
+    my $lookup = shift || $self->CustomFieldLookupType;
     my @classes = ($lookup =~ /RT::(\w+)-/g);
 
+    # Work on "RT::Queue", for instance
+    return $self->Id unless @classes;
+
     my $object = $self;
+    # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
+    my $final = shift @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;
 }
 
 
@@ -1598,30 +2009,20 @@ Returns the path RT uses to figure out which custom fields apply to this object.
 
 sub CustomFieldLookupType {
     my $self = shift;
-    return ref($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);
-
+    return ref($self) || $self;
 }
 
-# {{{ AddCustomFieldValue
 
 =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 
-(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
 
@@ -1635,12 +2036,13 @@ sub _AddCustomFieldValue {
     my %args = (
         Field             => undef,
         Value             => undef,
+        LargeContent      => undef,
+        ContentType       => undef,
         RecordTransaction => 1,
         @_
     );
 
     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
-
     unless ( $cf->Id ) {
         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
     }
@@ -1652,12 +2054,15 @@ sub _AddCustomFieldValue {
             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") );
@@ -1665,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
-    unless ( $cf->UnlimitedValues) {
+    unless ( $cf->UnlimitedValues ) {
+
+        # 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....
+        # 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 ) {
@@ -1679,8 +2087,8 @@ sub _AddCustomFieldValue {
                 $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 );
@@ -1696,12 +2104,14 @@ sub _AddCustomFieldValue {
             $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'},
@@ -1709,19 +2119,17 @@ sub _AddCustomFieldValue {
             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 );
-        $new_value->Load($new_value_id);
+        $new_value->Load( $new_value_id );
 
         # now that adding the new value was successful, delete the old one
-        if ($old_value) {
+        if ( $old_value ) {
             my ( $val, $msg ) = $old_value->Delete();
-            unless ($val) {
-                return ( 0, $msg );
-            }
+            return ( 0, $msg ) unless $val;
         }
 
         if ( $args{'RecordTransaction'} ) {
@@ -1734,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;
+            }
+        }
+
+        unless ( defined $old_content && length $old_content ) {
+            return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
         }
-        elsif ( $new_value->Content eq '' ) {
-            return ( 1,
-                $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) );
+        elsif ( !defined $new_content || !length $new_content ) {
+            return ( $new_value_id,
+                $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
         }
         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 {
-        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'},
         );
 
-        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'} ) {
-            my ( $TransactionId, $Msg, $TransactionObj ) =
-              $self->_NewTransaction(
+            my ( $tid, $msg ) = $self->_NewTransaction(
                 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 }
 
@@ -1802,10 +2231,10 @@ sub DeleteCustomFieldValue {
     );
 
     my $cf = $self->LoadCustomFieldByIdentifier($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'},
@@ -1814,6 +2243,7 @@ sub DeleteCustomFieldValue {
     unless ($val) {
         return ( 0, $msg );
     }
+
     my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
         Type          => 'CustomField',
         Field         => $cf->Id,
@@ -1824,18 +2254,26 @@ sub DeleteCustomFieldValue {
         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]",
-            $TransactionObj->OldValue, $cf->Name
+            $old_value, $cf->Name
         )
     );
 }
 
-# }}}
 
-# {{{ FirstCustomFieldValue
 
 =head2 FirstCustomFieldValue FIELD
 
@@ -1847,18 +2285,36 @@ Takes a field id or name
 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
 
@@ -1873,11 +2329,12 @@ sub CustomFieldValues {
     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 ) {
+            $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
             return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
         }
         return ( $cf->ValuesForObject($self) );
@@ -1885,12 +2342,11 @@ sub CustomFieldValues {
 
     # we're not limiting to a specific custom field;
     my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
-    $ocfs->LimitToObject($self);
+    $ocfs->LimitToObject( $self );
     return $ocfs;
-
 }
 
-=head2 CustomField IDENTIFER
+=head2 LoadCustomFieldByIdentifier IDENTIFER
 
 Find the custom field has id or name IDENTIFIER for this object.
 
@@ -1902,40 +2358,381 @@ sub LoadCustomFieldByIdentifier {
     my $self = shift;
     my $field = shift;
     
-    my $cf = RT::CustomField->new($self->CurrentUser);
-
+    my $cf;
     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->Load($field); 
+        $cf->SetContextObject( $self );
+        $cf->LoadById($field);
     } 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;
 }
 
+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 BasicColumns {
+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 { }
+
+=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 {
-  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;