import rt 3.8.10
[freeside.git] / rt / lib / RT / Record.pm
index 57a5ea7..3c85753 100755 (executable)
@@ -1,38 +1,40 @@
-# {{{ BEGIN BPS TAGGED BLOCK
-# 
+# BEGIN BPS TAGGED BLOCK {{{
+#
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2011 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-# 
-# 
+# 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
@@ -41,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
+#
+# END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
   RT::Record - Base class for RT record objects
 =head1 DESCRIPTION
 
 
-=begin testing
-
-ok (require RT::Record);
-
-=end testing
 
 =head1 METHODS
 
 =cut
 
 package RT::Record;
-use RT::Date;
-use RT::User;
-use RT::Attributes;
-use RT::Base;
-use DBIx::SearchBuilder::Record::Cachable;
 
 use strict;
-use vars qw/@ISA $_TABLE_ATTR/;
+use warnings;
 
-@ISA = qw(RT::Base);
+use RT::Date;
+use RT::User;
+use RT::Attributes;
+use Encode qw();
 
-if ($RT::DontCacheSearchBuilderRecords ) {
-    push (@ISA, 'DBIx::SearchBuilder::Record');
-} else {
-    push (@ISA, 'DBIx::SearchBuilder::Record::Cachable');
+our $_TABLE_ATTR = { };
 
+use RT::Base;
+my $base = 'DBIx::SearchBuilder::Record::Cachable';
+if ( $RT::Config && $RT::Config->Get('DontCacheSearchBuilderRecords') ) {
+    $base = 'DBIx::SearchBuilder::Record';
 }
+eval "require $base" or die $@;
+our @ISA = 'RT::Base';
+push @ISA, $base;
 
 # {{{ sub _Init 
 
@@ -100,12 +100,43 @@ The primary keys for RT classes is 'id'
 
 =cut
 
-sub _PrimaryKeys {
+sub _PrimaryKeys { return ['id'] }
+
+# }}}
+
+=head2 Delete
+
+Delete this record object from the database.
+
+=cut
+
+sub Delete {
     my $self = shift;
-    return ( ['id'] );
+    my ($rv) = $self->SUPER::Delete;
+    if ($rv) {
+        return ($rv, $self->loc("Object deleted"));
+    } else {
+
+        return(0, $self->loc("Object could not be deleted"))
+    } 
 }
 
-# }}}
+=head2 ObjectTypeStr
+
+Returns a string which is this object's type.  The type is the class,
+without the "RT::" prefix.
+
+
+=cut
+
+sub ObjectTypeStr {
+    my $self = shift;
+    if (ref($self) =~ /^.*::(\w+)$/) {
+       return $self->loc($1);
+    } else {
+       return $self->loc(ref($self));
+    }
+}
 
 =head2 Attributes
 
@@ -145,7 +176,9 @@ sub AddAttribute {
                                       Description => $args{'Description'},
                                       Content     => $args{'Content'} );
 
-    $self->Attributes->RedoSearch;
+
+    # XXX TODO: Why won't RedoSearch work here?                                     
+    $self->Attributes->_DoSearch;
     
     return ($id, $msg);
 }
@@ -191,8 +224,12 @@ sub DeleteAttribute {
 
 =head2 FirstAttribute NAME
 
-Returns the value of the first attribute with the matching name
-for this object, or C<undef> if no such attributes exist.
+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.
 
 =cut
 
@@ -204,16 +241,13 @@ sub FirstAttribute {
 
 
 # {{{ sub _Handle 
-sub _Handle {
-    my $self = shift;
-    return ($RT::Handle);
-}
+sub _Handle { return $RT::Handle }
 
 # }}}
 
 # {{{ sub Create 
 
-=item  Create PARAMHASH
+=head2  Create PARAMHASH
 
 Takes a PARAMHASH of Column -> Value pairs.
 If any Column has a Validate$PARAMNAME subroutine defined and the 
@@ -280,8 +314,6 @@ sub Create {
    }
 
     if  (UNIVERSAL::isa('errno',$id)) {
-        exit(0);
-       warn "It's here!";
         return(undef);
     }
 
@@ -311,39 +343,29 @@ DB is case sensitive
 
 sub LoadByCols {
     my $self = shift;
-    my %hash = (@_);
 
     # We don't want to hang onto this
     delete $self->{'attributes'};
 
+    return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
+
     # 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);
-                ($key, $op, $val) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key});
-                $newhash{$key}->{operator} = $op;
-                $newhash{$key}->{value} = $val;
-            }
+    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);
+    return $self->SUPER::LoadByCols( %hash );
 }
 
 # }}}
