X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FRecord.pm;h=8f1b5be5ed1ad29d39481859303d856ffdc98731;hp=313888cbc4a164351af193d6dc1fd5cd5c601408;hb=07bf36bccc4979b12db49b0f71524de4296f3717;hpb=06fb1346ff8076a84f743fa07de31852942e144f diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index 313888cbc..8f1b5be5e 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -66,12 +66,18 @@ package RT::Record; 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'); @@ -128,21 +134,39 @@ sub Delete { } } -=head2 ObjectTypeStr +=head2 RecordType -Returns a string which is this object's type. The type is the class, -without the "RT::" prefix. +Returns a string which is this record's type. It's not localized and by +default last part (everything after last ::) of class name is returned. +=cut + +sub RecordType { + my $res = ref($_[0]) || $_[0]; + $res =~ s/.*:://; + return $res; +} + +=head2 ObjectTypeStr + +DEPRECATED. Stays here for backwards. Returns localized L. =cut +# we deprecate because of: +# * ObjectType is used in several classes with ObjectId to store +# records of different types, for example transactions use those +# and it's unclear what this method should return 'Transaction' +# or type of referenced record +# * returning localized thing is not good idea + sub ObjectTypeStr { my $self = shift; - if (ref($self) =~ /^.*::(\w+)$/) { - return $self->loc($1); - } else { - return $self->loc(ref($self)); - } + RT->Deprecated( + Remove => "4.4", + Instead => "RecordType", + ); + return $self->loc( $self->RecordType( @_ ) ); } =head2 Attributes @@ -373,7 +397,10 @@ sub LoadByCols { # 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 @@ -391,7 +418,8 @@ sub LoadByCols { $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 and will be removed in 4.4 sub AgeAsString { my $self = shift; + RT->Deprecated( + Remove => "4.4", + Instead => "->CreatedObj->AgeAsString", + ); return ( $self->CreatedObj->AgeAsString() ); } - - -# TODO this should be deprecated +# B and will be removed in 4.4 +sub LongSinceUpdateAsString { + my $self = shift; + RT->Deprecated( + Remove => "4.4", + Instead => "->LastUpdatedObj->AgeAsString", + ); + if ( $self->LastUpdated ) { + return ( $self->LastUpdatedObj->AgeAsString() ); + } else { + return "never"; + } +} sub LastUpdatedAsString { my $self = shift; if ( $self->LastUpdated ) { return ( $self->LastUpdatedObj->AsString() ); - - } - else { + } else { return "never"; } } - -# -# TODO This should be deprecated -# 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; @@ -501,19 +516,24 @@ sub _Set { # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool # we want to change the standard "success" message if ($status) { - $msg = - $self->loc( - "[_1] changed from [_2] to [_3]", - $self->loc( $args{'Field'} ), - ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ), - '"' . $self->__Value( $args{'Field'}) . '"' - ); - } else { - - $msg = $self->CurrentUser->loc_fuzzy($msg); + if ($self->SQLType( $args{'Field'}) =~ /text/) { + $msg = $self->loc( + "[_1] updated", + $self->loc( $args{'Field'} ), + ); + } else { + $msg = $self->loc( + "[_1] changed from [_2] to [_3]", + $self->loc( $args{'Field'} ), + ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ), + '"' . $self->__Value( $args{'Field'}) . '"', + ); + } + } else { + $msg = $self->CurrentUser->loc_fuzzy($msg); } - return wantarray ? ($status, $msg) : $ret; + return wantarray ? ($status, $msg) : $ret; } @@ -527,7 +547,6 @@ It takes no options. Arguably, this is a bug sub _SetLastUpdated { my $self = shift; - use RT::Date; my $now = RT::Date->new( $self->CurrentUser ); $now->SetToNow(); @@ -638,15 +657,20 @@ sub __Value { } my $value = $self->SUPER::__Value($field); + return $value if ref $value; return undef if (!defined $value); + # Pg returns character columns as character strings; mysql and + # sqlite return them as bytes. While mysql can be made to return + # characters, using the mysql_enable_utf8 flag, the "Content" column + # is bytes on mysql and characters on Postgres, making true + # consistency impossible. if ( $args{'decode_utf8'} ) { - if ( !utf8::is_utf8($value) ) { + if ( !utf8::is_utf8($value) ) { # mysql/sqlite utf8::decode($value); } - } - else { + } else { if ( utf8::is_utf8($value) ) { utf8::encode($value); } @@ -660,7 +684,6 @@ sub __Value { sub _CacheConfig { { - 'cache_p' => 1, 'cache_for_sec' => 30, } } @@ -720,92 +743,155 @@ sub _Accessible { my $self = shift; my $column = shift; my $attribute = lc(shift); - return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column}); - return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0; + + my $class = ref($self) || $self; + $class->_BuildTableAttributes unless ($_TABLE_ATTR->{$class}); + + return 0 unless defined ($_TABLE_ATTR->{$class}->{$column}); + return $_TABLE_ATTR->{$class}->{$column}->{$attribute} || 0; } -=head2 _EncodeLOB BODY MIME_TYPE +=head2 _EncodeLOB BODY MIME_TYPE FILENAME -Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database +Takes a potentially large attachment. Returns (ContentEncoding, +EncodedBody, MimeType, Filename, NoteArgs) based on system configuration and +selected database. Returns a custom (short) text/plain message if +DropLongAttachments causes an attachment to not be stored. + +Encodes your data as base64 or Quoted-Printable as needed based on your +Databases's restrictions and the UTF-8ness of the data being passed in. Since +we are storing in columns marked UTF8, we must ensure that binary data is +encoded on databases which are strict. + +This function expects to receive an octet string in order to properly +evaluate and encode it. It will return an octet string. + +NoteArgs is currently used to indicate caller that the message is too long and +is truncated or dropped. It's a hashref which is expected to be passed to +L. =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 - && $MIMEType !~ /text\/plain/gi - && !Encode::is_utf8( $Body, 1 ) ) { - $ContentEncoding = 'quoted-printable'; - } + # set a flag telling us to mimencode the attachment + $ContentEncoding = 'base64'; - #if the attachment is larger than the maximum size - if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { + #cut the max attchment size by 25% (for mime-encoding overhead. + $RT::Logger->debug("Max size is $MaxSize"); + $MaxSize = $MaxSize * 3 / 4; + # Some databases (postgres) can't handle non-utf8 data + } elsif ( !$RT::Handle->BinarySafeBLOBs + && $Body =~ /\P{ASCII}/ + && !Encode::is_utf8( $Body, 1 ) ) { + $ContentEncoding = 'quoted-printable'; + } - # if we're supposed to truncate large attachments - if (RT->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", "plain/text", $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 C, C, C + +Unpacks data stored in the database, which may be base64 or QP encoded +because of our need to store binary and badly encoded data in columns +marked as UTF-8. Databases such as PostgreSQL and Oracle care that you +are feeding them invalid UTF-8 and will refuse the content. This +function handles unpacking the encoded data. + +It returns textual data as a UTF-8 string which has been processed by Encode's +PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see +the invalid byte but won't run into problems treating the data as UTF-8 later. + +This is similar to how we filter all data coming in via the web UI in +RT::Interface::Web::DecodeARGS. This filter should only end up being +applied to old data from less UTF-8-safe versions of RT. + +If the passed C includes a character set, that will be used +to decode textual data; the default character set is UTF-8. This is +necessary because while we attempt to store textual data as UTF-8, the +definition of "textual" has migrated over time, and thus we may now need +to attempt to decode data that was previously not trancoded on insertion. + +Important Note - This function expects an octet string and returns a +character string for non-binary data. + +=cut + sub _DecodeLOB { my $self = shift; my $ContentType = shift || ''; my $ContentEncoding = shift || 'none'; my $Content = shift; + RT::Util::assert_bytes( $Content ); + if ( $ContentEncoding eq 'base64' ) { $Content = MIME::Base64::decode_base64($Content); } @@ -816,28 +902,17 @@ sub _DecodeLOB { return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) ); } if ( RT::I18N::IsTextualContentType($ContentType) ) { - $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content); + my $entity = MIME::Entity->new(); + $entity->head->add("Content-Type", $ContentType); + $entity->bodyhandle( MIME::Body::Scalar->new( $Content ) ); + my $charset = RT::I18N::_FindOrGuessCharset($entity); + $charset = 'utf-8' if not $charset or not Encode::find_encoding($charset); + + $Content = Encode::decode($charset,$Content,Encode::FB_PERLQQ); } - return ($Content); + return ($Content); } -# 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, @@ -888,6 +963,8 @@ sub Update { $value =~ s/\r\n/\n/gs; + my $truncated_value = $self->TruncateValue($attribute, $value); + # If Queue is 'General', we want to resolve the queue name for # the object. @@ -897,13 +974,16 @@ sub Update { do { no warnings "uninitialized"; local $@; - eval { + my $name = eval { my $object = $attribute . "Obj"; - my $name = $self->$object->Name; - next if $name eq $value || $name eq ($value || 0); + $self->$object->Name; }; - next if $value eq $self->$attribute(); - next if ($value || 0) eq $self->$attribute(); + unless ($@) { + next if $name eq $value || $name eq ($value || 0); + } + + next if $truncated_value eq $self->$attribute(); + next if ( $truncated_value || 0 ) eq $self->$attribute(); }; $new_values{$attribute} = $value; @@ -1061,12 +1141,9 @@ sub HasUnresolvedDependencies { my $deps = $self->UnresolvedDependencies; if ($args{Type}) { - $deps->Limit( FIELD => 'Type', - OPERATOR => '=', - VALUE => $args{Type}); - } - else { - $deps->IgnoreType; + $deps->LimitType( VALUE => $args{Type} ); + } else { + $deps->IgnoreType; } if ($deps->Count > 0) { @@ -1092,10 +1169,7 @@ sub UnresolvedDependencies { my $self = shift; my $deps = RT::Tickets->new($self->CurrentUser); - my @live_statuses = RT::Queue->ActiveStatusArray(); - foreach my $status (@live_statuses) { - $deps->LimitStatus(VALUE => $status); - } + $deps->LimitToActiveStatus; $deps->LimitDependedOnBy($self->Id); return($deps); @@ -1143,35 +1217,35 @@ sub _AllLinkedTickets { 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; - next unless ($uri->IsLocal()); + next unless ($uri->IsLocal()); 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}) { - return map { $args{_found}{$_} } sort keys %{$args{_found}}; + return map { $args{_found}{$_} } sort keys %{$args{_found}}; } else { - return 1; + return 1; } } @@ -1208,6 +1282,11 @@ sub Customers { $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( @@ -1306,8 +1385,8 @@ Takes a Type and returns a string that is more human readable. sub FormatType{ my $self = shift; my %args = ( Type => '', - @_ - ); + @_ + ); $args{Type} =~ s/([A-Z])/" " . lc $1/ge; $args{Type} =~ s/^\s+//; return $args{Type}; @@ -1325,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, - FallBack => '', - @_ - ); + FallBack => '', + @_ + ); 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; } - - =head2 _AddLink Takes a paramhash of Type and one of Base or Target. Adds that link to this object. -Returns C, C and C 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 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 +method). B<< The subclass is expected to check the appropriate right on the +source object (i.e. C<$self>) before calling this method. >> This allows a +different right to be used on the source object during creation, for example. +Returns a tuple of (link ID, message, flag if link already existed). =cut sub _AddLink { my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - @_ ); - + 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; @@ -1361,7 +1456,7 @@ sub _AddLink { if ( $args{'Base'} and $args{'Target'} ) { $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") ); + return ( 0, $self->loc("Can't specify both base and target") ); } elsif ( $args{'Base'} ) { $args{'Target'} = $self->URI(); @@ -1377,8 +1472,30 @@ sub _AddLink { 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 - use RT::Link; my $old_link = RT::Link->new( $self->CurrentUser ); $old_link->LoadByParams( Base => $args{'Base'}, Type => $args{'Type'}, @@ -1388,100 +1505,192 @@ sub _AddLink { return ( $old_link->id, $self->loc("Link already exists"), 1 ); } - # }}} + if ( $args{'Type'} =~ /^(?:DependsOn|MemberOf)$/ ) { + my @tickets = $self->_AllLinkedTickets( + LinkType => $args{'Type'}, + Direction => $direction eq 'Target' ? 'Base' : 'Target', + ); + if ( grep { $_->id == ( $direction eq 'Target' ? $args{'Base'} : $args{'Target'} ) } @tickets ) { + return ( 0, $self->loc("Refused to add link which would create a circular relationship") ); + } + } # Storing the link in the DB. my $link = RT::Link->new( $self->CurrentUser ); my ($linkid, $linkmsg) = $link->Create( Target => $args{Target}, - Base => $args{Base}, - Type => $args{Type} ); + Base => $args{Base}, + Type => $args{Type} ); unless ($linkid) { $RT::Logger->error("Link could not be created: ".$linkmsg); - return ( 0, $self->loc("Link could not be created") ); + return ( 0, $self->loc("Link could not be created: [_1]", $linkmsg) ); } - my $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 $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 -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 +method). B<< The subclass is expected to check the appropriate right on the +source object (i.e. C<$self>) before calling this method. >> + +Returns a tuple of (status flag, message). =cut sub _DeleteLink { my $self = shift; my %args = ( - Base => undef, - Target => undef, - Type => undef, + Base => undef, + Target => undef, + Type => undef, + Silent => undef, + SilentBase => undef, + SilentTarget => undef, @_ ); - #we want one of base and target. we don't care which - #but we only want _one_ - + # We want one of base and target. We don't care which but we only want _one_. my $direction; my $remote_link; if ( $args{'Base'} and $args{'Target'} ) { $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target"); - return ( 0, $self->loc("Can't specifiy both base and target") ); + return ( 0, $self->loc("Can't specify both base and target") ); } elsif ( $args{'Base'} ) { $args{'Target'} = $self->URI(); - $remote_link = $args{'Base'}; - $direction = 'Target'; + $remote_link = $args{'Base'}; + $direction = 'Target'; } elsif ( $args{'Target'} ) { $args{'Base'} = $self->URI(); - $remote_link = $args{'Target'}; - $direction='Base'; + $remote_link = $args{'Target'}; + $direction = 'Base'; } else { $RT::Logger->error("Base or Target must be specified"); 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}); - my $targettext = $self->FormatLink(Object => $link->TargetObj, + 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 = "$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 @@ -1548,20 +1757,20 @@ sub _NewTransaction { 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( - ObjectId => $self->Id, - ObjectType => ref($self), + ObjectId => $self->Id, + ObjectType => ref($self), TimeTaken => $args{'TimeTaken'}, Type => $args{'Type'}, Data => $args{'Data'}, @@ -1586,10 +1795,10 @@ sub _NewTransaction { $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 ) { - push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; + push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; } RT->DatabaseHandle->Commit unless $in_txn; @@ -1601,17 +1810,14 @@ sub _NewTransaction { =head2 Transactions - Returns an RT::Transactions object of all transactions on this record object +Returns an L 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, @@ -1621,10 +1827,138 @@ sub Transactions { VALUE => ref($self), ); - return ($transactions); + return $transactions; } -# +=head2 SortedTransactions + +Returns the result of L ordered per the +I 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 object of all attachments on this record object +(for all its L). + +By default Content and Headers of attachments are not fetched right away from +database. Use C and C 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 object of all attachments, like L, +but only those that are text. + +By default Content and Headers are fetched. Use C and +C 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; @@ -1633,29 +1967,37 @@ sub CustomFields { $cfs->SetContextObject( $self ); # XXX handle multiple types properly $cfs->LimitToLookupType( $self->CustomFieldLookupType ); - $cfs->LimitToGlobalOrObjectId( - $self->_LookupId( $self->CustomFieldLookupType ) - ); + $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId ); $cfs->ApplySortOrder; return $cfs; } -# TODO: This _only_ works for RT::Class classes. it doesn't work, for example, -# for RT::IR classes. +# TODO: This _only_ works for RT::Foo classes. it doesn't work, for +# example, for RT::IR::Foo classes. -sub _LookupId { +sub CustomFieldLookupId { my $self = shift; - my $lookup = shift; + my $lookup = shift || $self->CustomFieldLookupType; my @classes = ($lookup =~ /RT::(\w+)-/g); + # Work on "RT::Queue", for instance + return $self->Id unless @classes; + my $object = $self; + # Save a ->Load call by not calling ->FooObj->Id, just ->Foo + my $final = shift @classes; foreach my $class (reverse @classes) { - my $method = "${class}Obj"; - $object = $object->$method; + my $method = "${class}Obj"; + $object = $object->$method; } - return $object->Id; + my $id = $object->$final; + unless (defined $id) { + my $method = "${final}Obj"; + $id = $object->$method->Id; + } + return $id; } @@ -1667,7 +2009,7 @@ Returns the path RT uses to figure out which custom fields apply to this object. sub CustomFieldLookupType { my $self = shift; - return ref($self); + return ref($self) || $self; } @@ -1745,8 +2087,8 @@ sub _AddCustomFieldValue { $i++; if ( $i < $cf_values ) { my ( $val, $msg ) = $cf->DeleteValueForObject( - Object => $self, - Content => $value->Content + Object => $self, + Id => $value->id, ); unless ($val) { return ( 0, $msg ); @@ -1762,31 +2104,14 @@ sub _AddCustomFieldValue { $values->RedoSearch if $i; # redo search if have deleted at least one value } - my ( $old_value, $old_content ); - if ( $old_value = $values->First ) { - $old_content = $old_value->Content; - $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; + 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'}, @@ -1853,6 +2178,11 @@ sub _AddCustomFieldValue { # 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'}, @@ -2050,12 +2380,359 @@ sub LoadCustomFieldByIdentifier { 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, 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 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 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;