fix phantom customer links
[freeside.git] / rt / lib / RT / Record.pm
index 59867aa..8f1b5be 100755 (executable)
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -66,12 +66,18 @@ package RT::Record;
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
+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 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');
 
 our $_TABLE_ATTR = { };
 use base RT->Config->Get('RecordBaseClass');
@@ -128,21 +134,39 @@ sub Delete {
     } 
 }
 
     } 
 }
 
-=head2 ObjectTypeStr
+=head2 RecordType
+
+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
 
 
-Returns a string which is this object's type.  The type is the class,
-without the "RT::" prefix.
+sub RecordType {
+    my $res = ref($_[0]) || $_[0];
+    $res =~ s/.*:://;
+    return $res;
+}
 
 
+=head2 ObjectTypeStr
+
+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
@@ -373,7 +397,10 @@ sub LoadByCols {
     # We don't want to hang onto this
     $self->ClearAttributes;
 
     # We don't want to hang onto this
     $self->ClearAttributes;
 
-    return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
+    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
@@ -391,7 +418,8 @@ sub LoadByCols {
             $hash{$key}->{function} = $func;
         }
     }
             $hash{$key}->{function} = $func;
         }
     }
-    return $self->SUPER::LoadByCols( %hash );
+    my ( $ret, $msg ) = $self->SUPER::LoadByCols( %hash );
+    return wantarray ? ( $ret, $msg ) : $ret;
 }
 
 
 }
 
 
@@ -419,57 +447,44 @@ sub CreatedObj {
 }
 
 
 }
 
 
-#
-# 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() );
 }
 
-
-
-# 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";
     }
 }
 
-
-#
-# TODO This should be deprecated 
-#
 sub CreatedAsString {
     my $self = shift;
     return ( $self->CreatedObj->AsString() );
 }
 
 sub CreatedAsString {
     my $self = shift;
     return ( $self->CreatedObj->AsString() );
 }
 
-
-#
-# TODO This should be deprecated
-#
-sub LongSinceUpdateAsString {
-    my $self = shift;
-    if ( $self->LastUpdated ) {
-
-        return ( $self->LastUpdatedObj->AgeAsString() );
-
-    }
-    else {
-        return "never";
-    }
-}
-
-
-
-#
 sub _Set {
     my $self = shift;
 
 sub _Set {
     my $self = shift;
 
@@ -532,7 +547,6 @@ It takes no options. Arguably, this is a bug
 
 sub _SetLastUpdated {
     my $self = shift;
 
 sub _SetLastUpdated {
     my $self = shift;
-    use RT::Date;
     my $now = RT::Date->new( $self->CurrentUser );
     $now->SetToNow();
 
     my $now = RT::Date->new( $self->CurrentUser );
     $now->SetToNow();
 
@@ -643,15 +657,20 @@ sub __Value {
     }
 
     my $value = $self->SUPER::__Value($field);
     }
 
     my $value = $self->SUPER::__Value($field);
+    return $value if ref $value;
 
     return undef if (!defined $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 ( $args{'decode_utf8'} ) {
-        if ( !utf8::is_utf8($value) ) {
+        if ( !utf8::is_utf8($value) ) { # mysql/sqlite
             utf8::decode($value);
         }
             utf8::decode($value);
         }
-    }
-    else {
+    } else {
         if ( utf8::is_utf8($value) ) {
             utf8::encode($value);
         }
         if ( utf8::is_utf8($value) ) {
             utf8::encode($value);
         }
@@ -665,7 +684,6 @@ sub __Value {
 
 sub _CacheConfig {
   {
 
 sub _CacheConfig {
   {
-     'cache_p'        => 1,
      'cache_for_sec'  => 30,
   }
 }
      'cache_for_sec'  => 30,
   }
 }
@@ -725,15 +743,19 @@ 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 FILENAME
 
 Takes a potentially large attachment. Returns (ContentEncoding,
 
 }
 
 =head2 _EncodeLOB BODY MIME_TYPE FILENAME
 
 Takes a potentially large attachment. Returns (ContentEncoding,
-EncodedBody, MimeType, Filename) based on system configuration and
+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.
 
 selected database.  Returns a custom (short) text/plain message if
 DropLongAttachments causes an attachment to not be stored.
 
@@ -745,78 +767,97 @@ 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.
 
 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 $Filename = 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->Config->Get('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::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");
-            $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';
-        }
+        # 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->Config->Get('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->Config->Get('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));
-                $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
-                $Filename .= ".txt" if $Filename;
-                return ("none", "Large attachment dropped", "text/plain", $Filename );
-            }
         }
 
         }
 
-        # 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, $MIMEType, $Filename );
 
 
+    return ($ContentEncoding, $Body, $MIMEType, $Filename, $note_args );
 }
 
 }
 
-=head2 _DecodeLOB
+=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
 
 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
@@ -832,6 +873,12 @@ 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.
 
 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.
 
 Important Note - This function expects an octet string and returns a
 character string for non-binary data.
 
@@ -843,6 +890,8 @@ sub _DecodeLOB {
     my $ContentEncoding = shift || 'none';
     my $Content         = shift;
 
     my $ContentEncoding = shift || 'none';
     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);
     }
