1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2005 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., 675 Mass Ave, Cambridge, MA 02139, USA.
28 # CONTRIBUTION SUBMISSION POLICY:
30 # (The following paragraph is not intended to limit the rights granted
31 # to you to modify and distribute this software under the terms of
32 # the GNU General Public License and is only of importance to you if
33 # you choose to contribute your changes and enhancements to the
34 # community by submitting them to Best Practical Solutions, LLC.)
36 # By intentionally submitting any modifications, corrections or
37 # derivatives to this work, or any other work intended for use with
38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
39 # you are the copyright holder for those contributions and you grant
40 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
41 # royalty-free, perpetual, license to use, copy, create derivative
42 # works based on those contributions, and sublicense and distribute
43 # those contributions and any derivatives thereof.
45 # END BPS TAGGED BLOCK }}}
49 RT::Record - Base class for RT record objects
59 ok (require RT::Record);
72 use DBIx::SearchBuilder::Record::Cachable;
75 use vars qw/@ISA $_TABLE_ATTR/;
79 if ($RT::DontCacheSearchBuilderRecords ) {
80 push (@ISA, 'DBIx::SearchBuilder::Record');
82 push (@ISA, 'DBIx::SearchBuilder::Record::Cachable');
90 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
91 $self->CurrentUser(@_);
100 The primary keys for RT classes is 'id'
113 Delete this record object from the database.
119 my ($rv) = $self->SUPER::Delete;
121 return ($rv, $self->loc("Object deleted"));
124 return(0, $self->loc("Object could not be deleted"))
130 Returns a string which is this object's type. The type is the class,
131 without the "RT::" prefix.
135 my $ticket = RT::Ticket->new($RT::SystemUser);
136 my $group = RT::Group->new($RT::SystemUser);
137 is($ticket->ObjectTypeStr, 'Ticket', "Ticket returns correct typestring");
138 is($group->ObjectTypeStr, 'Group', "Group returns correct typestring");
146 if (ref($self) =~ /^.*::(\w+)$/) {
147 return $self->loc($1);
149 return $self->loc(ref($self));
155 Return this object's attributes as an RT::Attributes object
162 unless ($self->{'attributes'}) {
163 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
164 $self->{'attributes'}->LimitToObject($self);
166 return ($self->{'attributes'});
171 =head2 AddAttribute { Name, Description, Content }
173 Adds a new attribute for this object.
179 my %args = ( Name => undef,
180 Description => undef,
184 my $attr = RT::Attribute->new( $self->CurrentUser );
185 my ( $id, $msg ) = $attr->Create(
187 Name => $args{'Name'},
188 Description => $args{'Description'},
189 Content => $args{'Content'} );
192 # XXX TODO: Why won't RedoSearch work here?
193 $self->Attributes->_DoSearch;
199 =head2 SetAttribute { Name, Description, Content }
201 Like AddAttribute, but replaces all existing attributes with the same Name.
207 my %args = ( Name => undef,
208 Description => undef,
212 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
213 or return $self->AddAttribute( %args );
215 my $AttributeObj = pop( @AttributeObjs );
216 $_->Delete foreach @AttributeObjs;
218 $AttributeObj->SetDescription( $args{'Description'} );
219 $AttributeObj->SetContent( $args{'Content'} );
221 $self->Attributes->RedoSearch;
225 =head2 DeleteAttribute NAME
227 Deletes all attributes with the matching name for this object.
231 sub DeleteAttribute {
234 return $self->Attributes->DeleteEntry( Name => $name );
237 =head2 FirstAttribute NAME
239 Returns the value of the first attribute with the matching name
240 for this object, or C<undef> if no such attributes exist.
247 return ($self->Attributes->Named( $name ))[0];
254 return ($RT::Handle);
261 =head2 Create PARAMHASH
263 Takes a PARAMHASH of Column -> Value pairs.
264 If any Column has a Validate$PARAMNAME subroutine defined and the
265 value provided doesn't pass validation, this routine returns
268 If this object's table has any of the following atetributes defined as
269 'Auto', this routine will automatically fill in their values.
276 foreach my $key ( keys %attribs ) {
277 my $method = "Validate$key";
278 unless ( $self->$method( $attribs{$key} ) ) {
280 return ( 0, $self->loc('Invalid value for [_1]', $key) );
287 my $now = RT::Date->new( $self->CurrentUser );
288 $now->Set( Format => 'unix', Value => time );
289 $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
291 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
292 $attribs{'Creator'} = $self->CurrentUser->id || '0';
294 $attribs{'LastUpdated'} = $now->ISO()
295 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
297 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
298 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
300 my $id = $self->SUPER::Create(%attribs);
301 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
305 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
312 # If the object was created in the database,
313 # load it up now, so we're sure we get what the database
314 # has. Arguably, this should not be necessary, but there
315 # isn't much we can do about it.
319 return ( $id, $self->loc('Object could not be created') );
327 if (UNIVERSAL::isa('errno',$id)) {
333 $self->Load($id) if ($id);
338 return ( $id, $self->loc('Object created') );
352 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
361 # We don't want to hang onto this
362 delete $self->{'attributes'};
364 # If this database is case sensitive we need to uncase objects for
366 if ( $self->_Handle->CaseSensitive ) {
368 foreach my $key ( keys %hash ) {
370 # If we've been passed an empty value, we can't do the lookup.
371 # We don't need to explicitly downcase integers or an id.
373 || !defined( $hash{$key} )
374 || $hash{$key} =~ /^\d+$/
377 $newhash{$key} = $hash{$key};
380 my ($op, $val, $func);
381 ($key, $op, $val, $func) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key});
382 $newhash{$key}->{operator} = $op;
383 $newhash{$key}->{value} = $val;
384 $newhash{$key}->{function} = $func;
388 # We've clobbered everything we care about. bash the old hash
389 # and replace it with the new hash
392 $self->SUPER::LoadByCols(%hash);
399 # There is room for optimizations in most of those subs:
405 my $obj = new RT::Date( $self->CurrentUser );
407 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
417 my $obj = new RT::Date( $self->CurrentUser );
419 $obj->Set( Format => 'sql', Value => $self->Created );
428 # TODO: This should be deprecated
432 return ( $self->CreatedObj->AgeAsString() );
437 # {{{ LastUpdatedAsString
439 # TODO this should be deprecated
441 sub LastUpdatedAsString {
443 if ( $self->LastUpdated ) {
444 return ( $self->LastUpdatedObj->AsString() );
454 # {{{ CreatedAsString
456 # TODO This should be deprecated
458 sub CreatedAsString {
460 return ( $self->CreatedObj->AsString() );
465 # {{{ LongSinceUpdateAsString
467 # TODO This should be deprecated
469 sub LongSinceUpdateAsString {
471 if ( $self->LastUpdated ) {
473 return ( $self->LastUpdatedObj->AgeAsString() );
497 #if the user is trying to modify the record
498 # TODO: document _why_ this code is here
500 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
504 my $old_val = $self->__Value($args{'Field'});
505 $self->_SetLastUpdated();
506 my $ret = $self->SUPER::_Set(
507 Field => $args{'Field'},
508 Value => $args{'Value'},
509 IsSQL => $args{'IsSQL'}
511 my ($status, $msg) = $ret->as_array();
513 # @values has two values, a status code and a message.
515 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
516 # we want to change the standard "success" message
520 "[_1] changed from [_2] to [_3]",
522 ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
523 '"' . $self->__Value( $args{'Field'}) . '"'
527 $msg = $self->CurrentUser->loc_fuzzy($msg);
529 return wantarray ? ($status, $msg) : $ret;
535 # {{{ sub _SetLastUpdated
537 =head2 _SetLastUpdated
539 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
540 It takes no options. Arguably, this is a bug
544 sub _SetLastUpdated {
547 my $now = new RT::Date( $self->CurrentUser );
550 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
551 my ( $msg, $val ) = $self->__Set(
552 Field => 'LastUpdated',
556 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
557 my ( $msg, $val ) = $self->__Set(
558 Field => 'LastUpdatedBy',
559 Value => $self->CurrentUser->id
570 Returns an RT::User object with the RT account of the creator of this row
576 unless ( exists $self->{'CreatorObj'} ) {
578 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
579 $self->{'CreatorObj'}->Load( $self->Creator );
581 return ( $self->{'CreatorObj'} );
586 # {{{ sub LastUpdatedByObj
588 =head2 LastUpdatedByObj
590 Returns an RT::User object of the last user to touch this object
594 sub LastUpdatedByObj {
596 unless ( exists $self->{LastUpdatedByObj} ) {
597 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
598 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
600 return $self->{'LastUpdatedByObj'};
609 Returns this record's URI
615 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
616 return($uri->URIForObject($self));
621 =head2 ValidateName NAME
623 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
630 if ($value && $value=~ /^\d+$/) {
639 =head2 SQLType attribute
641 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
649 return ($self->_Accessible($field, 'type'));
654 require Encode::compat if $] < 5.007001;
663 my %args = ( decode_utf8 => 1,
666 unless (defined $field && $field) {
667 $RT::Logger->error("$self __Value called with undef field");
669 my $value = $self->SUPER::__Value($field);
671 return('') if ( !defined($value) || $value eq '');
673 return Encode::decode_utf8($value) || $value if $args{'decode_utf8'};
677 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
682 'cache_for_sec' => 30,
688 sub _BuildTableAttributes {
692 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
693 $attributes = $self->_CoreAccessible();
694 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
695 $attributes = $self->_ClassAccessible();
699 foreach my $column (%$attributes) {
700 foreach my $attr ( %{ $attributes->{$column} } ) {
701 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
704 if ( UNIVERSAL::can( $self, '_OverlayAccessible' ) ) {
705 $attributes = $self->_OverlayAccessible();
707 foreach my $column (%$attributes) {
708 foreach my $attr ( %{ $attributes->{$column} } ) {
709 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
713 if ( UNIVERSAL::can( $self, '_VendorAccessible' ) ) {
714 $attributes = $self->_VendorAccessible();
716 foreach my $column (%$attributes) {
717 foreach my $attr ( %{ $attributes->{$column} } ) {
718 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
722 if ( UNIVERSAL::can( $self, '_LocalAccessible' ) ) {
723 $attributes = $self->_LocalAccessible();
725 foreach my $column (%$attributes) {
726 foreach my $attr ( %{ $attributes->{$column} } ) {
727 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
735 =head2 _ClassAccessible
737 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
738 DBIx::SearchBuilder::Record
742 sub _ClassAccessible {
744 return $_TABLE_ATTR->{ref($self)};
747 =head2 _Accessible COLUMN ATTRIBUTE
749 returns the value of ATTRIBUTE for COLUMN
757 my $attribute = lc(shift);
758 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
759 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
763 =head2 _EncodeLOB BODY MIME_TYPE
765 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
772 my $MIMEType = shift;
774 my $ContentEncoding = 'none';
776 #get the max attachment length from RT
777 my $MaxSize = $RT::MaxAttachmentSize;
779 #if the current attachment contains nulls and the
780 #database doesn't support embedded nulls
782 if ( $RT::AlwaysUseBase64 or
783 ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
785 # set a flag telling us to mimencode the attachment
786 $ContentEncoding = 'base64';
788 #cut the max attchment size by 25% (for mime-encoding overhead.
789 $RT::Logger->debug("Max size is $MaxSize\n");
790 $MaxSize = $MaxSize * 3 / 4;
791 # Some databases (postgres) can't handle non-utf8 data
792 } elsif ( !$RT::Handle->BinarySafeBLOBs
793 && $MIMEType !~ /text\/plain/gi
794 && !Encode::is_utf8( $Body, 1 ) ) {
795 $ContentEncoding = 'quoted-printable';
798 #if the attachment is larger than the maximum size
799 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
801 # if we're supposed to truncate large attachments
802 if ($RT::TruncateLongAttachments) {
804 # truncate the attachment to that length.
805 $Body = substr( $Body, 0, $MaxSize );
809 # elsif we're supposed to drop large attachments on the floor,
810 elsif ($RT::DropLongAttachments) {
812 # drop the attachment on the floor
813 $RT::Logger->info( "$self: Dropped an attachment of size " . length($Body) . "\n" . "It started: " . substr( $Body, 0, 60 ) . "\n" );
814 return ("none", "Large attachment dropped" );
818 # if we need to mimencode the attachment
819 if ( $ContentEncoding eq 'base64' ) {
821 # base64 encode the attachment
822 Encode::_utf8_off($Body);
823 $Body = MIME::Base64::encode_base64($Body);
825 } elsif ($ContentEncoding eq 'quoted-printable') {
826 Encode::_utf8_off($Body);
827 $Body = MIME::QuotedPrint::encode($Body);
831 return ($ContentEncoding, $Body);
837 my $ContentType = shift;
838 my $ContentEncoding = shift;
841 if ( $ContentEncoding eq 'base64' ) {
842 $Content = MIME::Base64::decode_base64($Content);
844 elsif ( $ContentEncoding eq 'quoted-printable' ) {
845 $Content = MIME::QuotedPrint::decode($Content);
847 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
848 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
850 if ( $ContentType eq 'text/plain' ) {
851 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
857 # A helper table for links mapping to make it easier
858 # to build and parse links between tickets
860 use vars '%LINKDIRMAP';
863 MemberOf => { Base => 'MemberOf',
864 Target => 'HasMember', },
865 RefersTo => { Base => 'RefersTo',
866 Target => 'ReferredToBy', },
867 DependsOn => { Base => 'DependsOn',
868 Target => 'DependedOnBy', },
869 MergedInto => { Base => 'MergedInto',
870 Target => 'MergedInto', },
879 AttributesRef => undef,
880 AttributePrefix => undef,
884 my $attributes = $args{'AttributesRef'};
885 my $ARGSRef = $args{'ARGSRef'};
888 foreach my $attribute (@$attributes) {
890 if ( defined $ARGSRef->{$attribute} ) {
891 $value = $ARGSRef->{$attribute};
894 defined( $args{'AttributePrefix'} )
896 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
899 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
906 $value =~ s/\r\n/\n/gs;
909 # If Queue is 'General', we want to resolve the queue name for
912 # This is in an eval block because $object might not exist.
913 # and might not have a Name method. But "can" won't find autoloaded
914 # items. If it fails, we don't care
916 my $object = $attribute . "Obj";
917 next if ($self->$object->Name eq $value);
919 next if ( $value eq $self->$attribute() );
920 my $method = "Set$attribute";
921 my ( $code, $msg ) = $self->$method($value);
922 my ($prefix) = ref($self) =~ /RT::(\w+)/;
924 # Default to $id, but use name if we can get it.
925 my $label = $self->id;
926 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
927 push @results, $self->loc( "$prefix [_1]", $label ) . ': '. $msg;
931 "[_1] could not be set to [_2].", # loc
932 "That is already the current value", # loc
933 "No value sent to _Set!\n", # loc
934 "Illegal value for [_1]", # loc
935 "The new value has been set.", # loc
936 "No column specified", # loc
937 "Immutable field", # loc
938 "Nonexistant field?", # loc
939 "Invalid data", # loc
940 "Couldn't find row", # loc
941 "Missing a primary key?: [_1]", # loc
942 "Found Object", # loc
951 # {{{ Routines dealing with Links
953 # {{{ Link Collections
959 This returns an RT::Links object which references all the tickets
960 which are 'MembersOf' this ticket
966 return ( $self->_Links( 'Target', 'MemberOf' ) );
975 This returns an RT::Links object which references all the tickets that this
976 ticket is a 'MemberOf'
982 return ( $self->_Links( 'Base', 'MemberOf' ) );
991 This returns an RT::Links object which shows all references for which this ticket is a base
997 return ( $self->_Links( 'Base', 'RefersTo' ) );
1006 This returns an RT::Links object which shows all references for which this ticket is a target
1012 return ( $self->_Links( 'Target', 'RefersTo' ) );
1021 This returns an RT::Links object which references all the tickets that depend on this one
1027 return ( $self->_Links( 'Target', 'DependsOn' ) );
1034 =head2 HasUnresolvedDependencies
1036 Takes a paramhash of Type (default to '__any'). Returns true if
1037 $self->UnresolvedDependencies returns an object with one or more members
1038 of that type. Returns false otherwise
1043 my $t1 = RT::Ticket->new($RT::SystemUser);
1044 my ($id, $trans, $msg) = $t1->Create(Subject => 'DepTest1', Queue => 'general');
1045 ok($id, "Created dep test 1 - $msg");
1047 my $t2 = RT::Ticket->new($RT::SystemUser);
1048 my ($id2, $trans, $msg2) = $t2->Create(Subject => 'DepTest2', Queue => 'general');
1049 ok($id2, "Created dep test 2 - $msg2");
1050 my $t3 = RT::Ticket->new($RT::SystemUser);
1051 my ($id3, $trans, $msg3) = $t3->Create(Subject => 'DepTest3', Queue => 'general', Type => 'approval');
1052 ok($id3, "Created dep test 3 - $msg3");
1053 my ($addid, $addmsg);
1054 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t2->id));
1055 ok ($addid, $addmsg);
1056 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t3->id));
1058 ok ($addid, $addmsg);
1059 my $link = RT::Link->new($RT::SystemUser);
1060 my ($rv, $msg) = $link->Load($addid);
1062 ok ($link->LocalTarget == $t3->id, "Link LocalTarget is correct");
1063 ok ($link->LocalBase == $t1->id, "Link LocalBase is correct");
1065 ok ($t1->HasUnresolvedDependencies, "Ticket ".$t1->Id." has unresolved deps");
1066 ok (!$t1->HasUnresolvedDependencies( Type => 'blah' ), "Ticket ".$t1->Id." has no unresolved blahs");
1067 ok ($t1->HasUnresolvedDependencies( Type => 'approval' ), "Ticket ".$t1->Id." has unresolved approvals");
1068 ok (!$t2->HasUnresolvedDependencies, "Ticket ".$t2->Id." has no unresolved deps");
1071 my ($rid, $rmsg)= $t1->Resolve();
1073 my ($rid2, $rmsg2) = $t2->Resolve();
1075 ($rid, $rmsg)= $t1->Resolve();
1077 my ($rid3,$rmsg3) = $t3->Resolve;
1079 ($rid, $rmsg)= $t1->Resolve();
1087 sub HasUnresolvedDependencies {
1094 my $deps = $self->UnresolvedDependencies;
1097 $deps->Limit( FIELD => 'Type',
1099 VALUE => $args{Type});
1105 if ($deps->Count > 0) {
1114 # {{{ UnresolvedDependencies
1116 =head2 UnresolvedDependencies
1118 Returns an RT::Tickets object of tickets which this ticket depends on
1119 and which have a status of new, open or stalled. (That list comes from
1120 RT::Queue->ActiveStatusArray
1125 sub UnresolvedDependencies {
1127 my $deps = RT::Tickets->new($self->CurrentUser);
1129 my @live_statuses = RT::Queue->ActiveStatusArray();
1130 foreach my $status (@live_statuses) {
1131 $deps->LimitStatus(VALUE => $status);
1133 $deps->LimitDependedOnBy($self->Id);
1141 # {{{ AllDependedOnBy
1143 =head2 AllDependedOnBy
1145 Returns an array of RT::Ticket objects which (directly or indirectly)
1146 depends on this ticket; takes an optional 'Type' argument in the param
1147 hash, which will limit returned tickets to that type, as well as cause
1148 tickets with that type to serve as 'leaf' nodes that stops the recursive
1153 sub AllDependedOnBy {
1155 my $dep = $self->DependedOnBy;
1163 while (my $link = $dep->Next()) {
1164 next unless ($link->BaseURI->IsLocal());
1165 next if $args{_found}{$link->BaseObj->Id};
1168 $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1169 $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1171 elsif ($link->BaseObj->Type eq $args{Type}) {
1172 $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1175 $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1180 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1193 This returns an RT::Links object which references all the tickets that this ticket depends on
1199 return ( $self->_Links( 'Base', 'DependsOn' ) );
1209 =head2 Links DIRECTION TYPE
1211 return links to/from this object.
1220 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1223 my $type = shift || "";
1225 unless ( $self->{"$field$type"} ) {
1226 $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1227 # at least to myself
1228 $self->{"$field$type"}->Limit( FIELD => $field,
1229 VALUE => $self->URI,
1230 ENTRYAGGREGATOR => 'OR' );
1231 $self->{"$field$type"}->Limit( FIELD => 'Type',
1235 return ( $self->{"$field$type"} );
1246 Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket.
1254 my %args = ( Target => '',
1261 # Remote_link is the URI of the object that is not this ticket
1265 if ( $args{'Base'} and $args{'Target'} ) {
1266 $RT::Logger->debug( "$self tried to create a link. both base and target were specified\n" );
1267 return ( 0, $self->loc("Can't specifiy both base and target") );
1269 elsif ( $args{'Base'} ) {
1270 $args{'Target'} = $self->URI();
1271 my $class = ref($self);
1272 $remote_link = $args{'Base'};
1273 $direction = 'Target';
1275 elsif ( $args{'Target'} ) {
1276 $args{'Base'} = $self->URI();
1277 my $class = ref($self);
1278 $remote_link = $args{'Target'};
1279 $direction = 'Base';
1282 return ( 0, $self->loc('Either base or target must be specified') );
1285 # {{{ Check if the link already exists - we don't want duplicates
1287 my $old_link = RT::Link->new( $self->CurrentUser );
1288 $old_link->LoadByParams( Base => $args{'Base'},
1289 Type => $args{'Type'},
1290 Target => $args{'Target'} );
1291 if ( $old_link->Id ) {
1292 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1293 return ( $old_link->id, $self->loc("Link already exists"), 0 );
1299 # Storing the link in the DB.
1300 my $link = RT::Link->new( $self->CurrentUser );
1301 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1302 Base => $args{Base},
1303 Type => $args{Type} );
1306 $RT::Logger->error("Link could not be created: ".$linkmsg);
1307 return ( 0, $self->loc("Link could not be created") );
1311 "Record $args{'Base'} $args{Type} record $args{'Target'}.";
1313 return ( $linkid, $self->loc( "Link created ([_1])", $TransString ) );
1318 # {{{ sub _DeleteLink
1322 Delete a link. takes a paramhash of Base, Target and Type.
1323 Either Base or Target must be null. The null value will
1324 be replaced with this ticket\'s id
1337 #we want one of base and target. we don't care which
1338 #but we only want _one_
1343 if ( $args{'Base'} and $args{'Target'} ) {
1344 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n");
1345 return ( 0, $self->loc("Can't specifiy both base and target") );
1347 elsif ( $args{'Base'} ) {
1348 $args{'Target'} = $self->URI();
1349 $remote_link = $args{'Base'};
1350 $direction = 'Target';
1352 elsif ( $args{'Target'} ) {
1353 $args{'Base'} = $self->URI();
1354 $remote_link = $args{'Target'};
1358 $RT::Logger->debug("$self: Base or Target must be specified\n");
1359 return ( 0, $self->loc('Either base or target must be specified') );
1362 my $link = new RT::Link( $self->CurrentUser );
1363 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} . "\n" );
1366 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1370 my $linkid = $link->id;
1373 my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}.";
1374 return ( 1, $self->loc("Link deleted ([_1])", $TransString));
1377 #if it's not a link we can find
1379 $RT::Logger->debug("Couldn't find that link\n");
1380 return ( 0, $self->loc("Link not found") );
1388 # {{{ Routines dealing with transactions
1390 # {{{ sub _NewTransaction
1392 =head2 _NewTransaction PARAMHASH
1394 Private function to create a new RT::Transaction object for this ticket update
1398 sub _NewTransaction {
1405 OldReference => undef,
1406 NewReference => undef,
1407 ReferenceType => undef,
1411 ActivateScrips => 1,
1416 my $old_ref = $args{'OldReference'};
1417 my $new_ref = $args{'NewReference'};
1418 my $ref_type = $args{'ReferenceType'};
1419 if ($old_ref or $new_ref) {
1420 $ref_type ||= ref($old_ref) || ref($new_ref);
1422 $RT::Logger->error("Reference type not specified for transaction");
1425 $old_ref = $old_ref->Id if ref($old_ref);
1426 $new_ref = $new_ref->Id if ref($new_ref);
1429 require RT::Transaction;
1430 my $trans = new RT::Transaction( $self->CurrentUser );
1431 my ( $transaction, $msg ) = $trans->Create(
1432 ObjectId => $self->Id,
1433 ObjectType => ref($self),
1434 TimeTaken => $args{'TimeTaken'},
1435 Type => $args{'Type'},
1436 Data => $args{'Data'},
1437 Field => $args{'Field'},
1438 NewValue => $args{'NewValue'},
1439 OldValue => $args{'OldValue'},
1440 NewReference => $new_ref,
1441 OldReference => $old_ref,
1442 ReferenceType => $ref_type,
1443 MIMEObj => $args{'MIMEObj'},
1444 ActivateScrips => $args{'ActivateScrips'},
1445 CommitScrips => $args{'CommitScrips'},
1448 # Rationalize the object since we may have done things to it during the caching.
1449 $self->Load($self->Id);
1451 $RT::Logger->warning($msg) unless $transaction;
1453 $self->_SetLastUpdated;
1455 if ( defined $args{'TimeTaken'} ) {
1456 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1458 if ( $RT::UseTransactionBatch and $transaction ) {
1459 push @{$self->{_TransactionBatch}}, $trans;
1461 return ( $transaction, $msg, $trans );
1466 # {{{ sub Transactions
1470 Returns an RT::Transactions object of all transactions on this record object
1477 use RT::Transactions;
1478 my $transactions = RT::Transactions->new( $self->CurrentUser );
1480 #If the user has no rights, return an empty object
1481 $transactions->Limit(
1482 FIELD => 'ObjectId',
1485 $transactions->Limit(
1486 FIELD => 'ObjectType',
1487 VALUE => ref($self),
1490 return ($transactions);
1496 # {{{ Routines dealing with custom fields
1500 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1502 # XXX handle multiple types properly
1503 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1504 $cfs->LimitToGlobalOrObjectId(
1505 $self->_LookupId( $self->CustomFieldLookupType ) );
1510 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
1515 my @classes = ($lookup =~ /RT::(\w+)-/g);
1518 foreach my $class (reverse @classes) {
1519 my $method = "${class}Obj";
1520 $object = $object->$method;
1527 =head2 CustomFieldLookupType
1529 Returns the path RT uses to figure out which custom fields apply to this object.
1533 sub CustomFieldLookupType {
1538 #TODO Deprecated API. Destroy in 3.6
1541 $RT::Logger->warning("_LookupTypes call is deprecated. Replace with CustomFieldLookupType");
1542 $RT::Logger->warning("Besides, it was a private API. Were you doing using it?");
1544 return($self->CustomFieldLookupType);
1548 # {{{ AddCustomFieldValue
1550 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1552 VALUE should be a string.
1553 FIELD can be a CustomField object OR a CustomField ID.
1556 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1557 deletes the old value.
1558 If VALUE is not a valid value for the custom field, returns
1559 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1563 sub AddCustomFieldValue {
1565 $self->_AddCustomFieldValue(@_);
1568 sub _AddCustomFieldValue {
1573 RecordTransaction => 1,
1577 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1579 unless ( $cf->Id ) {
1580 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1583 my $OCFs = $self->CustomFields;
1584 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1585 unless ( $OCFs->Count ) {
1589 "Custom field [_1] does not apply to this object",
1594 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1595 my $values = $cf->ValuesForObject($self);
1597 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1598 return ( 0, $self->loc("Invalid value for custom field") );
1601 # If the custom field only accepts a certain # of values, delete the existing
1602 # value and record a "changed from foo to bar" transaction
1603 unless ( $cf->UnlimitedValues) {
1605 # We need to whack any old values here. In most cases, the custom field should
1606 # only have one value to delete. In the pathalogical case, this custom field
1607 # used to be a multiple and we have many values to whack....
1608 my $cf_values = $values->Count;
1610 if ( $cf_values > $cf->MaxValues ) {
1611 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1612 # execute the same code to "change" the value from old to new
1613 while ( my $value = $values->Next ) {
1615 if ( $i < $cf_values ) {
1616 my ( $val, $msg ) = $cf->DeleteValueForObject(
1618 Content => $value->Content
1623 my ( $TransactionId, $Msg, $TransactionObj ) =
1624 $self->_NewTransaction(
1625 Type => 'CustomField',
1627 OldReference => $value,
1633 my ( $old_value, $old_content );
1634 if ( $old_value = $cf->ValuesForObject($self)->First ) {
1635 $old_content = $old_value->Content();
1636 return (1) if( $old_content eq $args{'Value'} && $old_value->LargeContent eq $args{'LargeContent'});;
1639 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1641 Content => $args{'Value'},
1642 LargeContent => $args{'LargeContent'},
1643 ContentType => $args{'ContentType'},
1646 unless ($new_value_id) {
1647 return ( 0, $self->loc( "Could not add new custom field value. [_1] ",, $value_msg));
1650 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1651 $new_value->Load($new_value_id);
1653 # now that adding the new value was successful, delete the old one
1655 my ( $val, $msg ) = $old_value->Delete();
1661 if ( $args{'RecordTransaction'} ) {
1662 my ( $TransactionId, $Msg, $TransactionObj ) =
1663 $self->_NewTransaction(
1664 Type => 'CustomField',
1666 OldReference => $old_value,
1667 NewReference => $new_value,
1671 if ( $old_value eq '' ) {
1672 return ( 1, $self->loc( "[_1] [_2] added", $cf->Name, $new_value->Content ));
1674 elsif ( $new_value->Content eq '' ) {
1676 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) );
1679 return ( 1, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_value->Content));
1684 # otherwise, just add a new value and record "new value added"
1686 my ($new_value_id) = $cf->AddValueForObject(
1688 Content => $args{'Value'},
1689 LargeContent => $args{'LargeContent'},
1690 ContentType => $args{'ContentType'},
1693 unless ($new_value_id) {
1694 return ( 0, $self->loc("Could not add new custom field value. ") );
1696 if ( $args{'RecordTransaction'} ) {
1697 my ( $TransactionId, $Msg, $TransactionObj ) =
1698 $self->_NewTransaction(
1699 Type => 'CustomField',
1701 NewReference => $new_value_id,
1702 ReferenceType => 'RT::ObjectCustomFieldValue',
1704 unless ($TransactionId) {
1706 $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1709 return ( 1, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name));
1716 # {{{ DeleteCustomFieldValue
1718 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1720 Deletes VALUE as a value of CustomField FIELD.
1722 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1724 If VALUE is not a valid value for the custom field, returns
1725 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1729 sub DeleteCustomFieldValue {
1738 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1740 unless ( $cf->Id ) {
1741 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1743 my ( $val, $msg ) = $cf->DeleteValueForObject(
1745 Id => $args{'ValueId'},
1746 Content => $args{'Value'},
1751 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1752 Type => 'CustomField',
1754 OldReference => $val,
1755 ReferenceType => 'RT::ObjectCustomFieldValue',
1757 unless ($TransactionId) {
1758 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1764 "[_1] is no longer a value for custom field [_2]",
1765 $TransactionObj->OldValue, $cf->Name
1772 # {{{ FirstCustomFieldValue
1774 =head2 FirstCustomFieldValue FIELD
1776 Return the content of the first value of CustomField FIELD for this ticket
1777 Takes a field id or name
1781 sub FirstCustomFieldValue {
1784 my $values = $self->CustomFieldValues($field);
1785 if ($values->First) {
1786 return $values->First->Content;
1795 # {{{ CustomFieldValues
1797 =head2 CustomFieldValues FIELD
1799 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1800 id or Name is FIELD for this record.
1802 Returns an RT::ObjectCustomFieldValues object
1806 sub CustomFieldValues {
1811 my $cf = $self->LoadCustomFieldByIdentifier($field);
1813 # we were asked to search on a custom field we couldn't fine
1814 unless ( $cf->id ) {
1815 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1817 return ( $cf->ValuesForObject($self) );
1820 # we're not limiting to a specific custom field;
1821 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1822 $ocfs->LimitToObject($self);
1827 =head2 CustomField IDENTIFER
1829 Find the custom field has id or name IDENTIFIER for this object.
1831 If no valid field is found, returns an empty RT::CustomField object.
1835 sub LoadCustomFieldByIdentifier {
1839 my $cf = RT::CustomField->new($self->CurrentUser);
1841 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1842 $cf->LoadById( $field->id );
1844 elsif ($field =~ /^\d+$/) {
1845 $cf = RT::CustomField->new($self->CurrentUser);
1849 my $cfs = $self->CustomFields($self->CurrentUser);
1850 $cfs->Limit(FIELD => 'Name', VALUE => $field);
1851 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1866 eval "require RT::Record_Vendor";
1867 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
1868 eval "require RT::Record_Local";
1869 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});