+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;
+}
+