@@ -853,28 +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('UTF-8',$Content,Encode::FB_PERLQQ) 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);
 }
 
 }
 
-# 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,
@@ -936,17 +974,16 @@ sub Update {
         do {
             no warnings "uninitialized";
             local $@;
         do {
             no warnings "uninitialized";
             local $@;
-            eval {
+            my $name = eval {
                 my $object = $attribute . "Obj";
                 my $object = $attribute . "Obj";
-                my $name = $self->$object->Name;
-                next if $name eq $value || $name eq ($value || 0);
+                $self->$object->Name;
             };
             };
+            unless ($@) {
+                next if $name eq $value || $name eq ($value || 0);
+            }
 
 
-            my $current = $self->$attribute();
-            # RT::Queue->Lifecycle returns a Lifecycle object instead of name
-            $current = eval { $current->Name } if ref $current;
-            next if $truncated_value eq $current;
-            next if ( $truncated_value || 0 ) eq $current;
+            next if $truncated_value eq $self->$attribute();
+            next if ( $truncated_value || 0 ) eq $self->$attribute();
         };
 
         $new_values{$attribute} = $value;
         };
 
         $new_values{$attribute} = $value;
@@ -1104,12 +1141,9 @@ 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) {
@@ -1135,10 +1169,7 @@ 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);
@@ -1186,35 +1217,35 @@ sub _AllLinkedTickets {
         LinkType  => undef,
         Direction => undef,
         Type   => undef,
         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()) {
         my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
         @_
     );
 
     my $dep = $self->_Links( $args{Direction}, $args{LinkType});
     while (my $link = $dep->Next()) {
         my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
-       next unless ($uri->IsLocal());
+        next unless ($uri->IsLocal());
         my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
         my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
-       next if $args{_found}{$obj->Id};
+        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{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;
     }
 }
 
     }
 }
 
