1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
6 # <jesse@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
51 RT::Record - Base class for RT record objects
74 our $_TABLE_ATTR = { };
77 my $base = 'DBIx::SearchBuilder::Record::Cachable';
78 if ( $RT::Config && $RT::Config->Get('DontCacheSearchBuilderRecords') ) {
79 $base = 'DBIx::SearchBuilder::Record';
81 eval "require $base" or die $@;
82 our @ISA = 'RT::Base';
89 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
90 $self->CurrentUser(@_);
99 The primary keys for RT classes is 'id'
103 sub _PrimaryKeys { return ['id'] }
109 Delete this record object from the database.
115 my ($rv) = $self->SUPER::Delete;
117 return ($rv, $self->loc("Object deleted"));
120 return(0, $self->loc("Object could not be deleted"))
126 Returns a string which is this object's type. The type is the class,
127 without the "RT::" prefix.
134 if (ref($self) =~ /^.*::(\w+)$/) {
135 return $self->loc($1);
137 return $self->loc(ref($self));
143 Return this object's attributes as an RT::Attributes object
150 unless ($self->{'attributes'}) {
151 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
152 $self->{'attributes'}->LimitToObject($self);
154 return ($self->{'attributes'});
159 =head2 AddAttribute { Name, Description, Content }
161 Adds a new attribute for this object.
167 my %args = ( Name => undef,
168 Description => undef,
172 my $attr = RT::Attribute->new( $self->CurrentUser );
173 my ( $id, $msg ) = $attr->Create(
175 Name => $args{'Name'},
176 Description => $args{'Description'},
177 Content => $args{'Content'} );
180 # XXX TODO: Why won't RedoSearch work here?
181 $self->Attributes->_DoSearch;
187 =head2 SetAttribute { Name, Description, Content }
189 Like AddAttribute, but replaces all existing attributes with the same Name.
195 my %args = ( Name => undef,
196 Description => undef,
200 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
201 or return $self->AddAttribute( %args );
203 my $AttributeObj = pop( @AttributeObjs );
204 $_->Delete foreach @AttributeObjs;
206 $AttributeObj->SetDescription( $args{'Description'} );
207 $AttributeObj->SetContent( $args{'Content'} );
209 $self->Attributes->RedoSearch;
213 =head2 DeleteAttribute NAME
215 Deletes all attributes with the matching name for this object.
219 sub DeleteAttribute {
222 return $self->Attributes->DeleteEntry( Name => $name );
225 =head2 FirstAttribute NAME
227 Returns the first attribute with the matching name for this object (as an
228 L<RT::Attribute> object), or C<undef> if no such attributes exist.
230 Note that if there is more than one attribute with the matching name on the
231 object, the choice of which one to return is basically arbitrary. This may be
232 made well-defined in the future.
239 return ($self->Attributes->Named( $name ))[0];
244 sub _Handle { return $RT::Handle }
250 =head2 Create PARAMHASH
252 Takes a PARAMHASH of Column -> Value pairs.
253 If any Column has a Validate$PARAMNAME subroutine defined and the
254 value provided doesn't pass validation, this routine returns
257 If this object's table has any of the following atetributes defined as
258 'Auto', this routine will automatically fill in their values.
265 foreach my $key ( keys %attribs ) {
266 my $method = "Validate$key";
267 unless ( $self->$method( $attribs{$key} ) ) {
269 return ( 0, $self->loc('Invalid value for [_1]', $key) );
276 my $now = RT::Date->new( $self->CurrentUser );
277 $now->Set( Format => 'unix', Value => time );
278 $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
280 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
281 $attribs{'Creator'} = $self->CurrentUser->id || '0';
283 $attribs{'LastUpdated'} = $now->ISO()
284 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
286 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
287 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
289 my $id = $self->SUPER::Create(%attribs);
290 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
294 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
301 # If the object was created in the database,
302 # load it up now, so we're sure we get what the database
303 # has. Arguably, this should not be necessary, but there
304 # isn't much we can do about it.
308 return ( $id, $self->loc('Object could not be created') );
316 if (UNIVERSAL::isa('errno',$id)) {
320 $self->Load($id) if ($id);
325 return ( $id, $self->loc('Object created') );
339 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
347 # We don't want to hang onto this
348 delete $self->{'attributes'};
350 return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
352 # If this database is case sensitive we need to uncase objects for
355 foreach my $key ( keys %hash ) {
357 # If we've been passed an empty value, we can't do the lookup.
358 # We don't need to explicitly downcase integers or an id.
359 if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
360 my ($op, $val, $func);
361 ($key, $op, $val, $func) =
362 $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
363 $hash{$key}->{operator} = $op;
364 $hash{$key}->{value} = $val;
365 $hash{$key}->{function} = $func;
368 return $self->SUPER::LoadByCols( %hash );
375 # There is room for optimizations in most of those subs:
381 my $obj = new RT::Date( $self->CurrentUser );
383 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
393 my $obj = new RT::Date( $self->CurrentUser );
395 $obj->Set( Format => 'sql', Value => $self->Created );
404 # TODO: This should be deprecated
408 return ( $self->CreatedObj->AgeAsString() );
413 # {{{ LastUpdatedAsString
415 # TODO this should be deprecated
417 sub LastUpdatedAsString {
419 if ( $self->LastUpdated ) {
420 return ( $self->LastUpdatedObj->AsString() );
430 # {{{ CreatedAsString
432 # TODO This should be deprecated
434 sub CreatedAsString {
436 return ( $self->CreatedObj->AsString() );
441 # {{{ LongSinceUpdateAsString
443 # TODO This should be deprecated
445 sub LongSinceUpdateAsString {
447 if ( $self->LastUpdated ) {
449 return ( $self->LastUpdatedObj->AgeAsString() );
473 #if the user is trying to modify the record
474 # TODO: document _why_ this code is here
476 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
480 my $old_val = $self->__Value($args{'Field'});
481 $self->_SetLastUpdated();
482 my $ret = $self->SUPER::_Set(
483 Field => $args{'Field'},
484 Value => $args{'Value'},
485 IsSQL => $args{'IsSQL'}
487 my ($status, $msg) = $ret->as_array();
489 # @values has two values, a status code and a message.
491 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
492 # we want to change the standard "success" message
496 "[_1] changed from [_2] to [_3]",
497 $self->loc( $args{'Field'} ),
498 ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
499 '"' . $self->__Value( $args{'Field'}) . '"'
503 $msg = $self->CurrentUser->loc_fuzzy($msg);
505 return wantarray ? ($status, $msg) : $ret;
511 # {{{ sub _SetLastUpdated
513 =head2 _SetLastUpdated
515 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
516 It takes no options. Arguably, this is a bug
520 sub _SetLastUpdated {
523 my $now = new RT::Date( $self->CurrentUser );
526 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
527 my ( $msg, $val ) = $self->__Set(
528 Field => 'LastUpdated',
532 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
533 my ( $msg, $val ) = $self->__Set(
534 Field => 'LastUpdatedBy',
535 Value => $self->CurrentUser->id
546 Returns an RT::User object with the RT account of the creator of this row
552 unless ( exists $self->{'CreatorObj'} ) {
554 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
555 $self->{'CreatorObj'}->Load( $self->Creator );
557 return ( $self->{'CreatorObj'} );
562 # {{{ sub LastUpdatedByObj
564 =head2 LastUpdatedByObj
566 Returns an RT::User object of the last user to touch this object
570 sub LastUpdatedByObj {
572 unless ( exists $self->{LastUpdatedByObj} ) {
573 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
574 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
576 return $self->{'LastUpdatedByObj'};
585 Returns this record's URI
591 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
592 return($uri->URIForObject($self));
597 =head2 ValidateName NAME
599 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
606 if ($value && $value=~ /^\d+$/) {
615 =head2 SQLType attribute
617 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
625 return ($self->_Accessible($field, 'type'));
633 my %args = ( decode_utf8 => 1, @_ );
636 $RT::Logger->error("__Value called with undef field");
639 my $value = $self->SUPER::__Value( $field );
640 if( $args{'decode_utf8'} ) {
641 return Encode::decode_utf8( $value ) unless Encode::is_utf8( $value );
643 return Encode::encode_utf8( $value ) if Encode::is_utf8( $value );
648 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
653 'cache_for_sec' => 30,
659 sub _BuildTableAttributes {
661 my $class = ref($self) || $self;
664 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
665 $attributes = $self->_CoreAccessible();
666 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
667 $attributes = $self->_ClassAccessible();
671 foreach my $column (%$attributes) {
672 foreach my $attr ( %{ $attributes->{$column} } ) {
673 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
676 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
677 next unless UNIVERSAL::can( $self, $method );
678 $attributes = $self->$method();
680 foreach my $column (%$attributes) {
681 foreach my $attr ( %{ $attributes->{$column} } ) {
682 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
689 =head2 _ClassAccessible
691 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
692 DBIx::SearchBuilder::Record
696 sub _ClassAccessible {
698 return $_TABLE_ATTR->{ref($self) || $self};
701 =head2 _Accessible COLUMN ATTRIBUTE
703 returns the value of ATTRIBUTE for COLUMN
711 my $attribute = lc(shift);
712 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
713 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
717 =head2 _EncodeLOB BODY MIME_TYPE
719 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
726 my $MIMEType = shift;
728 my $ContentEncoding = 'none';
730 #get the max attachment length from RT
731 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
733 #if the current attachment contains nulls and the
734 #database doesn't support embedded nulls
736 if ( RT->Config->Get('AlwaysUseBase64') or
737 ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
739 # set a flag telling us to mimencode the attachment
740 $ContentEncoding = 'base64';
742 #cut the max attchment size by 25% (for mime-encoding overhead.
743 $RT::Logger->debug("Max size is $MaxSize");
744 $MaxSize = $MaxSize * 3 / 4;
745 # Some databases (postgres) can't handle non-utf8 data
746 } elsif ( !$RT::Handle->BinarySafeBLOBs
747 && $MIMEType !~ /text\/plain/gi
748 && !Encode::is_utf8( $Body, 1 ) ) {
749 $ContentEncoding = 'quoted-printable';
752 #if the attachment is larger than the maximum size
753 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
755 # if we're supposed to truncate large attachments
756 if (RT->Config->Get('TruncateLongAttachments')) {
758 # truncate the attachment to that length.
759 $Body = substr( $Body, 0, $MaxSize );
763 # elsif we're supposed to drop large attachments on the floor,
764 elsif (RT->Config->Get('DropLongAttachments')) {
766 # drop the attachment on the floor
767 $RT::Logger->info( "$self: Dropped an attachment of size "
769 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
770 return ("none", "Large attachment dropped" );
774 # if we need to mimencode the attachment
775 if ( $ContentEncoding eq 'base64' ) {
777 # base64 encode the attachment
778 Encode::_utf8_off($Body);
779 $Body = MIME::Base64::encode_base64($Body);
781 } elsif ($ContentEncoding eq 'quoted-printable') {
782 Encode::_utf8_off($Body);
783 $Body = MIME::QuotedPrint::encode($Body);
787 return ($ContentEncoding, $Body);
793 my $ContentType = shift || '';
794 my $ContentEncoding = shift || 'none';
797 if ( $ContentEncoding eq 'base64' ) {
798 $Content = MIME::Base64::decode_base64($Content);
800 elsif ( $ContentEncoding eq 'quoted-printable' ) {
801 $Content = MIME::QuotedPrint::decode($Content);
803 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
804 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
806 if ( RT::I18N::IsTextualContentType($ContentType) ) {
807 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
812 # A helper table for links mapping to make it easier
813 # to build and parse links between tickets
815 use vars '%LINKDIRMAP';
818 MemberOf => { Base => 'MemberOf',
819 Target => 'HasMember', },
820 RefersTo => { Base => 'RefersTo',
821 Target => 'ReferredToBy', },
822 DependsOn => { Base => 'DependsOn',
823 Target => 'DependedOnBy', },
824 MergedInto => { Base => 'MergedInto',
825 Target => 'MergedInto', },
829 =head2 Update ARGSHASH
831 Updates fields on an object for you using the proper Set methods,
832 skipping unchanged values.
834 ARGSRef => a hashref of attributes => value for the update
835 AttributesRef => an arrayref of keys in ARGSRef that should be updated
836 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
837 when looking up values in ARGSRef
838 Bare attributes are tried before prefixed attributes
840 Returns a list of localized results of the update
849 AttributesRef => undef,
850 AttributePrefix => undef,
854 my $attributes = $args{'AttributesRef'};
855 my $ARGSRef = $args{'ARGSRef'};
858 foreach my $attribute (@$attributes) {
860 if ( defined $ARGSRef->{$attribute} ) {
861 $value = $ARGSRef->{$attribute};
864 defined( $args{'AttributePrefix'} )
866 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
869 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
876 $value =~ s/\r\n/\n/gs;
879 # If Queue is 'General', we want to resolve the queue name for
882 # This is in an eval block because $object might not exist.
883 # and might not have a Name method. But "can" won't find autoloaded
884 # items. If it fails, we don't care
886 no warnings "uninitialized";
889 my $object = $attribute . "Obj";
890 my $name = $self->$object->Name;
891 next if $name eq $value || $name eq ($value || 0);
893 next if $value eq $self->$attribute();
894 next if ($value || 0) eq $self->$attribute();
897 my $method = "Set$attribute";
898 my ( $code, $msg ) = $self->$method($value);
899 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
901 # Default to $id, but use name if we can get it.
902 my $label = $self->id;
903 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
904 # this requires model names to be loc'ed.
914 push @results, $self->loc( $prefix ) . " $label: ". $msg;
918 "[_1] could not be set to [_2].", # loc
919 "That is already the current value", # loc
920 "No value sent to _Set!\n", # loc
921 "Illegal value for [_1]", # loc
922 "The new value has been set.", # loc
923 "No column specified", # loc
924 "Immutable field", # loc
925 "Nonexistant field?", # loc
926 "Invalid data", # loc
927 "Couldn't find row", # loc
928 "Missing a primary key?: [_1]", # loc
929 "Found Object", # loc
938 # {{{ Routines dealing with Links
940 # {{{ Link Collections
946 This returns an RT::Links object which references all the tickets
947 which are 'MembersOf' this ticket
953 return ( $self->_Links( 'Target', 'MemberOf' ) );
962 This returns an RT::Links object which references all the tickets that this
963 ticket is a 'MemberOf'
969 return ( $self->_Links( 'Base', 'MemberOf' ) );
978 This returns an RT::Links object which shows all references for which this ticket is a base
984 return ( $self->_Links( 'Base', 'RefersTo' ) );
993 This returns an L<RT::Links> object which shows all references for which this ticket is a target
999 return ( $self->_Links( 'Target', 'RefersTo' ) );
1008 This returns an RT::Links object which references all the tickets that depend on this one
1014 return ( $self->_Links( 'Target', 'DependsOn' ) );
1021 =head2 HasUnresolvedDependencies
1023 Takes a paramhash of Type (default to '__any'). Returns the number of
1024 unresolved dependencies, if $self->UnresolvedDependencies returns an
1025 object with one or more members of that type. Returns false
1030 sub HasUnresolvedDependencies {
1037 my $deps = $self->UnresolvedDependencies;
1040 $deps->Limit( FIELD => 'Type',
1042 VALUE => $args{Type});
1048 if ($deps->Count > 0) {
1049 return $deps->Count;
1057 # {{{ UnresolvedDependencies
1059 =head2 UnresolvedDependencies
1061 Returns an RT::Tickets object of tickets which this ticket depends on
1062 and which have a status of new, open or stalled. (That list comes from
1063 RT::Queue->ActiveStatusArray
1068 sub UnresolvedDependencies {
1070 my $deps = RT::Tickets->new($self->CurrentUser);
1072 my @live_statuses = RT::Queue->ActiveStatusArray();
1073 foreach my $status (@live_statuses) {
1074 $deps->LimitStatus(VALUE => $status);
1076 $deps->LimitDependedOnBy($self->Id);
1084 # {{{ AllDependedOnBy
1086 =head2 AllDependedOnBy
1088 Returns an array of RT::Ticket objects which (directly or indirectly)
1089 depends on this ticket; takes an optional 'Type' argument in the param
1090 hash, which will limit returned tickets to that type, as well as cause
1091 tickets with that type to serve as 'leaf' nodes that stops the recursive
1096 sub AllDependedOnBy {
1098 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1099 Direction => 'Target', @_ );
1104 Returns an array of RT::Ticket objects which this ticket (directly or
1105 indirectly) depends on; takes an optional 'Type' argument in the param
1106 hash, which will limit returned tickets to that type, as well as cause
1107 tickets with that type to serve as 'leaf' nodes that stops the
1108 recursive dependency search.
1114 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1115 Direction => 'Base', @_ );
1118 sub _AllLinkedTickets {
1130 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1131 while (my $link = $dep->Next()) {
1132 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1133 next unless ($uri->IsLocal());
1134 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1135 next if $args{_found}{$obj->Id};
1138 $args{_found}{$obj->Id} = $obj;
1139 $obj->_AllLinkedTickets( %args, _top => 0 );
1141 elsif ($obj->Type eq $args{Type}) {
1142 $args{_found}{$obj->Id} = $obj;
1145 $obj->_AllLinkedTickets( %args, _top => 0 );
1150 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1163 This returns an RT::Links object which references all the tickets that this ticket depends on
1169 return ( $self->_Links( 'Base', 'DependsOn' ) );
1179 =head2 Links DIRECTION [TYPE]
1181 Return links (L<RT::Links>) to/from this object.
1183 DIRECTION is either 'Base' or 'Target'.
1185 TYPE is a type of links to return, it can be omitted to get
1195 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1198 my $type = shift || "";
1200 unless ( $self->{"$field$type"} ) {
1201 $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1202 # at least to myself
1203 $self->{"$field$type"}->Limit( FIELD => $field,
1204 VALUE => $self->URI,
1205 ENTRYAGGREGATOR => 'OR' );
1206 $self->{"$field$type"}->Limit( FIELD => 'Type',
1210 return ( $self->{"$field$type"} );
1217 # {{{ sub FormatType
1221 Takes a Type and returns a string that is more human readable.
1227 my %args = ( Type => '',
1230 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1231 $args{Type} =~ s/^\s+//;
1238 # {{{ sub FormatLink
1242 Takes either a Target or a Base and returns a string of human friendly text.
1248 my %args = ( Object => undef,
1252 my $text = "URI " . $args{FallBack};
1253 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1254 $text = "Ticket " . $args{Object}->id;
1265 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1267 Returns C<link id>, C<message> and C<exist> flag.
1274 my %args = ( Target => '',
1281 # Remote_link is the URI of the object that is not this ticket
1285 if ( $args{'Base'} and $args{'Target'} ) {
1286 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1287 return ( 0, $self->loc("Can't specifiy both base and target") );
1289 elsif ( $args{'Base'} ) {
1290 $args{'Target'} = $self->URI();
1291 $remote_link = $args{'Base'};
1292 $direction = 'Target';
1294 elsif ( $args{'Target'} ) {
1295 $args{'Base'} = $self->URI();
1296 $remote_link = $args{'Target'};
1297 $direction = 'Base';
1300 return ( 0, $self->loc('Either base or target must be specified') );
1303 # {{{ Check if the link already exists - we don't want duplicates
1305 my $old_link = RT::Link->new( $self->CurrentUser );
1306 $old_link->LoadByParams( Base => $args{'Base'},
1307 Type => $args{'Type'},
1308 Target => $args{'Target'} );
1309 if ( $old_link->Id ) {
1310 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1311 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1317 # Storing the link in the DB.
1318 my $link = RT::Link->new( $self->CurrentUser );
1319 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1320 Base => $args{Base},
1321 Type => $args{Type} );
1324 $RT::Logger->error("Link could not be created: ".$linkmsg);
1325 return ( 0, $self->loc("Link could not be created") );
1328 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1329 FallBack => $args{Base});
1330 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1331 FallBack => $args{Target});
1332 my $typetext = $self->FormatType(Type => $args{Type});
1334 "$basetext $typetext $targettext.";
1335 return ( $linkid, $TransString ) ;
1340 # {{{ sub _DeleteLink
1344 Delete a link. takes a paramhash of Base, Target and Type.
1345 Either Base or Target must be null. The null value will
1346 be replaced with this ticket\'s id
1359 #we want one of base and target. we don't care which
1360 #but we only want _one_
1365 if ( $args{'Base'} and $args{'Target'} ) {
1366 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1367 return ( 0, $self->loc("Can't specifiy both base and target") );
1369 elsif ( $args{'Base'} ) {
1370 $args{'Target'} = $self->URI();
1371 $remote_link = $args{'Base'};
1372 $direction = 'Target';
1374 elsif ( $args{'Target'} ) {
1375 $args{'Base'} = $self->URI();
1376 $remote_link = $args{'Target'};
1380 $RT::Logger->error("Base or Target must be specified");
1381 return ( 0, $self->loc('Either base or target must be specified') );
1384 my $link = new RT::Link( $self->CurrentUser );
1385 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1388 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1392 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1393 FallBack => $args{Base});
1394 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1395 FallBack => $args{Target});
1396 my $typetext = $self->FormatType(Type => $args{Type});
1397 my $linkid = $link->id;
1399 my $TransString = "$basetext no longer $typetext $targettext.";
1400 return ( 1, $TransString);
1403 #if it's not a link we can find
1405 $RT::Logger->debug("Couldn't find that link");
1406 return ( 0, $self->loc("Link not found") );
1414 # {{{ Routines dealing with transactions
1416 # {{{ sub _NewTransaction
1418 =head2 _NewTransaction PARAMHASH
1420 Private function to create a new RT::Transaction object for this ticket update
1424 sub _NewTransaction {
1431 OldReference => undef,
1432 NewReference => undef,
1433 ReferenceType => undef,
1437 ActivateScrips => 1,
1442 my $old_ref = $args{'OldReference'};
1443 my $new_ref = $args{'NewReference'};
1444 my $ref_type = $args{'ReferenceType'};
1445 if ($old_ref or $new_ref) {
1446 $ref_type ||= ref($old_ref) || ref($new_ref);
1448 $RT::Logger->error("Reference type not specified for transaction");
1451 $old_ref = $old_ref->Id if ref($old_ref);
1452 $new_ref = $new_ref->Id if ref($new_ref);
1455 require RT::Transaction;
1456 my $trans = new RT::Transaction( $self->CurrentUser );
1457 my ( $transaction, $msg ) = $trans->Create(
1458 ObjectId => $self->Id,
1459 ObjectType => ref($self),
1460 TimeTaken => $args{'TimeTaken'},
1461 Type => $args{'Type'},
1462 Data => $args{'Data'},
1463 Field => $args{'Field'},
1464 NewValue => $args{'NewValue'},
1465 OldValue => $args{'OldValue'},
1466 NewReference => $new_ref,
1467 OldReference => $old_ref,
1468 ReferenceType => $ref_type,
1469 MIMEObj => $args{'MIMEObj'},
1470 ActivateScrips => $args{'ActivateScrips'},
1471 CommitScrips => $args{'CommitScrips'},
1474 # Rationalize the object since we may have done things to it during the caching.
1475 $self->Load($self->Id);
1477 $RT::Logger->warning($msg) unless $transaction;
1479 $self->_SetLastUpdated;
1481 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1482 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1484 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1485 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1487 return ( $transaction, $msg, $trans );
1492 # {{{ sub Transactions
1496 Returns an RT::Transactions object of all transactions on this record object
1503 use RT::Transactions;
1504 my $transactions = RT::Transactions->new( $self->CurrentUser );
1506 #If the user has no rights, return an empty object
1507 $transactions->Limit(
1508 FIELD => 'ObjectId',
1511 $transactions->Limit(
1512 FIELD => 'ObjectType',
1513 VALUE => ref($self),
1516 return ($transactions);
1522 # {{{ Routines dealing with custom fields
1526 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1528 $cfs->SetContextObject( $self );
1529 # XXX handle multiple types properly
1530 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1531 $cfs->LimitToGlobalOrObjectId(
1532 $self->_LookupId( $self->CustomFieldLookupType )
1538 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
1543 my @classes = ($lookup =~ /RT::(\w+)-/g);
1546 foreach my $class (reverse @classes) {
1547 my $method = "${class}Obj";
1548 $object = $object->$method;
1555 =head2 CustomFieldLookupType
1557 Returns the path RT uses to figure out which custom fields apply to this object.
1561 sub CustomFieldLookupType {
1566 # {{{ AddCustomFieldValue
1568 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1570 VALUE should be a string. FIELD can be any identifier of a CustomField
1571 supported by L</LoadCustomFieldByIdentifier> method.
1573 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1574 deletes the old value.
1575 If VALUE is not a valid value for the custom field, returns
1576 (0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1577 $id is ID of created L<ObjectCustomFieldValue> object.
1581 sub AddCustomFieldValue {
1583 $self->_AddCustomFieldValue(@_);
1586 sub _AddCustomFieldValue {
1591 LargeContent => undef,
1592 ContentType => undef,
1593 RecordTransaction => 1,
1597 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1598 unless ( $cf->Id ) {
1599 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1602 my $OCFs = $self->CustomFields;
1603 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1604 unless ( $OCFs->Count ) {
1608 "Custom field [_1] does not apply to this object",
1614 # empty string is not correct value of any CF, so undef it
1615 foreach ( qw(Value LargeContent) ) {
1616 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1619 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1620 return ( 0, $self->loc("Invalid value for custom field") );
1623 # If the custom field only accepts a certain # of values, delete the existing
1624 # value and record a "changed from foo to bar" transaction
1625 unless ( $cf->UnlimitedValues ) {
1627 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1628 my $values = $cf->ValuesForObject($self);
1630 # We need to whack any old values here. In most cases, the custom field should
1631 # only have one value to delete. In the pathalogical case, this custom field
1632 # used to be a multiple and we have many values to whack....
1633 my $cf_values = $values->Count;
1635 if ( $cf_values > $cf->MaxValues ) {
1636 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1637 # execute the same code to "change" the value from old to new
1638 while ( my $value = $values->Next ) {
1640 if ( $i < $cf_values ) {
1641 my ( $val, $msg ) = $cf->DeleteValueForObject(
1643 Content => $value->Content
1648 my ( $TransactionId, $Msg, $TransactionObj ) =
1649 $self->_NewTransaction(
1650 Type => 'CustomField',
1652 OldReference => $value,
1656 $values->RedoSearch if $i; # redo search if have deleted at least one value
1659 my ( $old_value, $old_content );
1660 if ( $old_value = $values->First ) {
1661 $old_content = $old_value->Content;
1662 $old_content = undef if defined $old_content && !length $old_content;
1664 my $is_the_same = 1;
1665 if ( defined $args{'Value'} ) {
1666 $is_the_same = 0 unless defined $old_content
1667 && lc $old_content eq lc $args{'Value'};
1669 $is_the_same = 0 if defined $old_content;
1671 if ( $is_the_same ) {
1672 my $old_content = $old_value->LargeContent;
1673 if ( defined $args{'LargeContent'} ) {
1674 $is_the_same = 0 unless defined $old_content
1675 && $old_content eq $args{'LargeContent'};
1677 $is_the_same = 0 if defined $old_content;
1681 return $old_value->id if $is_the_same;
1684 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1686 Content => $args{'Value'},
1687 LargeContent => $args{'LargeContent'},
1688 ContentType => $args{'ContentType'},
1691 unless ( $new_value_id ) {
1692 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1695 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1696 $new_value->Load( $new_value_id );
1698 # now that adding the new value was successful, delete the old one
1700 my ( $val, $msg ) = $old_value->Delete();
1701 return ( 0, $msg ) unless $val;
1704 if ( $args{'RecordTransaction'} ) {
1705 my ( $TransactionId, $Msg, $TransactionObj ) =
1706 $self->_NewTransaction(
1707 Type => 'CustomField',
1709 OldReference => $old_value,
1710 NewReference => $new_value,
1714 my $new_content = $new_value->Content;
1715 unless ( defined $old_content && length $old_content ) {
1716 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1718 elsif ( !defined $new_content || !length $new_content ) {
1719 return ( $new_value_id,
1720 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1723 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1728 # otherwise, just add a new value and record "new value added"
1730 my ($new_value_id, $msg) = $cf->AddValueForObject(
1732 Content => $args{'Value'},
1733 LargeContent => $args{'LargeContent'},
1734 ContentType => $args{'ContentType'},
1737 unless ( $new_value_id ) {
1738 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1740 if ( $args{'RecordTransaction'} ) {
1741 my ( $tid, $msg ) = $self->_NewTransaction(
1742 Type => 'CustomField',
1744 NewReference => $new_value_id,
1745 ReferenceType => 'RT::ObjectCustomFieldValue',
1748 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1751 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1757 # {{{ DeleteCustomFieldValue
1759 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1761 Deletes VALUE as a value of CustomField FIELD.
1763 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1765 If VALUE is not a valid value for the custom field, returns
1766 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1770 sub DeleteCustomFieldValue {
1779 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1780 unless ( $cf->Id ) {
1781 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1784 my ( $val, $msg ) = $cf->DeleteValueForObject(
1786 Id => $args{'ValueId'},
1787 Content => $args{'Value'},
1793 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1794 Type => 'CustomField',
1796 OldReference => $val,
1797 ReferenceType => 'RT::ObjectCustomFieldValue',
1799 unless ($TransactionId) {
1800 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1806 "[_1] is no longer a value for custom field [_2]",
1807 $TransactionObj->OldValue, $cf->Name
1814 # {{{ FirstCustomFieldValue
1816 =head2 FirstCustomFieldValue FIELD
1818 Return the content of the first value of CustomField FIELD for this ticket
1819 Takes a field id or name
1823 sub FirstCustomFieldValue {
1827 my $values = $self->CustomFieldValues( $field );
1828 return undef unless my $first = $values->First;
1829 return $first->Content;
1832 =head2 CustomFieldValuesAsString FIELD
1834 Return the content of the CustomField FIELD for this ticket.
1835 If this is a multi-value custom field, values will be joined with newlines.
1837 Takes a field id or name as the first argument
1839 Takes an optional Separator => "," second and third argument
1840 if you want to join the values using something other than a newline
1844 sub CustomFieldValuesAsString {
1848 my $separator = $args{Separator} || "\n";
1850 my $values = $self->CustomFieldValues( $field );
1851 return join ($separator, grep { defined $_ }
1852 map { $_->Content } @{$values->ItemsArrayRef});
1856 # {{{ CustomFieldValues
1858 =head2 CustomFieldValues FIELD
1860 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1861 id or Name is FIELD for this record.
1863 Returns an RT::ObjectCustomFieldValues object
1867 sub CustomFieldValues {
1872 my $cf = $self->LoadCustomFieldByIdentifier( $field );
1874 # we were asked to search on a custom field we couldn't find
1875 unless ( $cf->id ) {
1876 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
1877 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1879 return ( $cf->ValuesForObject($self) );
1882 # we're not limiting to a specific custom field;
1883 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1884 $ocfs->LimitToObject( $self );
1888 =head2 LoadCustomFieldByIdentifier IDENTIFER
1890 Find the custom field has id or name IDENTIFIER for this object.
1892 If no valid field is found, returns an empty RT::CustomField object.
1896 sub LoadCustomFieldByIdentifier {
1901 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1902 $cf = RT::CustomField->new($self->CurrentUser);
1903 $cf->SetContextObject( $self );
1904 $cf->LoadById( $field->id );
1906 elsif ($field =~ /^\d+$/) {
1907 $cf = RT::CustomField->new($self->CurrentUser);
1908 $cf->SetContextObject( $self );
1909 $cf->LoadById($field);
1912 my $cfs = $self->CustomFields($self->CurrentUser);
1913 $cfs->SetContextObject( $self );
1914 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
1915 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1920 sub ACLEquivalenceObjects { }
1922 sub BasicColumns { }
1925 return RT->Config->Get('WebPath'). "/index.html?q=";
1928 eval "require RT::Record_Vendor";
1929 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
1930 eval "require RT::Record_Local";
1931 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});