#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
use strict;
use warnings;
+use RT;
+use base RT->Config->Get('RecordBaseClass');
+use base 'RT::Base';
-use RT::Date;
-use RT::User;
-use RT::Attributes;
+require RT::Date;
+require RT::User;
+require RT::Attributes;
+require RT::Transactions;
+require RT::Link;
use Encode qw();
our $_TABLE_ATTR = { };
-use base RT->Config->Get('RecordBaseClass');
-use base 'RT::Base';
sub _Init {
}
}
-=head2 ObjectTypeStr
+=head2 RecordType
+
+Returns a string which is this record's type. It's not localized and by
+default last part (everything after last ::) of class name is returned.
+
+=cut
+
+sub RecordType {
+ my $res = ref($_[0]) || $_[0];
+ $res =~ s/.*:://;
+ return $res;
+}
-Returns a string which is this object's type. The type is the class,
-without the "RT::" prefix.
+=head2 ObjectTypeStr
+DEPRECATED. Stays here for backwards. Returns localized L</RecordType>.
=cut
+# we deprecate because of:
+# * ObjectType is used in several classes with ObjectId to store
+# records of different types, for example transactions use those
+# and it's unclear what this method should return 'Transaction'
+# or type of referenced record
+# * returning localized thing is not good idea
+
sub ObjectTypeStr {
my $self = shift;
- if (ref($self) =~ /^.*::(\w+)$/) {
- return $self->loc($1);
- } else {
- return $self->loc(ref($self));
- }
+ RT->Deprecated(
+ Remove => "4.4",
+ Instead => "RecordType",
+ );
+ return $self->loc( $self->RecordType( @_ ) );
}
=head2 Attributes
# 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
$hash{$key}->{function} = $func;
}
}
- return $self->SUPER::LoadByCols( %hash );
+ my ( $ret, $msg ) = $self->SUPER::LoadByCols( %hash );
+ return wantarray ? ( $ret, $msg ) : $ret;
}
}
-#
-# TODO: This should be deprecated
-#
+# B<DEPRECATED> and will be removed in 4.4
sub AgeAsString {
my $self = shift;
+ RT->Deprecated(
+ Remove => "4.4",
+ Instead => "->CreatedObj->AgeAsString",
+ );
return ( $self->CreatedObj->AgeAsString() );
}
-
-
-# TODO this should be deprecated
+# B<DEPRECATED> and will be removed in 4.4
+sub LongSinceUpdateAsString {
+ my $self = shift;
+ RT->Deprecated(
+ Remove => "4.4",
+ Instead => "->LastUpdatedObj->AgeAsString",
+ );
+ if ( $self->LastUpdated ) {
+ return ( $self->LastUpdatedObj->AgeAsString() );
+ } else {
+ return "never";
+ }
+}
sub LastUpdatedAsString {
my $self = shift;
if ( $self->LastUpdated ) {
return ( $self->LastUpdatedObj->AsString() );
-
- }
- else {
+ } else {
return "never";
}
}
-
-#
-# 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;
# $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;
}
sub _SetLastUpdated {
my $self = shift;
- use RT::Date;
my $now = RT::Date->new( $self->CurrentUser );
$now->SetToNow();
}
my $value = $self->SUPER::__Value($field);
+ return $value if ref $value;
+
+ return undef if (!defined $value);
if ( $args{'decode_utf8'} ) {
if ( !utf8::is_utf8($value) ) {
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;
}
. length($Body));
$RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
$Filename .= ".txt" if $Filename;
- return ("none", "Large attachment dropped", "plain/text", $Filename );
+ return ("none", "Large attachment dropped", "text/plain", $Filename );
}
}
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,
$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.
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;
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) {
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);
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;
}
}
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 {
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<link id>, C<message> and C<exist> flag.
+If Silent is true then no transactions will be recorded. You can individually
+control transactions on both base and target and with SilentBase and
+SilentTarget respectively. By default both transactions are created.
+
+If the link destination is a local object and does the
+L<RT::Record::Role::Status> role, this method ensures object Status is not
+"deleted". Linking to deleted objects is forbidden.
+If the link destination (i.e. not C<$self>) is a local object and the
+C<$StrictLinkACL> option is enabled, this method checks the appropriate right
+on the destination object (if any, as returned by the L</ModifyLinkRight>
+method). B<< The subclass is expected to check the appropriate right on the
+source object (i.e. C<$self>) before calling this method. >> This allows a
+different right to be used on the source object during creation, for example.
+
+Returns a tuple of (link ID, message, flag if link already existed).
=cut
sub _AddLink {
my $self = shift;
- 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;
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();
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'},
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</ModifyLinkRight>
+method). B<< The subclass is expected to check the appropriate right on the
+source object (i.e. C<$self>) before calling this method. >>
+
+Returns a tuple of (status flag, message).
=cut
sub _DeleteLink {
my $self = shift;
my %args = (
- Base => undef,
- Target => undef,
- Type => undef,
+ Base => undef,
+ Target => undef,
+ Type => undef,
+ Silent => undef,
+ SilentBase => undef,
+ SilentTarget => undef,
@_
);
- #we want one of base and target. we don't care which
- #but we only want _one_
-
+ # We want one of base and target. We don't care which but we only want _one_.
my $direction;
my $remote_link;
if ( $args{'Base'} and $args{'Target'} ) {
$RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
- 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'}
+ );
+
+ unless ($link->id) {
+ $RT::Logger->debug("Couldn't find that link");
+ return ( 0, $self->loc("Link not found") );
+ }
- if ( $link->id ) {
- my $basetext = $self->FormatLink(Object => $link->BaseObj,
+ 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
+In a database transaction, gains an exclusive lock on the row, to
+prevent race conditions. On SQLite, this is a "RESERVED" lock on the
+entire database.
+=cut
+sub LockForUpdate {
+ my $self = shift;
+
+ my $pk = $self->_PrimaryKey;
+ my $id = @_ ? $_[0] : $self->$pk;
+ $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
+ if (RT->Config->Get('DatabaseType') eq "SQLite") {
+ # SQLite does DB-level locking, upgrading the transaction to
+ # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
+ # UPDATE to force the upgade.
+ return RT->DatabaseHandle->dbh->do(
+ "UPDATE " .$self->Table.
+ " SET $pk = $pk WHERE 1 = 0");
+ } else {
+ return $self->_LoadFromSQL(
+ "SELECT * FROM ".$self->Table
+ ." WHERE $pk = ? FOR UPDATE",
+ $id,
+ );
+ }
+}
=head2 _NewTransaction PARAMHASH
@_
);
+ my $in_txn = RT->DatabaseHandle->TransactionDepth;
+ RT->DatabaseHandle->BeginTransaction unless $in_txn;
+
+ $self->LockForUpdate;
+
my $old_ref = $args{'OldReference'};
my $new_ref = $args{'NewReference'};
my $ref_type = $args{'ReferenceType'};
if ($old_ref or $new_ref) {
- $ref_type ||= ref($old_ref) || ref($new_ref);
- if (!$ref_type) {
- $RT::Logger->error("Reference type not specified for transaction");
- return;
- }
- $old_ref = $old_ref->Id if ref($old_ref);
- $new_ref = $new_ref->Id if ref($new_ref);
+ $ref_type ||= ref($old_ref) || ref($new_ref);
+ if (!$ref_type) {
+ $RT::Logger->error("Reference type not specified for transaction");
+ return;
+ }
+ $old_ref = $old_ref->Id if ref($old_ref);
+ $new_ref = $new_ref->Id if ref($new_ref);
}
require RT::Transaction;
my $trans = 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'},
$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;
+
return ( $transaction, $msg, $trans );
}
=head2 Transactions
- Returns an RT::Transactions object of all transactions on this record object
+Returns an L<RT::Transactions> object of all transactions on this record object
=cut
sub Transactions {
my $self = shift;
- use RT::Transactions;
my $transactions = RT::Transactions->new( $self->CurrentUser );
-
- #If the user has no rights, return an empty object
$transactions->Limit(
FIELD => 'ObjectId',
VALUE => $self->id,
VALUE => ref($self),
);
- return ($transactions);
+ return $transactions;
}
-#
+=head2 SortedTransactions
+
+Returns the result of L</Transactions> ordered per the
+I<OldestTransactionsFirst> preference/option.
+
+=cut
+
+sub SortedTransactions {
+ my $self = shift;
+ my $txns = $self->Transactions;
+ my $order = RT->Config->Get("OldestTransactionsFirst", $self->CurrentUser)
+ ? 'ASC' : 'DESC';
+ $txns->OrderByCols(
+ { FIELD => 'Created', ORDER => $order },
+ { FIELD => 'id', ORDER => $order },
+ );
+ return $txns;
+}
+
+our %TRANSACTION_CLASSIFICATION = (
+ Create => 'message',
+ Correspond => 'message',
+ Comment => 'message',
+
+ AddWatcher => 'people',
+ DelWatcher => 'people',
+
+ Take => 'people',
+ Untake => 'people',
+ Force => 'people',
+ Steal => 'people',
+ Give => 'people',
+
+ AddLink => 'links',
+ DeleteLink => 'links',
+
+ Status => 'basics',
+ Set => {
+ __default => 'basics',
+ map( { $_ => 'dates' } qw(
+ Told Starts Started Due LastUpdated Created LastUpdated
+ ) ),
+ map( { $_ => 'people' } qw(
+ Owner Creator LastUpdatedBy
+ ) ),
+ },
+ __default => 'other',
+);
+
+sub ClassifyTransaction {
+ my $self = shift;
+ my $txn = shift;
+
+ my $type = $txn->Type;
+
+ my $res = $TRANSACTION_CLASSIFICATION{ $type };
+ return $res || $TRANSACTION_CLASSIFICATION{ '__default' }
+ unless ref $res;
+
+ return $res->{ $txn->Field } || $res->{'__default'}
+ || $TRANSACTION_CLASSIFICATION{ '__default' };
+}
+
+=head2 Attachments
+
+Returns an L<RT::Attachments> object of all attachments on this record object
+(for all its L</Transactions>).
+
+By default Content and Headers of attachments are not fetched right away from
+database. Use C<WithContent> and C<WithHeaders> options to override this.
+
+=cut
+
+sub Attachments {
+ my $self = shift;
+ my %args = (
+ WithHeaders => 0,
+ WithContent => 0,
+ @_
+ );
+ my @columns = grep { not /^(Headers|Content)$/ }
+ RT::Attachment->ReadableAttributes;
+ push @columns, 'Headers' if $args{'WithHeaders'};
+ push @columns, 'Content' if $args{'WithContent'};
+
+ my $res = RT::Attachments->new( $self->CurrentUser );
+ $res->Columns( @columns );
+ my $txn_alias = $res->TransactionAlias;
+ $res->Limit(
+ ALIAS => $txn_alias,
+ FIELD => 'ObjectType',
+ VALUE => ref($self),
+ );
+ $res->Limit(
+ ALIAS => $txn_alias,
+ FIELD => 'ObjectId',
+ VALUE => $self->id,
+ );
+ return $res;
+}
+
+=head2 TextAttachments
+
+Returns an L<RT::Attachments> object of all attachments, like L<Attachments>,
+but only those that are text.
+
+By default Content and Headers are fetched. Use C<WithContent> and
+C<WithHeaders> options to override this.
+
+=cut
+
+sub TextAttachments {
+ my $self = shift;
+ my $res = $self->Attachments(
+ WithHeaders => 1,
+ WithContent => 1,
+ @_
+ );
+ $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text/plain');
+ $res->Limit( FIELD => 'ContentType', OPERATOR => 'STARTSWITH', VALUE => 'message/');
+ $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text');
+ $res->Limit( FIELD => 'Filename', OPERATOR => 'IS', VALUE => 'NULL')
+ if RT->Config->Get( 'SuppressInlineTextFiles', $self->CurrentUser );
+ return $res;
+}
sub CustomFields {
my $self = shift;
$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;
}
sub CustomFieldLookupType {
my $self = shift;
- return ref($self);
+ return ref($self) || $self;
}
0,
$self->loc(
"Custom field [_1] does not apply to this object",
- $args{'Field'}
+ ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
)
);
}
my $is_the_same = 1;
if ( defined $args{'Value'} ) {
$is_the_same = 0 unless defined $old_content
- && lc $old_content eq lc $args{'Value'};
+ && $old_content eq $args{'Value'};
} else {
$is_the_same = 0 if defined $old_content;
}
sub ACLEquivalenceObjects { }
+=head2 HasRight
+
+ Takes a paramhash with the attributes 'Right' and 'Principal'
+ 'Right' is a ticket-scoped textual right from RT::ACE
+ 'Principal' is an RT::User object
+
+ Returns 1 if the principal has the right. Returns undef if not.
+
+=cut
+
+sub HasRight {
+ my $self = shift;
+ my %args = (
+ Right => undef,
+ Principal => undef,
+ @_
+ );
+
+ $args{Principal} ||= $self->CurrentUser->PrincipalObj;
+
+ return $args{'Principal'}->HasRight(
+ Object => $self->Id ? $self : $RT::System,
+ Right => $args{'Right'}
+ );
+}
+
+sub CurrentUserHasRight {
+ my $self = shift;
+ return $self->HasRight( Right => @_ );
+}
+
+sub ModifyLinkRight { }
+
+=head2 ColumnMapClassName
+
+ColumnMap needs a massaged collection class name to load the correct list
+display. Equivalent to L<RT::SearchBuilder/ColumnMapClassName>, but provided
+for a record instead of a collection.
+
+Returns a string. May be called as a package method.
+
+=cut
+
+sub ColumnMapClassName {
+ my $self = shift;
+ my $Class = ref($self) || $self;
+ $Class =~ s/:/_/g;
+ return $Class;
+}
+
sub BasicColumns { }
sub WikiBase {
return RT->Config->Get('WebPath'). "/index.html?q=";
}
+sub 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-encode things with a ContentEncoding for transfer
+ if ($ca{ContentEncoding} and $ca{ContentType}) {
+ my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/;
+ $store{$content_col} = $self->$content_col;
+ 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 {
+}
+
RT::Base->_ImportOverlays();
1;
git://git.uio.no / usit-rt.git / blobdiff