# BEGIN BPS TAGGED BLOCK {{{
-#
+#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-# <jesse@bestpractical.com>
-#
+#
+# This software is Copyright (c) 1996-2014 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., 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
# 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 }}}
=head1 NAME
use strict;
use warnings;
+
use RT::Date;
use RT::I18N;
use RT::User;
use Encode qw();
our $_TABLE_ATTR = { };
+use base RT->Config->Get('RecordBaseClass');
+use base 'RT::Base';
-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
sub _Init {
my $self = shift;
$self->CurrentUser(@_);
}
-# }}}
-# {{{ _PrimaryKeys
=head2 _PrimaryKeys
=cut
sub _PrimaryKeys { return ['id'] }
+# short circuit many, many thousands of calls from searchbuilder
+sub _PrimaryKey { 'id' }
-# }}}
+=head2 Id
+
+Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
+on a very common codepath
+
+C<id> is an alias to C<Id> and is the preferred way to call this method.
+
+=cut
+
+sub Id {
+ return shift->{'values'}->{id};
+}
+
+*id = \&Id;
=head2 Delete
sub Attributes {
my $self = shift;
-
unless ($self->{'attributes'}) {
- $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
- $self->{'attributes'}->LimitToObject($self);
+ $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
+ $self->{'attributes'}->LimitToObject($self);
+ $self->{'attributes'}->OrderByCols({FIELD => 'id'});
}
- return ($self->{'attributes'});
-
+ return ($self->{'attributes'});
}
sub DeleteAttribute {
my $self = shift;
my $name = shift;
- return $self->Attributes->DeleteEntry( Name => $name );
+ my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name );
+ $self->ClearAttributes;
+ return ($val,$msg);
}
=head2 FirstAttribute NAME
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.
+If there is more than one attribute with the matching name on the
+object, the first value that was set is returned.
=cut
}
-# {{{ sub _Handle
+sub ClearAttributes {
+ my $self = shift;
+ delete $self->{'attributes'};
+
+}
+
sub _Handle { return $RT::Handle }
-# }}}
-# {{{ sub Create
=head2 Create PARAMHASH
If this object's table has any of the following atetributes defined as
'Auto', this routine will automatically fill in their values.
+=over
+
+=item Created
+
+=item Creator
+
+=item LastUpdated
+
+=item LastUpdatedBy
+
+=back
+
=cut
sub Create {
my $self = shift;
my %attribs = (@_);
foreach my $key ( keys %attribs ) {
- my $method = "Validate$key";
- unless ( $self->$method( $attribs{$key} ) ) {
+ if (my $method = $self->can("Validate$key")) {
+ if (! $method->( $self, $attribs{$key} ) ) {
if (wantarray) {
return ( 0, $self->loc('Invalid value for [_1]', $key) );
}
return (0);
}
}
+ }
}
- my $now = RT::Date->new( $self->CurrentUser );
- $now->Set( Format => 'unix', Value => time );
- $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
+
+
+
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
+
+ my $now_iso =
+ sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
+
+ $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
$attribs{'Creator'} = $self->CurrentUser->id || '0';
}
- $attribs{'LastUpdated'} = $now->ISO()
+ $attribs{'LastUpdated'} = $now_iso
if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
$attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
}
-# }}}
-# {{{ sub LoadByCols
=head2 LoadByCols
my $self = shift;
# We don't want to hang onto this
- delete $self->{'attributes'};
+ $self->ClearAttributes;
return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
return $self->SUPER::LoadByCols( %hash );
}
-# }}}
-# {{{ Datehandling
# There is room for optimizations in most of those subs:
-# {{{ LastUpdatedObj
sub LastUpdatedObj {
my $self = shift;
- my $obj = new RT::Date( $self->CurrentUser );
+ my $obj = RT::Date->new( $self->CurrentUser );
$obj->Set( Format => 'sql', Value => $self->LastUpdated );
return $obj;
}
-# }}}
-# {{{ CreatedObj
sub CreatedObj {
my $self = shift;
- my $obj = new RT::Date( $self->CurrentUser );
+ my $obj = RT::Date->new( $self->CurrentUser );
$obj->Set( Format => 'sql', Value => $self->Created );
return $obj;
}
-# }}}
-# {{{ AgeAsString
#
# TODO: This should be deprecated
#
return ( $self->CreatedObj->AgeAsString() );
}
-# }}}
-# {{{ LastUpdatedAsString
# TODO this should be deprecated
}
}
-# }}}
-# {{{ CreatedAsString
#
# TODO This should be deprecated
#
return ( $self->CreatedObj->AsString() );
}
-# }}}
-# {{{ LongSinceUpdateAsString
#
# TODO This should be deprecated
#
}
}
-# }}}
-# }}} Datehandling
-# {{{ sub _Set
#
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
=head2 _SetLastUpdated
sub _SetLastUpdated {
my $self = shift;
use RT::Date;
- my $now = new RT::Date( $self->CurrentUser );
+ my $now = RT::Date->new( $self->CurrentUser );
$now->SetToNow();
if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
}
}
-# }}}
-# {{{ sub CreatorObj
=head2 CreatorObj
return ( $self->{'CreatorObj'} );
}
-# }}}
-# {{{ sub LastUpdatedByObj
=head2 LastUpdatedByObj
return $self->{'LastUpdatedByObj'};
}
-# }}}
-# {{{ sub URI
=head2 URI
return($uri->URIForObject($self));
}
-# }}}
=head2 ValidateName NAME
sub ValidateName {
my $self = shift;
my $value = shift;
- if ($value && $value=~ /^\d+$/) {
+ if (defined $value && $value=~ /^\d+$/) {
return(0);
} else {
- return (1);
+ return(1);
}
}
sub __Value {
my $self = shift;
my $field = shift;
- my %args = ( decode_utf8 => 1, @_ );
+ my %args = ( decode_utf8 => 1, @_ );
- unless ( $field ) {
+ unless ($field) {
$RT::Logger->error("__Value called with undef field");
}
- 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 );
+ my $value = $self->SUPER::__Value($field);
+
+ return undef if (!defined $value);
+
+ if ( $args{'decode_utf8'} ) {
+ if ( !utf8::is_utf8($value) ) {
+ utf8::decode($value);
+ }
+ }
+ else {
+ if ( utf8::is_utf8($value) ) {
+ utf8::encode($value);
+ }
}
+
return $value;
+
}
# Set up defaults for DBIx::SearchBuilder::Record::Cachable
}
- foreach my $column (%$attributes) {
- foreach my $attr ( %{ $attributes->{$column} } ) {
+ foreach my $column (keys %$attributes) {
+ foreach my $attr ( keys %{ $attributes->{$column} } ) {
$_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
}
}
next unless UNIVERSAL::can( $self, $method );
$attributes = $self->$method();
- foreach my $column (%$attributes) {
- foreach my $attr ( %{ $attributes->{$column} } ) {
+ foreach my $column ( keys %$attributes ) {
+ foreach my $attr ( keys %{ $attributes->{$column} } ) {
$_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
}
}
}
-=head2 _EncodeLOB BODY MIME_TYPE
+=head2 _EncodeLOB BODY MIME_TYPE FILENAME
+
+Takes a potentially large attachment. Returns (ContentEncoding,
+EncodedBody, MimeType, Filename) based on system configuration and
+selected database. Returns a custom (short) text/plain message if
+DropLongAttachments causes an attachment to not be stored.
-Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
+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.
=cut
sub _EncodeLOB {
my $self = shift;
my $Body = shift;
- my $MIMEType = shift;
+ my $MIMEType = shift || '';
+ my $Filename = shift;
my $ContentEncoding = 'none';
#if the current attachment contains nulls and the
#database doesn't support embedded nulls
- if ( RT->Config->Get('AlwaysUseBase64') or
- ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
+ if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
# set a flag telling us to mimencode the attachment
$ContentEncoding = 'base64';
$MaxSize = $MaxSize * 3 / 4;
# Some databases (postgres) can't handle non-utf8 data
} elsif ( !$RT::Handle->BinarySafeBLOBs
- && $MIMEType !~ /text\/plain/gi
+ && $Body =~ /\P{ASCII}/
&& !Encode::is_utf8( $Body, 1 ) ) {
$ContentEncoding = 'quoted-printable';
}
$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" );
+ $Filename .= ".txt" if $Filename;
+ return ("none", "Large attachment dropped", "text/plain", $Filename );
}
}
}
- return ($ContentEncoding, $Body);
+ return ($ContentEncoding, $Body, $MIMEType, $Filename );
}
+=head2 _DecodeLOB
+
+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.
+
+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 || '';
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);
+ $Content = Encode::decode('UTF-8',$Content,Encode::FB_PERLQQ) unless Encode::is_utf8($Content);
}
return ($Content);
}
my $attributes = $args{'AttributesRef'};
my $ARGSRef = $args{'ARGSRef'};
- my @results;
+ my %new_values;
+ # gather all new values
foreach my $attribute (@$attributes) {
my $value;
if ( defined $ARGSRef->{$attribute} ) {
$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.
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();
+
+ my $current = $self->$attribute();
+ # RT::Queue->Lifecycle returns a Lifecycle object instead of name
+ $current = eval { $current->Name } if ref $current;
+ next if $truncated_value eq $current;
+ next if ( $truncated_value || 0 ) eq $current;
};
+ $new_values{$attribute} = $value;
+ }
+
+ return $self->_UpdateAttributes(
+ Attributes => $attributes,
+ NewValues => \%new_values,
+ );
+}
+
+sub _UpdateAttributes {
+ my $self = shift;
+ my %args = (
+ Attributes => [],
+ NewValues => {},
+ @_,
+ );
+
+ my @results;
+
+ foreach my $attribute (@{ $args{Attributes} }) {
+ next if !exists($args{NewValues}{$attribute});
+
+ my $value = $args{NewValues}{$attribute};
my $method = "Set$attribute";
my ( $code, $msg ) = $self->$method($value);
my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
"User" # loc
"Group" # loc
"Queue" # loc
+
=cut
push @results, $self->loc( $prefix ) . " $label: ". $msg;
"[_1] could not be set to [_2].", # loc
"That is already the current value", # loc
- "No value sent to _Set!\n", # loc
+ "No value sent to _Set!", # loc
"Illegal value for [_1]", # loc
"The new value has been set.", # loc
"No column specified", # loc
return @results;
}
-# {{{ Routines dealing with Links
-# {{{ Link Collections
-# {{{ sub Members
=head2 Members
return ( $self->_Links( 'Target', 'MemberOf' ) );
}
-# }}}
-# {{{ sub MemberOf
=head2 MemberOf
return ( $self->_Links( 'Base', 'MemberOf' ) );
}
-# }}}
-# {{{ RefersTo
=head2 RefersTo
return ( $self->_Links( 'Base', 'RefersTo' ) );
}
-# }}}
-# {{{ ReferredToBy
=head2 ReferredToBy
return ( $self->_Links( 'Target', 'RefersTo' ) );
}
-# }}}
-# {{{ DependedOnBy
=head2 DependedOnBy
return ( $self->_Links( 'Target', 'DependsOn' ) );
}
-# }}}
}
-# {{{ UnresolvedDependencies
=head2 UnresolvedDependencies
}
-# }}}
-# {{{ AllDependedOnBy
=head2 AllDependedOnBy
$args{_found}{$obj->Id} = $obj;
$obj->_AllLinkedTickets( %args, _top => 0 );
}
- elsif ($obj->Type eq $args{Type}) {
+ elsif ($obj->Type and $obj->Type eq $args{Type}) {
$args{_found}{$obj->Id} = $obj;
}
else {
}
}
-# }}}
-# {{{ DependsOn
=head2 DependsOn
=head2 Customers
- This returns an RT::Links object which references all the customers that this object is a member of.
+ This returns an RT::Links object which references all the customers that
+ this object is a member of. This includes both explicitly linked customers
+ and links implied by services.
=cut
$self->{'Customers'} = $self->MemberOf->Clone;
- $self->{'Customers'}->Limit(
- FIELD => 'Target',
- OPERATOR => 'STARTSWITH',
- VALUE => 'freeside://freeside/cust_main/',
- );
+ for my $fstable (qw(cust_main cust_svc)) {
+
+ $self->{'Customers'}->Limit(
+ FIELD => 'Target',
+ OPERATOR => 'STARTSWITH',
+ VALUE => "freeside://freeside/$fstable",
+ ENTRYAGGREGATOR => 'OR',
+ SUBCLAUSE => 'customers',
+ );
+ }
}
warn "->Customers method called on $self; returning ".
# }}}
-# {{{ sub _Links
+# {{{ Services
+
+=head2 Services
+
+ This returns an RT::Links object which references all the services this
+ object is a member of.
+
+=cut
+
+sub Services {
+ my( $self, %opt ) = @_;
+
+ unless ( $self->{'Services'} ) {
+
+ $self->{'Services'} = $self->MemberOf->Clone;
+
+ $self->{'Services'}->Limit(
+ FIELD => 'Target',
+ OPERATOR => 'STARTSWITH',
+ VALUE => "freeside://freeside/cust_svc",
+ );
+ }
+
+ return $self->{'Services'};
+}
+
+
+
+
+
=head2 Links DIRECTION [TYPE]
=cut
-*Links = \&_Links;
+sub Links { shift->_Links(@_) }
sub _Links {
my $self = shift;
my $type = shift || "";
unless ( $self->{"$field$type"} ) {
- $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
+ $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
# at least to myself
$self->{"$field$type"}->Limit( FIELD => $field,
VALUE => $self->URI,
return ( $self->{"$field$type"} );
}
-# }}}
-# }}}
-# {{{ sub FormatType
=head2 FormatType
}
-# }}}
-# {{{ sub FormatLink
=head2 FormatLink
return $text;
}
-# }}}
-# {{{ sub _AddLink
=head2 _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();
return ( 0, $self->loc('Either base or target must be specified') );
}
- # {{{ Check if the link already exists - we don't want duplicates
+ # Check if the link already exists - we don't want duplicates
use RT::Link;
my $old_link = RT::Link->new( $self->CurrentUser );
$old_link->LoadByParams( Base => $args{'Base'},
return ( $linkid, $TransString ) ;
}
-# }}}
-# {{{ sub _DeleteLink
=head2 _DeleteLink
Delete a link. takes a paramhash of Base, Target and Type.
Either Base or Target must be null. The null value will
-be replaced with this ticket\'s id
+be replaced with this ticket's id
=cut
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();
return ( 0, $self->loc('Either base or target must be specified') );
}
- my $link = new RT::Link( $self->CurrentUser );
+ my $link = RT::Link->new( $self->CurrentUser );
$RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
}
}
-# }}}
-# }}}
+=head1 LockForUpdate
-# {{{ Routines dealing with transactions
+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 _NewTransaction
+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
MIMEObj => undef,
ActivateScrips => 1,
CommitScrips => 1,
+ SquelchMailTo => undef,
+ CustomFields => {},
@_
);
+ 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'};
}
require RT::Transaction;
- my $trans = new RT::Transaction( $self->CurrentUser );
+ my $trans = RT::Transaction->new( $self->CurrentUser );
my ( $transaction, $msg ) = $trans->Create(
ObjectId => $self->Id,
ObjectType => ref($self),
MIMEObj => $args{'MIMEObj'},
ActivateScrips => $args{'ActivateScrips'},
CommitScrips => $args{'CommitScrips'},
+ SquelchMailTo => $args{'SquelchMailTo'},
+ CustomFields => $args{'CustomFields'},
);
# Rationalize the object since we may have done things to it during the caching.
if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
}
+
+ RT->DatabaseHandle->Commit unless $in_txn;
+
return ( $transaction, $msg, $trans );
}
-# }}}
-# {{{ sub Transactions
=head2 Transactions
return ($transactions);
}
-# }}}
-# }}}
#
-# {{{ Routines dealing with custom fields
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::FM 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;
}
- 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;
}
-# {{{ AddCustomFieldValue
=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
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;
}
}
my $new_content = $new_value->Content;
+
+ # For datetime, we need to display them in "human" format in result message
+ #XXX TODO how about date without time?
+ if ($cf->Type eq 'DateTime') {
+ my $DateObj = RT::Date->new( $self->CurrentUser );
+ $DateObj->Set(
+ Format => 'ISO',
+ Value => $new_content,
+ );
+ $new_content = $DateObj->AsString;
+
+ if ( defined $old_content && length $old_content ) {
+ $DateObj->Set(
+ Format => 'ISO',
+ Value => $old_content,
+ );
+ $old_content = $DateObj->AsString;
+ }
+ }
+
unless ( defined $old_content && length $old_content ) {
return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
}
}
}
-# }}}
-# {{{ DeleteCustomFieldValue
=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
}
+ my $old_value = $TransactionObj->OldValue;
+ # For datetime, we need to display them in "human" format in result message
+ if ( $cf->Type eq 'DateTime' ) {
+ my $DateObj = RT::Date->new( $self->CurrentUser );
+ $DateObj->Set(
+ Format => 'ISO',
+ Value => $old_value,
+ );
+ $old_value = $DateObj->AsString;
+ }
return (
$TransactionId,
$self->loc(
"[_1] is no longer a value for custom field [_2]",
- $TransactionObj->OldValue, $cf->Name
+ $old_value, $cf->Name
)
);
}
-# }}}
-# {{{ FirstCustomFieldValue
=head2 FirstCustomFieldValue FIELD
}
-# {{{ CustomFieldValues
=head2 CustomFieldValues FIELD
return RT->Config->Get('WebPath'). "/index.html?q=";
}
-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});
+RT::Base->_ImportOverlays();
1;
projects / freeside.git / blobdiff