X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FRecord.pm;h=59867aae8216b6b304b70971f455e57cc12d721a;hp=262bd208a76581efcae43f62301d990677789430;hb=e9e0cf0989259b94d9758eceff448666a2e5a5cc;hpb=2dfda73eeb3eae2d4f894099754794ef07d060dd diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index 262bd208a..59867aae8 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -1,40 +1,40 @@ # BEGIN BPS TAGGED BLOCK {{{ -# +# # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# -# +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# +# # (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 @@ -43,8 +43,9 @@ # royalty-free, perpetual, license to use, copy, create derivative # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. -# +# # END BPS TAGGED BLOCK }}} + =head1 NAME RT::Record - Base class for RT record objects @@ -55,11 +56,6 @@ =head1 DESCRIPTION -=begin testing - -ok (require RT::Record); - -=end testing =head1 METHODS @@ -70,36 +66,25 @@ package RT::Record; use strict; use warnings; -our @ISA; -use base qw(RT::Base); use RT::Date; +use RT::I18N; use RT::User; use RT::Attributes; -use DBIx::SearchBuilder::Record::Cachable; use Encode qw(); our $_TABLE_ATTR = { }; +use base RT->Config->Get('RecordBaseClass'); +use base 'RT::Base'; -if ( $RT::DontCacheSearchBuilderRecords ) { - push (@ISA, 'DBIx::SearchBuilder::Record'); -} else { - push (@ISA, 'DBIx::SearchBuilder::Record::Cachable'); - -} - -# {{{ sub _Init - sub _Init { my $self = shift; $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)}); $self->CurrentUser(@_); } -# }}} -# {{{ _PrimaryKeys =head2 _PrimaryKeys @@ -107,12 +92,24 @@ The primary keys for RT classes is 'id' =cut -sub _PrimaryKeys { - my $self = shift; - return ( ['id'] ); +sub _PrimaryKeys { return ['id'] } +# short circuit many, many thousands of calls from searchbuilder +sub _PrimaryKey { 'id' } + +=head2 Id + +Override L to avoid a few lookups RT doesn't do +on a very common codepath + +C is an alias to C and is the preferred way to call this method. + +=cut + +sub Id { + return shift->{'values'}->{id}; } -# }}} +*id = \&Id; =head2 Delete @@ -136,14 +133,6 @@ sub Delete { Returns a string which is this object's type. The type is the class, without the "RT::" prefix. -=begin testing - -my $ticket = RT::Ticket->new($RT::SystemUser); -my $group = RT::Group->new($RT::SystemUser); -is($ticket->ObjectTypeStr, 'Ticket', "Ticket returns correct typestring"); -is($group->ObjectTypeStr, 'Group', "Group returns correct typestring"); - -=end testing =cut @@ -164,13 +153,12 @@ Return this object's attributes as an RT::Attributes object 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'}); } @@ -237,17 +225,17 @@ Deletes all attributes with the matching name for this object. 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 object), or C 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 @@ -258,15 +246,15 @@ sub FirstAttribute { } -# {{{ sub _Handle -sub _Handle { +sub ClearAttributes { my $self = shift; - return ($RT::Handle); + delete $self->{'attributes'}; + } -# }}} +sub _Handle { return $RT::Handle } + -# {{{ sub Create =head2 Create PARAMHASH @@ -278,14 +266,26 @@ an error. 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) ); } @@ -293,15 +293,22 @@ sub Create { 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' @@ -335,8 +342,6 @@ sub Create { } if (UNIVERSAL::isa('errno',$id)) { - exit(0); - warn "It's here!"; return(undef); } @@ -353,9 +358,7 @@ sub Create { } -# }}} -# {{{ sub LoadByCols =head2 LoadByCols @@ -366,74 +369,56 @@ DB is case sensitive sub LoadByCols { my $self = shift; - my %hash = (@_); # We don't want to hang onto this - delete $self->{'attributes'}; + $self->ClearAttributes; + + return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive; # If this database is case sensitive we need to uncase objects for # explicit loading - if ( $self->_Handle->CaseSensitive ) { - my %newhash; - foreach my $key ( keys %hash ) { - - # If we've been passed an empty value, we can't do the lookup. - # We don't need to explicitly downcase integers or an id. - if ( $key =~ '^id$' - || !defined( $hash{$key} ) - || $hash{$key} =~ /^\d+$/ - ) - { - $newhash{$key} = $hash{$key}; - } - else { - my ($op, $val, $func); - ($key, $op, $val, $func) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key}); - $newhash{$key}->{operator} = $op; - $newhash{$key}->{value} = $val; - $newhash{$key}->{function} = $func; - } + my %hash = (@_); + foreach my $key ( keys %hash ) { + + # If we've been passed an empty value, we can't do the lookup. + # We don't need to explicitly downcase integers or an id. + if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) { + my ($op, $val, $func); + ($key, $op, $val, $func) = + $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } ); + $hash{$key}->{operator} = $op; + $hash{$key}->{value} = $val; + $hash{$key}->{function} = $func; } - - # We've clobbered everything we care about. bash the old hash - # and replace it with the new hash - %hash = %newhash; } - $self->SUPER::LoadByCols(%hash); + return $self->SUPER::LoadByCols( %hash ); } -# }}} -# {{{ 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 # @@ -442,9 +427,7 @@ sub AgeAsString { return ( $self->CreatedObj->AgeAsString() ); } -# }}} -# {{{ LastUpdatedAsString # TODO this should be deprecated @@ -459,9 +442,7 @@ sub LastUpdatedAsString { } } -# }}} -# {{{ CreatedAsString # # TODO This should be deprecated # @@ -470,9 +451,7 @@ sub CreatedAsString { return ( $self->CreatedObj->AsString() ); } -# }}} -# {{{ LongSinceUpdateAsString # # TODO This should be deprecated # @@ -488,11 +467,8 @@ sub LongSinceUpdateAsString { } } -# }}} -# }}} Datehandling -# {{{ sub _Set # sub _Set { my $self = shift; @@ -525,24 +501,27 @@ 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]", - $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 @@ -554,7 +533,7 @@ It takes no options. Arguably, this is a bug 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' ) ) { @@ -571,9 +550,7 @@ sub _SetLastUpdated { } } -# }}} -# {{{ sub CreatorObj =head2 CreatorObj @@ -591,9 +568,7 @@ sub CreatorObj { return ( $self->{'CreatorObj'} ); } -# }}} -# {{{ sub LastUpdatedByObj =head2 LastUpdatedByObj @@ -610,9 +585,7 @@ sub LastUpdatedByObj { return $self->{'LastUpdatedByObj'}; } -# }}} -# {{{ sub URI =head2 URI @@ -626,7 +599,6 @@ sub URI { return($uri->URIForObject($self)); } -# }}} =head2 ValidateName NAME @@ -637,10 +609,10 @@ Validate the name of the record we're creating. Mostly, just make sure it's not sub ValidateName { my $self = shift; my $value = shift; - if ($value && $value=~ /^\d+$/) { + if (defined $value && $value=~ /^\d+$/) { return(0); } else { - return (1); + return(1); } } @@ -661,29 +633,32 @@ sub SQLType { } - sub __Value { my $self = shift; my $field = shift; - my %args = ( decode_utf8 => 1, - @_ ); + my %args = ( decode_utf8 => 1, @_ ); - unless (defined $field && $field) { - $RT::Logger->error("$self __Value called with undef field"); + unless ($field) { + $RT::Logger->error("__Value called with undef field"); } + my $value = $self->SUPER::__Value($field); - return('') if ( !defined($value) || $value eq ''); + return undef if (!defined $value); - if( $args{'decode_utf8'} ) { - # XXX: is_utf8 check should be here unless Encode bug would be fixed - # see http://rt.cpan.org/NoAuth/Bug.html?id=14559 - return Encode::decode_utf8($value) unless Encode::is_utf8($value); - } else { - # check is_utf8 here just to be shure - return Encode::encode_utf8($value) if Encode::is_utf8($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 @@ -699,6 +674,7 @@ sub _CacheConfig { sub _BuildTableAttributes { my $self = shift; + my $class = ref($self) || $self; my $attributes; if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) { @@ -708,39 +684,21 @@ sub _BuildTableAttributes { } - foreach my $column (%$attributes) { - foreach my $attr ( %{ $attributes->{$column} } ) { - $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr}; + foreach my $column (keys %$attributes) { + foreach my $attr ( keys %{ $attributes->{$column} } ) { + $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; } } - if ( UNIVERSAL::can( $self, '_OverlayAccessible' ) ) { - $attributes = $self->_OverlayAccessible(); + foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) { + next unless UNIVERSAL::can( $self, $method ); + $attributes = $self->$method(); - foreach my $column (%$attributes) { - foreach my $attr ( %{ $attributes->{$column} } ) { - $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr}; + foreach my $column ( keys %$attributes ) { + foreach my $attr ( keys %{ $attributes->{$column} } ) { + $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; } } } - if ( UNIVERSAL::can( $self, '_VendorAccessible' ) ) { - $attributes = $self->_VendorAccessible(); - - foreach my $column (%$attributes) { - foreach my $attr ( %{ $attributes->{$column} } ) { - $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr}; - } - } - } - if ( UNIVERSAL::can( $self, '_LocalAccessible' ) ) { - $attributes = $self->_LocalAccessible(); - - foreach my $column (%$attributes) { - foreach my $attr ( %{ $attributes->{$column} } ) { - $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr}; - } - } - } - } @@ -753,7 +711,7 @@ DBIx::SearchBuilder::Record sub _ClassAccessible { my $self = shift; - return $_TABLE_ATTR->{ref($self)}; + return $_TABLE_ATTR->{ref($self) || $self}; } =head2 _Accessible COLUMN ATTRIBUTE @@ -772,37 +730,48 @@ sub _Accessible { } -=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'; #get the max attachment length from RT - my $MaxSize = $RT::MaxAttachmentSize; + my $MaxSize = RT->Config->Get('MaxAttachmentSize'); #if the current attachment contains nulls and the #database doesn't support embedded nulls - if ( $RT::AlwaysUseBase64 or - ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { + if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { # set a flag telling us to mimencode the attachment $ContentEncoding = 'base64'; #cut the max attchment size by 25% (for mime-encoding overhead. - $RT::Logger->debug("Max size is $MaxSize\n"); + $RT::Logger->debug("Max size is $MaxSize"); $MaxSize = $MaxSize * 3 / 4; # Some databases (postgres) can't handle non-utf8 data } elsif ( !$RT::Handle->BinarySafeBLOBs - && $MIMEType !~ /text\/plain/gi + && $Body =~ /\P{ASCII}/ && !Encode::is_utf8( $Body, 1 ) ) { $ContentEncoding = 'quoted-printable'; } @@ -811,7 +780,7 @@ sub _EncodeLOB { if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { # if we're supposed to truncate large attachments - if ($RT::TruncateLongAttachments) { + if (RT->Config->Get('TruncateLongAttachments')) { # truncate the attachment to that length. $Body = substr( $Body, 0, $MaxSize ); @@ -819,14 +788,14 @@ sub _EncodeLOB { } # elsif we're supposed to drop large attachments on the floor, - elsif ($RT::DropLongAttachments) { + elsif (RT->Config->Get('DropLongAttachments')) { # drop the attachment on the floor $RT::Logger->info( "$self: Dropped an attachment of size " - . length($Body) . "\n" - . "It started: " . substr( $Body, 0, 60 ) . "\n" - ); - return ("none", "Large attachment dropped" ); + . length($Body)); + $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); + $Filename .= ".txt" if $Filename; + return ("none", "Large attachment dropped", "text/plain", $Filename ); } } @@ -843,14 +812,35 @@ sub _EncodeLOB { } - 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; - my $ContentEncoding = shift; + my $ContentType = shift || ''; + my $ContentEncoding = shift || 'none'; my $Content = shift; if ( $ContentEncoding eq 'base64' ) { @@ -863,12 +853,11 @@ sub _DecodeLOB { 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); } -# {{{ LINKDIRMAP # A helper table for links mapping to make it easier # to build and parse links between tickets @@ -913,8 +902,9 @@ sub Update { 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} ) { @@ -935,6 +925,7 @@ 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. @@ -942,11 +933,45 @@ sub Update { # This is in an eval block because $object might not exist. # and might not have a Name method. But "can" won't find autoloaded # items. If it fails, we don't care - eval { - my $object = $attribute . "Obj"; - next if ($self->$object->Name eq $value); + do { + no warnings "uninitialized"; + local $@; + eval { + my $object = $attribute . "Obj"; + my $name = $self->$object->Name; + next if $name eq $value || $name eq ($value || 0); + }; + + 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; }; - next if ( $value eq $self->$attribute() ); + + $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+)/; @@ -954,13 +979,24 @@ sub Update { # Default to $id, but use name if we can get it. my $label = $self->id; $label = $self->Name if (UNIVERSAL::can($self,'Name')); - push @results, $self->loc( "$prefix [_1]", $label ) . ': '. $msg; + # this requires model names to be loc'ed. + +=for loc + + "Ticket" # loc + "User" # loc + "Group" # loc + "Queue" # loc + +=cut + + push @results, $self->loc( $prefix ) . " $label: ". $msg; =for loc "[_1] could not be set to [_2].", # loc "That is already the current value", # loc - "No value sent to _Set!\n", # loc + "No value sent to _Set!", # loc "Illegal value for [_1]", # loc "The new value has been set.", # loc "No column specified", # loc @@ -978,11 +1014,8 @@ sub Update { return @results; } -# {{{ Routines dealing with Links -# {{{ Link Collections -# {{{ sub Members =head2 Members @@ -996,9 +1029,7 @@ sub Members { return ( $self->_Links( 'Target', 'MemberOf' ) ); } -# }}} -# {{{ sub MemberOf =head2 MemberOf @@ -1012,9 +1043,7 @@ sub MemberOf { return ( $self->_Links( 'Base', 'MemberOf' ) ); } -# }}} -# {{{ RefersTo =head2 RefersTo @@ -1027,9 +1056,7 @@ sub RefersTo { return ( $self->_Links( 'Base', 'RefersTo' ) ); } -# }}} -# {{{ ReferredToBy =head2 ReferredToBy @@ -1042,9 +1069,7 @@ sub ReferredToBy { return ( $self->_Links( 'Target', 'RefersTo' ) ); } -# }}} -# {{{ DependedOnBy =head2 DependedOnBy @@ -1057,60 +1082,15 @@ sub DependedOnBy { return ( $self->_Links( 'Target', 'DependsOn' ) ); } -# }}} =head2 HasUnresolvedDependencies - Takes a paramhash of Type (default to '__any'). Returns true if -$self->UnresolvedDependencies returns an object with one or more members -of that type. Returns false otherwise - - -=begin testing - -my $t1 = RT::Ticket->new($RT::SystemUser); -my ($id, $trans, $msg) = $t1->Create(Subject => 'DepTest1', Queue => 'general'); -ok($id, "Created dep test 1 - $msg"); - -my $t2 = RT::Ticket->new($RT::SystemUser); -my ($id2, $trans, $msg2) = $t2->Create(Subject => 'DepTest2', Queue => 'general'); -ok($id2, "Created dep test 2 - $msg2"); -my $t3 = RT::Ticket->new($RT::SystemUser); -my ($id3, $trans, $msg3) = $t3->Create(Subject => 'DepTest3', Queue => 'general', Type => 'approval'); -ok($id3, "Created dep test 3 - $msg3"); -my ($addid, $addmsg); -ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t2->id)); -ok ($addid, $addmsg); -ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t3->id)); - -ok ($addid, $addmsg); -my $link = RT::Link->new($RT::SystemUser); -my ($rv, $msg) = $link->Load($addid); -ok ($rv, $msg); -ok ($link->LocalTarget == $t3->id, "Link LocalTarget is correct"); -ok ($link->LocalBase == $t1->id, "Link LocalBase is correct"); - -ok ($t1->HasUnresolvedDependencies, "Ticket ".$t1->Id." has unresolved deps"); -ok (!$t1->HasUnresolvedDependencies( Type => 'blah' ), "Ticket ".$t1->Id." has no unresolved blahs"); -ok ($t1->HasUnresolvedDependencies( Type => 'approval' ), "Ticket ".$t1->Id." has unresolved approvals"); -ok (!$t2->HasUnresolvedDependencies, "Ticket ".$t2->Id." has no unresolved deps"); -; - -my ($rid, $rmsg)= $t1->Resolve(); -ok(!$rid, $rmsg); -my ($rid2, $rmsg2) = $t2->Resolve(); -ok ($rid2, $rmsg2); -($rid, $rmsg)= $t1->Resolve(); -ok(!$rid, $rmsg); -my ($rid3,$rmsg3) = $t3->Resolve; -ok ($rid3,$rmsg3); -($rid, $rmsg)= $t1->Resolve(); -ok($rid, $rmsg); - - -=end testing +Takes a paramhash of Type (default to '__any'). Returns the number of +unresolved dependencies, if $self->UnresolvedDependencies returns an +object with one or more members of that type. Returns false +otherwise. =cut @@ -1133,7 +1113,7 @@ sub HasUnresolvedDependencies { } if ($deps->Count > 0) { - return 1; + return $deps->Count; } else { return (undef); @@ -1141,7 +1121,6 @@ sub HasUnresolvedDependencies { } -# {{{ UnresolvedDependencies =head2 UnresolvedDependencies @@ -1166,9 +1145,7 @@ sub UnresolvedDependencies { } -# }}} -# {{{ AllDependedOnBy =head2 AllDependedOnBy @@ -1182,27 +1159,54 @@ dependency search. sub AllDependedOnBy { my $self = shift; - my $dep = $self->DependedOnBy; + return $self->_AllLinkedTickets( LinkType => 'DependsOn', + Direction => 'Target', @_ ); +} + +=head2 AllDependsOn + +Returns an array of RT::Ticket objects which this ticket (directly or +indirectly) depends on; takes an optional 'Type' argument in the param +hash, which will limit returned tickets to that type, as well as cause +tickets with that type to serve as 'leaf' nodes that stops the +recursive dependency search. + +=cut + +sub AllDependsOn { + my $self = shift; + return $self->_AllLinkedTickets( LinkType => 'DependsOn', + Direction => 'Base', @_ ); +} + +sub _AllLinkedTickets { + my $self = shift; + my %args = ( + LinkType => undef, + Direction => undef, Type => undef, _found => {}, _top => 1, @_ ); + my $dep = $self->_Links( $args{Direction}, $args{LinkType}); while (my $link = $dep->Next()) { - next unless ($link->BaseURI->IsLocal()); - next if $args{_found}{$link->BaseObj->Id}; + my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI; + next unless ($uri->IsLocal()); + my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj; + next if $args{_found}{$obj->Id}; if (!$args{Type}) { - $args{_found}{$link->BaseObj->Id} = $link->BaseObj; - $link->BaseObj->AllDependedOnBy( %args, _top => 0 ); + $args{_found}{$obj->Id} = $obj; + $obj->_AllLinkedTickets( %args, _top => 0 ); } - elsif ($link->BaseObj->Type eq $args{Type}) { - $args{_found}{$link->BaseObj->Id} = $link->BaseObj; + elsif ($obj->Type and $obj->Type eq $args{Type}) { + $args{_found}{$obj->Id} = $obj; } else { - $link->BaseObj->AllDependedOnBy( %args, _top => 0 ); + $obj->_AllLinkedTickets( %args, _top => 0 ); } } @@ -1214,9 +1218,7 @@ sub AllDependedOnBy { } } -# }}} -# {{{ DependsOn =head2 DependsOn @@ -1231,10 +1233,75 @@ sub DependsOn { # }}} +# {{{ Customers + +=head2 Customers + + 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 + +sub Customers { + my( $self, %opt ) = @_; + my $Debug = $opt{'Debug'}; + + unless ( $self->{'Customers'} ) { + + $self->{'Customers'} = $self->MemberOf->Clone; + + 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 ". + ref($self->{'Customers'}). ' object' + if $Debug; + + return $self->{'Customers'}; +} + +# }}} + +# {{{ 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'}; +} + + -# {{{ sub _Links =head2 Links DIRECTION [TYPE] @@ -1247,7 +1314,7 @@ links of any type. =cut -*Links = \&_Links; +sub Links { shift->_Links(@_) } sub _Links { my $self = shift; @@ -1258,7 +1325,7 @@ sub _Links { 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, @@ -1270,11 +1337,48 @@ sub _Links { return ( $self->{"$field$type"} ); } -# }}} -# }}} -# {{{ sub _AddLink + +=head2 FormatType + +Takes a Type and returns a string that is more human readable. + +=cut + +sub FormatType{ + my $self = shift; + my %args = ( Type => '', + @_ + ); + $args{Type} =~ s/([A-Z])/" " . lc $1/ge; + $args{Type} =~ s/^\s+//; + return $args{Type}; +} + + + + +=head2 FormatLink + +Takes either a Target or a Base and returns a string of human friendly text. + +=cut + +sub FormatLink { + my $self = shift; + my %args = ( Object => undef, + FallBack => '', + @_ + ); + my $text = "URI " . $args{FallBack}; + if ($args{Object} && $args{Object}->isa("RT::Ticket")) { + $text = "Ticket " . $args{Object}->id; + } + return $text; +} + + =head2 _AddLink @@ -1285,7 +1389,6 @@ Returns C, C and C flag. =cut - sub _AddLink { my $self = shift; my %args = ( Target => '', @@ -1300,8 +1403,8 @@ sub _AddLink { my $direction; if ( $args{'Base'} and $args{'Target'} ) { - $RT::Logger->debug( "$self tried to create a link. both base and target were specified\n" ); - return ( 0, $self->loc("Can't specifiy both base and target") ); + $RT::Logger->debug( "$self tried to create a link. both base and target were specified" ); + return ( 0, $self->loc("Can't specify both base and target") ); } elsif ( $args{'Base'} ) { $args{'Target'} = $self->URI(); @@ -1317,7 +1420,7 @@ sub _AddLink { 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'}, @@ -1342,21 +1445,23 @@ sub _AddLink { return ( 0, $self->loc("Link could not be created") ); } + my $basetext = $self->FormatLink(Object => $link->BaseObj, + FallBack => $args{Base}); + my $targettext = $self->FormatLink(Object => $link->TargetObj, + FallBack => $args{Target}); + my $typetext = $self->FormatType(Type => $args{Type}); my $TransString = - "Record $args{'Base'} $args{Type} record $args{'Target'}."; - - return ( $linkid, $self->loc( "Link created ([_1])", $TransString ) ); + "$basetext $typetext $targettext."; + 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 @@ -1376,8 +1481,8 @@ sub _DeleteLink { my $remote_link; if ( $args{'Base'} and $args{'Target'} ) { - $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n"); - return ( 0, $self->loc("Can't specifiy both base and target") ); + $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target"); + return ( 0, $self->loc("Can't specify both base and target") ); } elsif ( $args{'Base'} ) { $args{'Target'} = $self->URI(); @@ -1390,39 +1495,66 @@ sub _DeleteLink { $direction='Base'; } else { - $RT::Logger->error("Base or Target must be specified\n"); + $RT::Logger->error("Base or Target must be specified"); return ( 0, $self->loc('Either base or target must be specified') ); } - my $link = new RT::Link( $self->CurrentUser ); - $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} . "\n" ); + 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'} ); #it's a real link. - if ( $link->id ) { + if ( $link->id ) { + my $basetext = $self->FormatLink(Object => $link->BaseObj, + FallBack => $args{Base}); + my $targettext = $self->FormatLink(Object => $link->TargetObj, + FallBack => $args{Target}); + my $typetext = $self->FormatType(Type => $args{Type}); my $linkid = $link->id; $link->Delete(); - - my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}."; - return ( 1, $self->loc("Link deleted ([_1])", $TransString)); + my $TransString = "$basetext no longer $typetext $targettext."; + return ( 1, $TransString); } #if it's not a link we can find else { - $RT::Logger->debug("Couldn't find that link\n"); + $RT::Logger->debug("Couldn't find that link"); return ( 0, $self->loc("Link not found") ); } } -# }}} -# }}} +=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. -# {{{ Routines dealing with transactions +=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 @@ -1445,9 +1577,16 @@ sub _NewTransaction { 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'}; @@ -1462,7 +1601,7 @@ sub _NewTransaction { } 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), @@ -1478,6 +1617,8 @@ sub _NewTransaction { 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. @@ -1490,15 +1631,16 @@ sub _NewTransaction { if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) { $self->_UpdateTimeTaken( $args{'TimeTaken'} ); } - if ( $RT::UseTransactionBatch and $transaction ) { + 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 @@ -1525,37 +1667,46 @@ sub Transactions { return ($transactions); } -# }}} -# }}} # -# {{{ Routines dealing with custom fields sub CustomFields { my $self = shift; my $cfs = RT::CustomFields->new( $self->CurrentUser ); - + + $cfs->SetContextObject( $self ); # XXX handle multiple types properly $cfs->LimitToLookupType( $self->CustomFieldLookupType ); - $cfs->LimitToGlobalOrObjectId( - $self->_LookupId( $self->CustomFieldLookupType ) ); + $cfs->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; } @@ -1567,30 +1718,20 @@ Returns the path RT uses to figure out which custom fields apply to this object. sub CustomFieldLookupType { my $self = shift; - return ref($self); -} - -#TODO Deprecated API. Destroy in 3.6 -sub _LookupTypes { - my $self = shift; - $RT::Logger->warning("_LookupTypes call is deprecated at (". join(":",caller)."). Replace with CustomFieldLookupType"); - - return($self->CustomFieldLookupType); - + return ref($self) || $self; } -# {{{ AddCustomFieldValue =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE } -VALUE should be a string. -FIELD can be a CustomField object OR a CustomField ID. +VALUE should be a string. FIELD can be any identifier of a CustomField +supported by L method. - -Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field, -deletes the old value. +Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field, +deletes the old value. If VALUE is not a valid value for the custom field, returns -(0, 'Error message' ) otherwise, returns (1, 'Success Message') +(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where +$id is ID of created L object. =cut @@ -1604,12 +1745,13 @@ sub _AddCustomFieldValue { my %args = ( Field => undef, Value => undef, + LargeContent => undef, + ContentType => undef, RecordTransaction => 1, @_ ); my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); - unless ( $cf->Id ) { return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); } @@ -1621,12 +1763,15 @@ sub _AddCustomFieldValue { 0, $self->loc( "Custom field [_1] does not apply to this object", - $args{'Field'} + ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'} ) ); } - # Load up a ObjectCustomFieldValues object for this custom field and this ticket - my $values = $cf->ValuesForObject($self); + + # empty string is not correct value of any CF, so undef it + foreach ( qw(Value LargeContent) ) { + $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ }; + } unless ( $cf->ValidateValue( $args{'Value'} ) ) { return ( 0, $self->loc("Invalid value for custom field") ); @@ -1634,11 +1779,14 @@ sub _AddCustomFieldValue { # If the custom field only accepts a certain # of values, delete the existing # value and record a "changed from foo to bar" transaction - unless ( $cf->UnlimitedValues) { + unless ( $cf->UnlimitedValues ) { + + # Load up a ObjectCustomFieldValues object for this custom field and this ticket + my $values = $cf->ValuesForObject($self); - # We need to whack any old values here. In most cases, the custom field should - # only have one value to delete. In the pathalogical case, this custom field - # used to be a multiple and we have many values to whack.... + # We need to whack any old values here. In most cases, the custom field should + # only have one value to delete. In the pathalogical case, this custom field + # used to be a multiple and we have many values to whack.... my $cf_values = $values->Count; if ( $cf_values > $cf->MaxValues ) { @@ -1667,8 +1815,27 @@ sub _AddCustomFieldValue { my ( $old_value, $old_content ); if ( $old_value = $values->First ) { - $old_content = $old_value->Content(); - return (1) if( $old_content eq $args{'Value'} && $old_value->LargeContent eq $args{'LargeContent'});; + $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 + && $old_content eq $args{'Value'}; + } else { + $is_the_same = 0 if defined $old_content; + } + if ( $is_the_same ) { + my $old_content = $old_value->LargeContent; + if ( defined $args{'LargeContent'} ) { + $is_the_same = 0 unless defined $old_content + && $old_content eq $args{'LargeContent'}; + } else { + $is_the_same = 0 if defined $old_content; + } + } + + return $old_value->id if $is_the_same; } my ( $new_value_id, $value_msg ) = $cf->AddValueForObject( @@ -1678,19 +1845,17 @@ sub _AddCustomFieldValue { ContentType => $args{'ContentType'}, ); - unless ($new_value_id) { - return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) ); + unless ( $new_value_id ) { + return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) ); } my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser ); - $new_value->Load($new_value_id); + $new_value->Load( $new_value_id ); # now that adding the new value was successful, delete the old one - if ($old_value) { + if ( $old_value ) { my ( $val, $msg ) = $old_value->Delete(); - unless ($val) { - return ( 0, $msg ); - } + return ( 0, $msg ) unless $val; } if ( $args{'RecordTransaction'} ) { @@ -1703,52 +1868,68 @@ sub _AddCustomFieldValue { ); } - if ( $old_value eq '' ) { - return ( 1, $self->loc( "[_1] [_2] added", $cf->Name, $new_value->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 )); } - elsif ( $new_value->Content eq '' ) { - return ( 1, - $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) ); + elsif ( !defined $new_content || !length $new_content ) { + return ( $new_value_id, + $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) ); } else { - return ( 1, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_value->Content)); + return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content)); } } # otherwise, just add a new value and record "new value added" else { - my ($new_value_id, $value_msg) = $cf->AddValueForObject( + my ($new_value_id, $msg) = $cf->AddValueForObject( Object => $self, Content => $args{'Value'}, LargeContent => $args{'LargeContent'}, ContentType => $args{'ContentType'}, ); - unless ($new_value_id) { - return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) ); + unless ( $new_value_id ) { + return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) ); } if ( $args{'RecordTransaction'} ) { - my ( $TransactionId, $Msg, $TransactionObj ) = - $self->_NewTransaction( + my ( $tid, $msg ) = $self->_NewTransaction( Type => 'CustomField', Field => $cf->Id, NewReference => $new_value_id, ReferenceType => 'RT::ObjectCustomFieldValue', - ); - unless ($TransactionId) { - return ( 0, - $self->loc( "Couldn't create a transaction: [_1]", $Msg ) ); + ); + unless ( $tid ) { + return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) ); } } - return ( 1, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name)); + return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) ); } - } -# }}} -# {{{ DeleteCustomFieldValue =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE } @@ -1771,10 +1952,10 @@ sub DeleteCustomFieldValue { ); my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); - unless ( $cf->Id ) { return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); } + my ( $val, $msg ) = $cf->DeleteValueForObject( Object => $self, Id => $args{'ValueId'}, @@ -1783,6 +1964,7 @@ sub DeleteCustomFieldValue { unless ($val) { return ( 0, $msg ); } + my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction( Type => 'CustomField', Field => $cf->Id, @@ -1793,18 +1975,26 @@ sub DeleteCustomFieldValue { 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 @@ -1816,18 +2006,36 @@ Takes a field id or name sub FirstCustomFieldValue { my $self = shift; my $field = shift; - my $values = $self->CustomFieldValues($field); - if ($values->First) { - return $values->First->Content; - } else { - return undef; - } + my $values = $self->CustomFieldValues( $field ); + return undef unless my $first = $values->First; + return $first->Content; } +=head2 CustomFieldValuesAsString FIELD + +Return the content of the CustomField FIELD for this ticket. +If this is a multi-value custom field, values will be joined with newlines. + +Takes a field id or name as the first argument + +Takes an optional Separator => "," second and third argument +if you want to join the values using something other than a newline + +=cut + +sub CustomFieldValuesAsString { + my $self = shift; + my $field = shift; + my %args = @_; + my $separator = $args{Separator} || "\n"; + + my $values = $self->CustomFieldValues( $field ); + return join ($separator, grep { defined $_ } + map { $_->Content } @{$values->ItemsArrayRef}); +} -# {{{ CustomFieldValues =head2 CustomFieldValues FIELD @@ -1842,11 +2050,12 @@ sub CustomFieldValues { my $self = shift; my $field = shift; - if ($field) { - my $cf = $self->LoadCustomFieldByIdentifier($field); + if ( $field ) { + my $cf = $self->LoadCustomFieldByIdentifier( $field ); - # we were asked to search on a custom field we couldn't fine + # we were asked to search on a custom field we couldn't find unless ( $cf->id ) { + $RT::Logger->warning("Couldn't load custom field by '$field' identifier"); return RT::ObjectCustomFieldValues->new( $self->CurrentUser ); } return ( $cf->ValuesForObject($self) ); @@ -1854,12 +2063,11 @@ sub CustomFieldValues { # we're not limiting to a specific custom field; my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser ); - $ocfs->LimitToObject($self); + $ocfs->LimitToObject( $self ); return $ocfs; - } -=head2 CustomField IDENTIFER +=head2 LoadCustomFieldByIdentifier IDENTIFER Find the custom field has id or name IDENTIFIER for this object. @@ -1871,40 +2079,34 @@ sub LoadCustomFieldByIdentifier { my $self = shift; my $field = shift; - my $cf = RT::CustomField->new($self->CurrentUser); - + my $cf; if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) { + $cf = RT::CustomField->new($self->CurrentUser); + $cf->SetContextObject( $self ); $cf->LoadById( $field->id ); } elsif ($field =~ /^\d+$/) { $cf = RT::CustomField->new($self->CurrentUser); - $cf->Load($field); + $cf->SetContextObject( $self ); + $cf->LoadById($field); } else { my $cfs = $self->CustomFields($self->CurrentUser); + $cfs->SetContextObject( $self ); $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0); $cf = $cfs->First || RT::CustomField->new($self->CurrentUser); } return $cf; } +sub ACLEquivalenceObjects { } -# }}} - -# }}} - -# }}} - -sub BasicColumns { -} +sub BasicColumns { } sub WikiBase { - return $RT::WebPath. "/index.html?q="; + 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;