@@ -437,6 +459,7 @@ sub LongSinceUpdateAsString {
 # }}} Datehandling
 
 # {{{ sub _Set 
+#
 sub _Set {
     my $self = shift;
 
@@ -454,12 +477,33 @@ sub _Set {
         $args{'Value'} = 0;
     }
 
-    $self->_SetLastUpdated();
-    my ( $val, $msg ) = $self->SUPER::_Set(
+    my $old_val = $self->__Value($args{'Field'});
+     $self->_SetLastUpdated();
+    my $ret = $self->SUPER::_Set(
         Field => $args{'Field'},
         Value => $args{'Value'},
         IsSQL => $args{'IsSQL'}
     );
+        my ($status, $msg) =  $ret->as_array();
+
+        # @values has two values, a status code and a message.
+
+    # $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]",
+            $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;     
+
 }
 
 # }}}
@@ -549,8 +593,22 @@ sub URI {
 }
 
 # }}}
 
+=head2 ValidateName NAME
+
+Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
+
+=cut
+
+sub ValidateName {
+    my $self = shift;
+    my $value = shift;
+    if ($value && $value=~ /^\d+$/) {
+        return(0);
+    } else  {
+         return (1);
+    }
+}
 
 
 
@@ -569,26 +627,21 @@ sub SQLType {
 
 }
 
-require Encode::compat if $] < 5.007001;
-require Encode;
-
-
-
-
 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 '');
-
-    return Encode::decode_utf8($value) || $value if $args{'decode_utf8'};
+    my $value = $self->SUPER::__Value( $field );
+    if( $args{'decode_utf8'} ) {
+        return Encode::decode_utf8( $value ) unless Encode::is_utf8( $value );
+    } else {
+        return Encode::encode_utf8( $value ) if Encode::is_utf8( $value );
+    }
     return $value;
 }
 
@@ -605,6 +658,7 @@ sub _CacheConfig {
 
 sub _BuildTableAttributes {
     my $self = shift;
+    my $class = ref($self) || $self;
 
     my $attributes;
     if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
@@ -616,37 +670,19 @@ 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};
-            }
+            $_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};
+                $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
             }
         }
     }
-
 }
 
 
@@ -659,7 +695,7 @@ DBIx::SearchBuilder::Record
 
 sub _ClassAccessible {
     my $self = shift;
-    return $_TABLE_ATTR->{ref($self)};
+    return $_TABLE_ATTR->{ref($self) || $self};
 }
 
 =head2 _Accessible COLUMN ATTRIBUTE