@@ -1251,6 +1282,11 @@ sub Customers {
 
       $self->{'Customers'} = $self->MemberOf->Clone;
 
 
       $self->{'Customers'} = $self->MemberOf->Clone;
 
+      $self->{'Customers'}->Limit( FIELD    => 'Base',
+                                   OPERATOR => 'STARTSWITH',
+                                   VALUE    => 'fsck.com-rt://%/ticket/',
+                                 );
+
       for my $fstable (qw(cust_main cust_svc)) {
 
         $self->{'Customers'}->Limit(
       for my $fstable (qw(cust_main cust_svc)) {
 
         $self->{'Customers'}->Limit(
@@ -1349,8 +1385,8 @@ Takes a Type and returns a string that is more human readable.
 sub FormatType{
     my $self = shift;
     my %args = ( Type => '',
 sub FormatType{
     my $self = shift;
     my %args = ( Type => '',
-                @_
-              );
+                 @_
+               );
     $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
     $args{Type} =~ s/^\s+//;
     return $args{Type};
     $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
     $args{Type} =~ s/^\s+//;
     return $args{Type};
@@ -1368,35 +1404,51 @@ Takes either a Target or a Base and returns a string of human friendly text.
 sub FormatLink {
     my $self = shift;
     my %args = ( Object => undef,
 sub FormatLink {
     my $self = shift;
     my %args = ( Object => undef,
-                FallBack => '',
-                @_
-              );
+                 FallBack => '',
+                 @_
+               );
     my $text = "URI " . $args{FallBack};
     if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
     my $text = "URI " . $args{FallBack};
     if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
-       $text = "Ticket " . $args{Object}->id;
+        $text = "Ticket " . $args{Object}->id;
     }
     return $text;
 }
 
     }
     return $text;
 }
 
-
-
 =head2 _AddLink
 
 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
 
 =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.
+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;
 
 =cut
 
 sub _AddLink {
     my $self = shift;
-    my %args = ( Target => '',
-                 Base   => '',
-                 Type   => '',
-                 Silent => undef,
-                 @_ );
-
+    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;
 
     # Remote_link is the URI of the object that is not this ticket
     my $remote_link;
@@ -1420,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') );
     }
 
+    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
     # Check if the link already exists - we don't want duplicates
-    use RT::Link;
     my $old_link = RT::Link->new( $self->CurrentUser );
     $old_link->LoadByParams( Base   => $args{'Base'},
                              Type   => $args{'Type'},
     my $old_link = RT::Link->new( $self->CurrentUser );
     $old_link->LoadByParams( Base   => $args{'Base'},
                              Type   => $args{'Type'},
@@ -1431,52 +1505,96 @@ 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 $basetext = $self->FormatLink(Object => $link->BaseObj,
-                                    FallBack => $args{Base});
-    my $targettext = $self->FormatLink(Object => $link->TargetObj,
-                                      FallBack => $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 $typetext = $self->FormatType(Type => $args{Type});
-    my $TransString =
-      "$basetext $typetext $targettext.";
-    return ( $linkid, $TransString ) ;
-}
+    my $TransString = "$basetext $typetext $targettext.";
+
+    # 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;
+    }
+
+    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;
 
     my $direction;
     my $remote_link;
 
@@ -1486,45 +1604,93 @@ sub _DeleteLink {
     }
     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 {
         $RT::Logger->error("Base or Target must be specified");
         return ( 0, $self->loc('Either base or target must be specified') );
     }
 
     }
     else {
         $RT::Logger->error("Base or Target must be specified");
         return ( 0, $self->loc('Either base or target must be specified') );
     }
 
-    my $link = RT::Link->new( $self->CurrentUser );
-    $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
+    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. 
+    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'}
+    );
 
 
-    if ( $link->id ) {
-        my $basetext = $self->FormatLink(Object => $link->BaseObj,
+    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});
                                      FallBack => $args{Base});
-        my $targettext = $self->FormatLink(Object => $link->TargetObj,
+    my $targettext = $self->FormatLink(Object   => $link->TargetObj,
                                        FallBack => $args{Target});
                                        FallBack => $args{Target});
-        my $typetext = $self->FormatType(Type => $args{Type});
-        my $linkid = $link->id;
-        $link->Delete();
-        my $TransString = "$basetext no longer $typetext $targettext.";
-        return ( 1, $TransString);
+    my $typetext = $self->FormatType(Type => $args{Type});
+    my $TransString = "$basetext no longer $typetext $targettext.";
+
+    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");
-        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
 
 
 =head1 LockForUpdate
 
@@ -1591,20 +1757,20 @@ sub _NewTransaction {
     my $new_ref = $args{'NewReference'};
     my $ref_type = $args{'ReferenceType'};
     if ($old_ref or $new_ref) {
     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 = RT::Transaction->new( $self->CurrentUser );
     my ( $transaction, $msg ) = $trans->Create(
     }
 
     require RT::Transaction;
     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'},
         TimeTaken => $args{'TimeTaken'},
         Type      => $args{'Type'},
         Data      => $args{'Data'},
@@ -1629,10 +1795,10 @@ 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->Config->Get('UseTransactionBatch') and $transaction ) {
     }
     if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
-           push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
+            push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
     }
 
     RT->DatabaseHandle->Commit unless $in_txn;
     }
 
     RT->DatabaseHandle->Commit unless $in_txn;
@@ -1644,17 +1810,14 @@ sub _NewTransaction {
 
 =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,
@@ -1664,10 +1827,138 @@ sub Transactions {
         VALUE => ref($self),
     );
 
         VALUE => ref($self),
     );
 
-    return ($transactions);
+    return $transactions;
 }
 
 }
 
-#
+=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;
 
 sub CustomFields {
     my $self = shift;
@@ -1697,8 +1988,8 @@ sub CustomFieldLookupId {
     # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
     my $final = shift @classes;
     foreach my $class (reverse @classes) {
     # 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;
     }
 
     my $id = $object->$final;
     }
 
     my $id = $object->$final;
@@ -1796,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 );
@@ -1813,31 +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;
-            $old_content = undef if defined $old_content && !length $old_content;
-
-            my $is_the_same = 1;
-            if ( defined $args{'Value'} ) {
-                $is_the_same = 0 unless defined $old_content
-                    && $old_content eq $args{'Value'};
-            } else {
-                $is_the_same = 0 if defined $old_content;
-            }
-            if ( $is_the_same ) {
-                my $old_content = $old_value->LargeContent;
-                if ( defined $args{'LargeContent'} ) {
-                    $is_the_same = 0 unless defined $old_content
-                        && $old_content eq $args{'LargeContent'};
-                } else {
-                    $is_the_same = 0 if defined $old_content;
-                }
-            }
-
-            return $old_value->id if $is_the_same;
+        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'},
@@ -1904,6 +2178,11 @@ sub _AddCustomFieldValue {
 
     # 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 $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'},
         my ($new_value_id, $msg) = $cf->AddValueForObject(
             Object       => $self,
             Content      => $args{'Value'},
@@ -2101,12 +2380,359 @@ sub LoadCustomFieldByIdentifier {
 
 sub ACLEquivalenceObjects { } 
 
 
 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 { }
+
+=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->Config->Get('WebPath'). "/index.html?q=";
 }
 
 sub BasicColumns { }
 
 sub WikiBase {
     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;
+}
+
 RT::Base->_ImportOverlays();
 
 1;
 RT::Base->_ImportOverlays();
 
 1;