@@ -687,24 +723,24 @@ Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) bas
 sub _EncodeLOB {
         my $self = shift;
         my $Body = shift;
-        my $MIMEType = shift;
+        my $MIMEType = shift || '';
 
         my $ContentEncoding = 'none';
 
         #get the max attachment length from RT
-        my $MaxSize = $RT::MaxAttachmentSize;
+        my $MaxSize = RT->Config->Get('MaxAttachmentSize');
 
         #if the current attachment contains nulls and the
         #database doesn't support embedded nulls
 
-        if ( $RT::AlwaysUseBase64 or
+        if ( RT->Config->Get('AlwaysUseBase64') or
              ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
 
             # set a flag telling us to mimencode the attachment
             $ContentEncoding = 'base64';
 
             #cut the max attchment size by 25% (for mime-encoding overhead.
-            $RT::Logger->debug("Max size is $MaxSize\n");
+            $RT::Logger->debug("Max size is $MaxSize");
             $MaxSize = $MaxSize * 3 / 4;
         # Some databases (postgres) can't handle non-utf8 data
         } elsif (    !$RT::Handle->BinarySafeBLOBs
@@ -717,7 +753,7 @@ sub _EncodeLOB {
         if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
 
             # if we're supposed to truncate large attachments
-            if ($RT::TruncateLongAttachments) {
+            if (RT->Config->Get('TruncateLongAttachments')) {
 
                 # truncate the attachment to that length.
                 $Body = substr( $Body, 0, $MaxSize );
@@ -725,10 +761,12 @@ sub _EncodeLOB {
             }
 
             # elsif we're supposed to drop large attachments on the floor,
-            elsif ($RT::DropLongAttachments) {
+            elsif (RT->Config->Get('DropLongAttachments')) {
 
                 # 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" );
+                $RT::Logger->info( "$self: Dropped an attachment of size "
+                                   . length($Body));
+                $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
                 return ("none", "Large attachment dropped" );
             }
         }
@@ -750,8 +788,27 @@ sub _EncodeLOB {
 
 }
 
+sub _DecodeLOB {
+    my $self            = shift;
+    my $ContentType     = shift || '';
+    my $ContentEncoding = shift || 'none';
+    my $Content         = shift;
+
+    if ( $ContentEncoding eq 'base64' ) {
+        $Content = MIME::Base64::decode_base64($Content);
+    }
+    elsif ( $ContentEncoding eq 'quoted-printable' ) {
+        $Content = MIME::QuotedPrint::decode($Content);
+    }
+    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);
+    }
+        return ($Content);
+}
 
-# {{{ LINKDIRMAP
 # A helper table for links mapping to make it easier
 # to build and parse links between tickets
 
@@ -769,6 +826,21 @@ use vars '%LINKDIRMAP';
 
 );
 
+=head2 Update  ARGSHASH
+
+Updates fields on an object for you using the proper Set methods,
+skipping unchanged values.
+
+ ARGSRef => a hashref of attributes => value for the update
+ AttributesRef => an arrayref of keys in ARGSRef that should be updated
+ AttributePrefix => a prefix that should be added to the attributes in AttributesRef
+                    when looking up values in ARGSRef
+                    Bare attributes are tried before prefixed attributes
+
+Returns a list of localized results of the update
+
+=cut
+
 sub Update {
     my $self = shift;
 
@@ -793,8 +865,7 @@ sub Update {
             && defined(
                 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
             )
-          )
-        {
+          ) {
             $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
 
         }
@@ -811,21 +882,39 @@ 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 $@;
+            eval {
+                my $object = $attribute . "Obj";
+                my $name = $self->$object->Name;
+                next if $name eq $value || $name eq ($value || 0);
+            };
+            next if $value eq $self->$attribute();
+            next if ($value || 0) eq $self->$attribute();
         };
-        next if ( $value eq $self->$attribute() );
+
         my $method = "Set$attribute";
         my ( $code, $msg ) = $self->$method($value);
+        my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
 
-        my ($prefix) = ref($self) =~ /RT::(\w+)/;
-        push @results,
-          $self->loc( "$prefix [_1]", $self->id ) . ': '
-          . $self->loc($attribute) . ': '
-          . $self->CurrentUser->loc_fuzzy($msg);
+        # Default to $id, but use name if we can get it.
+        my $label = $self->id;
+        $label = $self->Name if (UNIVERSAL::can($self,'Name'));
+        # 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
@@ -838,6 +927,7 @@ sub Update {
                                    "Couldn't find row",                    # loc
                                    "Missing a primary key?: [_1]",         # loc
                                    "Found Object",                         # loc
+
 =cut
 
     }
@@ -845,7 +935,7 @@ sub Update {
     return @results;
 }
 
-# {{{ Routines dealing with Links between tickets
+# {{{ Routines dealing with Links
 
 # {{{ Link Collections
 
@@ -900,7 +990,7 @@ sub RefersTo {
 
 =head2 ReferredToBy
 
-  This returns an RT::Links object which shows all references for which this ticket is a target
+This returns an L<RT::Links> object which shows all references for which this ticket is a target
 
 =cut
 
@@ -930,46 +1020,10 @@ sub DependedOnBy {
 
 =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);
-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);
-ok($t2->Resolve);
-($rid, $rmsg)= $t1->Resolve();
-ok(!$rid, $rmsg);
-ok($t3->Resolve);
-($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
 
@@ -992,7 +1046,7 @@ sub HasUnresolvedDependencies {
     }
 
     if ($deps->Count > 0) {
-        return 1;
+        return $deps->Count;
     }
     else {
         return (undef);
@@ -1041,27 +1095,54 @@ 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,
         @_
     );
 
+    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};
+        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}{$link->BaseObj->Id} = $link->BaseObj;
-           $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
+           $args{_found}{$obj->Id} = $obj;
+           $obj->_AllLinkedTickets( %args, _top => 0 );
        }
-       elsif ($link->BaseObj->Type eq $args{Type}) {
-           $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
+       elsif ($obj->Type eq $args{Type}) {
+           $args{_found}{$obj->Id} = $obj;
        }
        else {
-           $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
+           $obj->_AllLinkedTickets( %args, _top => 0 );
        }
     }
 
@@ -1095,6 +1176,19 @@ sub DependsOn {
 
 # {{{ sub _Links 
 
+=head2 Links DIRECTION [TYPE]
+
+Return links (L<RT::Links>) to/from this object.
+
+DIRECTION is either 'Base' or 'Target'.
+
+TYPE is a type of links to return, it can be omitted to get
+links of any type.
+
+=cut
+
+*Links = \&_Links;
+
 sub _Links {
     my $self = shift;
 
@@ -1120,15 +1214,60 @@ sub _Links {
 
 # }}}
 
+# {{{ sub FormatType
+
+=head2 FormatType
+
+Takes a Type and returns a string that is more human readable.
+
+=cut
+
+sub FormatType{
+    my $self = shift;
+    my %args = ( Type => '',
+                @_
+              );
+    $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
+    $args{Type} =~ s/^\s+//;
+    return $args{Type};
+}
+
+
+# }}}
+
+# {{{ sub FormatLink
+
+=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;
+}
+
+# }}}
+
 # {{{ sub _AddLink
 
 =head2 _AddLink
 
-Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket.
+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.
 
-=cut
 
+=cut
 
 sub _AddLink {
     my $self = shift;
@@ -1144,19 +1283,16 @@ sub _AddLink {
     my $direction;
 
     if ( $args{'Base'} and $args{'Target'} ) {
-        $RT::Logger->debug(
-"$self tried to delete a link. both base and target were specified\n" );
+        $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
         return ( 0, $self->loc("Can't specifiy both base and target") );
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
-       my $class = ref($self);
         $remote_link    = $args{'Base'};
         $direction      = 'Target';
     }
     elsif ( $args{'Target'} ) {
         $args{'Base'} = $self->URI();
-       my $class = ref($self);
         $remote_link  = $args{'Target'};
         $direction    = 'Base';
     }
@@ -1172,7 +1308,7 @@ sub _AddLink {
                              Target => $args{'Target'} );
     if ( $old_link->Id ) {
         $RT::Logger->debug("$self Somebody tried to duplicate a link");
-        return ( $old_link->id, $self->loc("Link already exists"), 0 );
+        return ( $old_link->id, $self->loc("Link already exists"), 1 );
     }
 
     # }}}
@@ -1189,10 +1325,14 @@ sub _AddLink {
         return ( 0, $self->loc("Link could not be created") );
     }
 
+    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 =
-      "Record $args{'Base'} $args{Type} record $args{'Target'}.";
-
-    return ( 1, $self->loc( "Link created ([_1])", $TransString ) );
+      "$basetext $typetext $targettext.";
+    return ( $linkid, $TransString ) ;
 }
 
 # }}}
@@ -1223,7 +1363,7 @@ sub _DeleteLink {
     my $remote_link;
 
     if ( $args{'Base'} and $args{'Target'} ) {
-        $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n");
+        $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
         return ( 0, $self->loc("Can't specifiy both base and target") );
     }
     elsif ( $args{'Base'} ) {
@@ -1237,37 +1377,555 @@ sub _DeleteLink {
         $direction='Base';
     }
     else {
-        $RT::Logger->debug("$self: 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" );
+    $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
 
 
     $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=>  $args{'Target'} );
     #it's a real link. 
-    if ( $link->id ) {
 
+    if ( $link->id ) {
+        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 $linkid = $link->id;
         $link->Delete();
-
-        my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}.";
-        return ( 1, $self->loc("Link deleted ([_1])", $TransString));
+        my $TransString = "$basetext no longer $typetext $targettext.";
+        return ( 1, $TransString);
     }
 
     #if it's not a link we can find
     else {
-        $RT::Logger->debug("Couldn't find that link\n");
+        $RT::Logger->debug("Couldn't find that link");
         return ( 0, $self->loc("Link not found") );
     }
 }
 
 # }}}
 
-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});
+# }}}
+
+# {{{ Routines dealing with transactions
+
+# {{{ sub _NewTransaction
+
+=head2 _NewTransaction  PARAMHASH
+
+Private function to create a new RT::Transaction object for this ticket update
+
+=cut
+
+sub _NewTransaction {
+    my $self = shift;
+    my %args = (
+        TimeTaken => undef,
+        Type      => undef,
+        OldValue  => undef,
+        NewValue  => undef,
+        OldReference  => undef,
+        NewReference  => undef,
+        ReferenceType => undef,
+        Data      => undef,
+        Field     => undef,
+        MIMEObj   => undef,
+        ActivateScrips => 1,
+        CommitScrips => 1,
+        @_
+    );
+
+    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);
+    }
+
+    require RT::Transaction;
+    my $trans = new RT::Transaction( $self->CurrentUser );
+    my ( $transaction, $msg ) = $trans->Create(
+       ObjectId  => $self->Id,
+       ObjectType => ref($self),
+        TimeTaken => $args{'TimeTaken'},
+        Type      => $args{'Type'},
+        Data      => $args{'Data'},
+        Field     => $args{'Field'},
+        NewValue  => $args{'NewValue'},
+        OldValue  => $args{'OldValue'},
+        NewReference  => $new_ref,
+        OldReference  => $old_ref,
+        ReferenceType => $ref_type,
+        MIMEObj   => $args{'MIMEObj'},
+        ActivateScrips => $args{'ActivateScrips'},
+        CommitScrips => $args{'CommitScrips'},
+    );
+
+    # Rationalize the object since we may have done things to it during the caching.
+    $self->Load($self->Id);
+
+    $RT::Logger->warning($msg) unless $transaction;
+
+    $self->_SetLastUpdated;
+
+    if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
+        $self->_UpdateTimeTaken( $args{'TimeTaken'} );
+    }
+    if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
+           push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
+    }
+    return ( $transaction, $msg, $trans );
+}
+
+# }}}
+
+# {{{ sub Transactions 
+
+=head2 Transactions
+
+  Returns an 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,
+    );
+    $transactions->Limit(
+        FIELD => 'ObjectType',
+        VALUE => ref($self),
+    );
+
+    return ($transactions);
+}
+
+# }}}
+# }}}
+#
+# {{{ Routines dealing with custom fields
+
+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->ApplySortOrder;
+
+    return $cfs;
+}
+
+# TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
+
+sub _LookupId {
+    my $self = shift;
+    my $lookup = shift;
+    my @classes = ($lookup =~ /RT::(\w+)-/g);
+
+    my $object = $self;
+    foreach my $class (reverse @classes) {
+       my $method = "${class}Obj";
+       $object = $object->$method;
+    }
+
+    return $object->Id;
+}
+
+
+=head2 CustomFieldLookupType 
+
+Returns the path RT uses to figure out which custom fields apply to this object.
+
+=cut
+
+sub CustomFieldLookupType {
+    my $self = shift;
+    return ref($self);
+}
+
+# {{{ AddCustomFieldValue
+
+=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
+
+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.
+If VALUE is not a valid value for the custom field, returns 
+(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
+$id is ID of created L<ObjectCustomFieldValue> object.
+
+=cut
+
+sub AddCustomFieldValue {
+    my $self = shift;
+    $self->_AddCustomFieldValue(@_);
+}
+
+sub _AddCustomFieldValue {
+    my $self = shift;
+    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'} ) );
+    }
+
+    my $OCFs = $self->CustomFields;
+    $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
+    unless ( $OCFs->Count ) {
+        return (
+            0,
+            $self->loc(
+                "Custom field [_1] does not apply to this object",
+                $args{'Field'}
+            )
+        );
+    }
+
+    # 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") );
+    }
+
+    # 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 ) {
+
+        # Load up a ObjectCustomFieldValues object for this custom field and this ticket
+        my $values = $cf->ValuesForObject($self);
+
+        # We need to whack any old values here.  In most cases, the custom field should
+        # only have one value to delete.  In the pathalogical case, this custom field
+        # used to be a multiple and we have many values to whack....
+        my $cf_values = $values->Count;
+
+        if ( $cf_values > $cf->MaxValues ) {
+            my $i = 0;   #We want to delete all but the max we can currently have , so we can then
+                 # execute the same code to "change" the value from old to new
+            while ( my $value = $values->Next ) {
+                $i++;
+                if ( $i < $cf_values ) {
+                    my ( $val, $msg ) = $cf->DeleteValueForObject(
+                        Object  => $self,
+                        Content => $value->Content
+                    );
+                    unless ($val) {
+                        return ( 0, $msg );
+                    }
+                    my ( $TransactionId, $Msg, $TransactionObj ) =
+                      $self->_NewTransaction(
+                        Type         => 'CustomField',
+                        Field        => $cf->Id,
+                        OldReference => $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
+                    && lc $old_content eq lc $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;
+        }
+
+        my ( $new_value_id, $value_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 ) );
+        }
+
+        my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
+        $new_value->Load( $new_value_id );
+
+        # now that adding the new value was successful, delete the old one
+        if ( $old_value ) {
+            my ( $val, $msg ) = $old_value->Delete();
+            return ( 0, $msg ) unless $val;
+        }
+
+        if ( $args{'RecordTransaction'} ) {
+            my ( $TransactionId, $Msg, $TransactionObj ) =
+              $self->_NewTransaction(
+                Type         => 'CustomField',
+                Field        => $cf->Id,
+                OldReference => $old_value,
+                NewReference => $new_value,
+              );
+        }
+
+        my $new_content = $new_value->Content;
+        unless ( defined $old_content && length $old_content ) {
+            return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
+        }
+        elsif ( !defined $new_content || !length $new_content ) {
+            return ( $new_value_id,
+                $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
+        }
+        else {
+            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, $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]", $msg ) );
+        }
+        if ( $args{'RecordTransaction'} ) {
+            my ( $tid, $msg ) = $self->_NewTransaction(
+                Type          => 'CustomField',
+                Field         => $cf->Id,
+                NewReference  => $new_value_id,
+                ReferenceType => 'RT::ObjectCustomFieldValue',
+            );
+            unless ( $tid ) {
+                return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
+            }
+        }
+        return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
+    }
+}
+
+# }}}
+
+# {{{ DeleteCustomFieldValue
+
+=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
+
+Deletes VALUE as a value of CustomField FIELD. 
+
+VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
+
+If VALUE is not a valid value for the custom field, returns 
+(0, 'Error message' ) otherwise, returns (1, 'Success Message')
+
+=cut
+
+sub DeleteCustomFieldValue {
+    my $self = shift;
+    my %args = (
+        Field   => undef,
+        Value   => undef,
+        ValueId => undef,
+        @_
+    );
+
+    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'},
+        Content => $args{'Value'},
+    );
+    unless ($val) {
+        return ( 0, $msg );
+    }
+
+    my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
+        Type          => 'CustomField',
+        Field         => $cf->Id,
+        OldReference  => $val,
+        ReferenceType => 'RT::ObjectCustomFieldValue',
+    );
+    unless ($TransactionId) {
+        return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
+    }
+
+    return (
+        $TransactionId,
+        $self->loc(
+            "[_1] is no longer a value for custom field [_2]",
+            $TransactionObj->OldValue, $cf->Name
+        )
+    );
+}
+
+# }}}
+
+# {{{ FirstCustomFieldValue
+
+=head2 FirstCustomFieldValue FIELD
+
+Return the content of the first value of CustomField FIELD for this ticket
+Takes a field id or name
+
+=cut
+
+sub FirstCustomFieldValue {
+    my $self = shift;
+    my $field = shift;
+
+    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
+
+Return a ObjectCustomFieldValues object of all values of the CustomField whose 
+id or Name is FIELD for this record.
+
+Returns an RT::ObjectCustomFieldValues object
+
+=cut
+
+sub CustomFieldValues {
+    my $self  = shift;
+    my $field = shift;
+
+    if ( $field ) {
+        my $cf = $self->LoadCustomFieldByIdentifier( $field );
+
+        # 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) );
+    }
+
+    # we're not limiting to a specific custom field;
+    my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
+    $ocfs->LimitToObject( $self );
+    return $ocfs;
+}
+
+=head2 LoadCustomFieldByIdentifier IDENTIFER
+
+Find the custom field has id or name IDENTIFIER for this object.
+
+If no valid field is found, returns an empty RT::CustomField object.
+
+=cut
+
+sub LoadCustomFieldByIdentifier {
+    my $self = shift;
+    my $field = shift;
+    
+    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->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 { } 
+
+sub BasicColumns { }
+
+sub WikiBase {
+    return RT->Config->Get('WebPath'). "/index.html?q=";
+}
+
+RT::Base->_ImportOverlays();
 
 1;