1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2007 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/copyleft/gpl.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 }}}
50 RT::Record - Base class for RT record objects
60 ok (require RT::Record);
74 use base qw(RT::Base);
79 use DBIx::SearchBuilder::Record::Cachable;
82 our $_TABLE_ATTR = { };
85 if ( $RT::DontCacheSearchBuilderRecords ) {
86 push (@ISA, 'DBIx::SearchBuilder::Record');
88 push (@ISA, 'DBIx::SearchBuilder::Record::Cachable');
96 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
97 $self->CurrentUser(@_);
106 The primary keys for RT classes is 'id'
119 Delete this record object from the database.
125 my ($rv) = $self->SUPER::Delete;
127 return ($rv, $self->loc("Object deleted"));
130 return(0, $self->loc("Object could not be deleted"))
136 Returns a string which is this object's type. The type is the class,
137 without the "RT::" prefix.
141 my $ticket = RT::Ticket->new($RT::SystemUser);
142 my $group = RT::Group->new($RT::SystemUser);
143 is($ticket->ObjectTypeStr, 'Ticket', "Ticket returns correct typestring");
144 is($group->ObjectTypeStr, 'Group', "Group returns correct typestring");
152 if (ref($self) =~ /^.*::(\w+)$/) {
153 return $self->loc($1);
155 return $self->loc(ref($self));
161 Return this object's attributes as an RT::Attributes object
168 unless ($self->{'attributes'}) {
169 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
170 $self->{'attributes'}->LimitToObject($self);
172 return ($self->{'attributes'});
177 =head2 AddAttribute { Name, Description, Content }
179 Adds a new attribute for this object.
185 my %args = ( Name => undef,
186 Description => undef,
190 my $attr = RT::Attribute->new( $self->CurrentUser );
191 my ( $id, $msg ) = $attr->Create(
193 Name => $args{'Name'},
194 Description => $args{'Description'},
195 Content => $args{'Content'} );
198 # XXX TODO: Why won't RedoSearch work here?
199 $self->Attributes->_DoSearch;
205 =head2 SetAttribute { Name, Description, Content }
207 Like AddAttribute, but replaces all existing attributes with the same Name.
213 my %args = ( Name => undef,
214 Description => undef,
218 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
219 or return $self->AddAttribute( %args );
221 my $AttributeObj = pop( @AttributeObjs );
222 $_->Delete foreach @AttributeObjs;
224 $AttributeObj->SetDescription( $args{'Description'} );
225 $AttributeObj->SetContent( $args{'Content'} );
227 $self->Attributes->RedoSearch;
231 =head2 DeleteAttribute NAME
233 Deletes all attributes with the matching name for this object.
237 sub DeleteAttribute {
240 return $self->Attributes->DeleteEntry( Name => $name );
243 =head2 FirstAttribute NAME
245 Returns the first attribute with the matching name for this object (as an
246 L<RT::Attribute> object), or C<undef> if no such attributes exist.
248 Note that if there is more than one attribute with the matching name on the
249 object, the choice of which one to return is basically arbitrary. This may be
250 made well-defined in the future.
257 return ($self->Attributes->Named( $name ))[0];
264 return ($RT::Handle);
271 =head2 Create PARAMHASH
273 Takes a PARAMHASH of Column -> Value pairs.
274 If any Column has a Validate$PARAMNAME subroutine defined and the
275 value provided doesn't pass validation, this routine returns
278 If this object's table has any of the following atetributes defined as
279 'Auto', this routine will automatically fill in their values.
286 foreach my $key ( keys %attribs ) {
287 my $method = "Validate$key";
288 unless ( $self->$method( $attribs{$key} ) ) {
290 return ( 0, $self->loc('Invalid value for [_1]', $key) );
297 my $now = RT::Date->new( $self->CurrentUser );
298 $now->Set( Format => 'unix', Value => time );
299 $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
301 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
302 $attribs{'Creator'} = $self->CurrentUser->id || '0';
304 $attribs{'LastUpdated'} = $now->ISO()
305 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
307 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
308 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
310 my $id = $self->SUPER::Create(%attribs);
311 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
315 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
322 # If the object was created in the database,
323 # load it up now, so we're sure we get what the database
324 # has. Arguably, this should not be necessary, but there
325 # isn't much we can do about it.
329 return ( $id, $self->loc('Object could not be created') );
337 if (UNIVERSAL::isa('errno',$id)) {
343 $self->Load($id) if ($id);
348 return ( $id, $self->loc('Object created') );
362 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
371 # We don't want to hang onto this
372 delete $self->{'attributes'};
374 # If this database is case sensitive we need to uncase objects for
376 if ( $self->_Handle->CaseSensitive ) {
378 foreach my $key ( keys %hash ) {
380 # If we've been passed an empty value, we can't do the lookup.
381 # We don't need to explicitly downcase integers or an id.
383 || !defined( $hash{$key} )
384 || $hash{$key} =~ /^\d+$/
387 $newhash{$key} = $hash{$key};
390 my ($op, $val, $func);
391 ($key, $op, $val, $func) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key});
392 $newhash{$key}->{operator} = $op;
393 $newhash{$key}->{value} = $val;
394 $newhash{$key}->{function} = $func;
398 # We've clobbered everything we care about. bash the old hash
399 # and replace it with the new hash
402 $self->SUPER::LoadByCols(%hash);
409 # There is room for optimizations in most of those subs:
415 my $obj = new RT::Date( $self->CurrentUser );
417 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
427 my $obj = new RT::Date( $self->CurrentUser );
429 $obj->Set( Format => 'sql', Value => $self->Created );
438 # TODO: This should be deprecated
442 return ( $self->CreatedObj->AgeAsString() );
447 # {{{ LastUpdatedAsString
449 # TODO this should be deprecated
451 sub LastUpdatedAsString {
453 if ( $self->LastUpdated ) {
454 return ( $self->LastUpdatedObj->AsString() );
464 # {{{ CreatedAsString
466 # TODO This should be deprecated
468 sub CreatedAsString {
470 return ( $self->CreatedObj->AsString() );
475 # {{{ LongSinceUpdateAsString
477 # TODO This should be deprecated
479 sub LongSinceUpdateAsString {
481 if ( $self->LastUpdated ) {
483 return ( $self->LastUpdatedObj->AgeAsString() );
507 #if the user is trying to modify the record
508 # TODO: document _why_ this code is here
510 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
514 my $old_val = $self->__Value($args{'Field'});
515 $self->_SetLastUpdated();
516 my $ret = $self->SUPER::_Set(
517 Field => $args{'Field'},
518 Value => $args{'Value'},
519 IsSQL => $args{'IsSQL'}
521 my ($status, $msg) = $ret->as_array();
523 # @values has two values, a status code and a message.
525 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
526 # we want to change the standard "success" message
530 "[_1] changed from [_2] to [_3]",
532 ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
533 '"' . $self->__Value( $args{'Field'}) . '"'
537 $msg = $self->CurrentUser->loc_fuzzy($msg);
539 return wantarray ? ($status, $msg) : $ret;
545 # {{{ sub _SetLastUpdated
547 =head2 _SetLastUpdated
549 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
550 It takes no options. Arguably, this is a bug
554 sub _SetLastUpdated {
557 my $now = new RT::Date( $self->CurrentUser );
560 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
561 my ( $msg, $val ) = $self->__Set(
562 Field => 'LastUpdated',
566 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
567 my ( $msg, $val ) = $self->__Set(
568 Field => 'LastUpdatedBy',
569 Value => $self->CurrentUser->id
580 Returns an RT::User object with the RT account of the creator of this row
586 unless ( exists $self->{'CreatorObj'} ) {
588 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
589 $self->{'CreatorObj'}->Load( $self->Creator );
591 return ( $self->{'CreatorObj'} );
596 # {{{ sub LastUpdatedByObj
598 =head2 LastUpdatedByObj
600 Returns an RT::User object of the last user to touch this object
604 sub LastUpdatedByObj {
606 unless ( exists $self->{LastUpdatedByObj} ) {
607 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
608 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
610 return $self->{'LastUpdatedByObj'};
619 Returns this record's URI
625 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
626 return($uri->URIForObject($self));
631 =head2 ValidateName NAME
633 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
640 if ($value && $value=~ /^\d+$/) {
649 =head2 SQLType attribute
651 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
659 return ($self->_Accessible($field, 'type'));
668 my %args = ( decode_utf8 => 1,
671 unless (defined $field && $field) {
672 $RT::Logger->error("$self __Value called with undef field");
674 my $value = $self->SUPER::__Value($field);
676 return('') if ( !defined($value) || $value eq '');
678 if( $args{'decode_utf8'} ) {
679 # XXX: is_utf8 check should be here unless Encode bug would be fixed
680 # see http://rt.cpan.org/NoAuth/Bug.html?id=14559
681 return Encode::decode_utf8($value) unless Encode::is_utf8($value);
683 # check is_utf8 here just to be shure
684 return Encode::encode_utf8($value) if Encode::is_utf8($value);
689 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
694 'cache_for_sec' => 30,
700 sub _BuildTableAttributes {
704 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
705 $attributes = $self->_CoreAccessible();
706 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
707 $attributes = $self->_ClassAccessible();
711 foreach my $column (%$attributes) {
712 foreach my $attr ( %{ $attributes->{$column} } ) {
713 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
716 if ( UNIVERSAL::can( $self, '_OverlayAccessible' ) ) {
717 $attributes = $self->_OverlayAccessible();
719 foreach my $column (%$attributes) {
720 foreach my $attr ( %{ $attributes->{$column} } ) {
721 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
725 if ( UNIVERSAL::can( $self, '_VendorAccessible' ) ) {
726 $attributes = $self->_VendorAccessible();
728 foreach my $column (%$attributes) {
729 foreach my $attr ( %{ $attributes->{$column} } ) {
730 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
734 if ( UNIVERSAL::can( $self, '_LocalAccessible' ) ) {
735 $attributes = $self->_LocalAccessible();
737 foreach my $column (%$attributes) {
738 foreach my $attr ( %{ $attributes->{$column} } ) {
739 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
747 =head2 _ClassAccessible
749 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
750 DBIx::SearchBuilder::Record
754 sub _ClassAccessible {
756 return $_TABLE_ATTR->{ref($self)};
759 =head2 _Accessible COLUMN ATTRIBUTE
761 returns the value of ATTRIBUTE for COLUMN
769 my $attribute = lc(shift);
770 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
771 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
775 =head2 _EncodeLOB BODY MIME_TYPE
777 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
784 my $MIMEType = shift;
786 my $ContentEncoding = 'none';
788 #get the max attachment length from RT
789 my $MaxSize = $RT::MaxAttachmentSize;
791 #if the current attachment contains nulls and the
792 #database doesn't support embedded nulls
794 if ( $RT::AlwaysUseBase64 or
795 ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
797 # set a flag telling us to mimencode the attachment
798 $ContentEncoding = 'base64';
800 #cut the max attchment size by 25% (for mime-encoding overhead.
801 $RT::Logger->debug("Max size is $MaxSize\n");
802 $MaxSize = $MaxSize * 3 / 4;
803 # Some databases (postgres) can't handle non-utf8 data
804 } elsif ( !$RT::Handle->BinarySafeBLOBs
805 && $MIMEType !~ /text\/plain/gi
806 && !Encode::is_utf8( $Body, 1 ) ) {
807 $ContentEncoding = 'quoted-printable';
810 #if the attachment is larger than the maximum size
811 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
813 # if we're supposed to truncate large attachments
814 if ($RT::TruncateLongAttachments) {
816 # truncate the attachment to that length.
817 $Body = substr( $Body, 0, $MaxSize );
821 # elsif we're supposed to drop large attachments on the floor,
822 elsif ($RT::DropLongAttachments) {
824 # drop the attachment on the floor
825 $RT::Logger->info( "$self: Dropped an attachment of size "
826 . length($Body) . "\n"
827 . "It started: " . substr( $Body, 0, 60 ) . "\n"
829 return ("none", "Large attachment dropped" );
833 # if we need to mimencode the attachment
834 if ( $ContentEncoding eq 'base64' ) {
836 # base64 encode the attachment
837 Encode::_utf8_off($Body);
838 $Body = MIME::Base64::encode_base64($Body);
840 } elsif ($ContentEncoding eq 'quoted-printable') {
841 Encode::_utf8_off($Body);
842 $Body = MIME::QuotedPrint::encode($Body);
846 return ($ContentEncoding, $Body);
852 my $ContentType = shift;
853 my $ContentEncoding = shift;
856 if ( $ContentEncoding eq 'base64' ) {
857 $Content = MIME::Base64::decode_base64($Content);
859 elsif ( $ContentEncoding eq 'quoted-printable' ) {
860 $Content = MIME::QuotedPrint::decode($Content);
862 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
863 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
865 if ( RT::I18N::IsTextualContentType($ContentType) ) {
866 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
872 # A helper table for links mapping to make it easier
873 # to build and parse links between tickets
875 use vars '%LINKDIRMAP';
878 MemberOf => { Base => 'MemberOf',
879 Target => 'HasMember', },
880 RefersTo => { Base => 'RefersTo',
881 Target => 'ReferredToBy', },
882 DependsOn => { Base => 'DependsOn',
883 Target => 'DependedOnBy', },
884 MergedInto => { Base => 'MergedInto',
885 Target => 'MergedInto', },
889 =head2 Update ARGSHASH
891 Updates fields on an object for you using the proper Set methods,
892 skipping unchanged values.
894 ARGSRef => a hashref of attributes => value for the update
895 AttributesRef => an arrayref of keys in ARGSRef that should be updated
896 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
897 when looking up values in ARGSRef
898 Bare attributes are tried before prefixed attributes
900 Returns a list of localized results of the update
909 AttributesRef => undef,
910 AttributePrefix => undef,
914 my $attributes = $args{'AttributesRef'};
915 my $ARGSRef = $args{'ARGSRef'};
918 foreach my $attribute (@$attributes) {
920 if ( defined $ARGSRef->{$attribute} ) {
921 $value = $ARGSRef->{$attribute};
924 defined( $args{'AttributePrefix'} )
926 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
929 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
936 $value =~ s/\r\n/\n/gs;
939 # If Queue is 'General', we want to resolve the queue name for
942 # This is in an eval block because $object might not exist.
943 # and might not have a Name method. But "can" won't find autoloaded
944 # items. If it fails, we don't care
946 my $object = $attribute . "Obj";
947 next if ($self->$object->Name eq $value);
949 next if ( $value eq $self->$attribute() );
950 my $method = "Set$attribute";
951 my ( $code, $msg ) = $self->$method($value);
952 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
954 # Default to $id, but use name if we can get it.
955 my $label = $self->id;
956 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
957 push @results, $self->loc( "$prefix [_1]", $label ) . ': '. $msg;
961 "[_1] could not be set to [_2].", # loc
962 "That is already the current value", # loc
963 "No value sent to _Set!\n", # loc
964 "Illegal value for [_1]", # loc
965 "The new value has been set.", # loc
966 "No column specified", # loc
967 "Immutable field", # loc
968 "Nonexistant field?", # loc
969 "Invalid data", # loc
970 "Couldn't find row", # loc
971 "Missing a primary key?: [_1]", # loc
972 "Found Object", # loc
981 # {{{ Routines dealing with Links
983 # {{{ Link Collections
989 This returns an RT::Links object which references all the tickets
990 which are 'MembersOf' this ticket
996 return ( $self->_Links( 'Target', 'MemberOf' ) );
1005 This returns an RT::Links object which references all the tickets that this
1006 ticket is a 'MemberOf'
1012 return ( $self->_Links( 'Base', 'MemberOf' ) );
1021 This returns an RT::Links object which shows all references for which this ticket is a base
1027 return ( $self->_Links( 'Base', 'RefersTo' ) );
1036 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1042 return ( $self->_Links( 'Target', 'RefersTo' ) );
1051 This returns an RT::Links object which references all the tickets that depend on this one
1057 return ( $self->_Links( 'Target', 'DependsOn' ) );
1064 =head2 HasUnresolvedDependencies
1066 Takes a paramhash of Type (default to '__any'). Returns true if
1067 $self->UnresolvedDependencies returns an object with one or more members
1068 of that type. Returns false otherwise
1073 my $t1 = RT::Ticket->new($RT::SystemUser);
1074 my ($id, $trans, $msg) = $t1->Create(Subject => 'DepTest1', Queue => 'general');
1075 ok($id, "Created dep test 1 - $msg");
1077 my $t2 = RT::Ticket->new($RT::SystemUser);
1078 my ($id2, $trans, $msg2) = $t2->Create(Subject => 'DepTest2', Queue => 'general');
1079 ok($id2, "Created dep test 2 - $msg2");
1080 my $t3 = RT::Ticket->new($RT::SystemUser);
1081 my ($id3, $trans, $msg3) = $t3->Create(Subject => 'DepTest3', Queue => 'general', Type => 'approval');
1082 ok($id3, "Created dep test 3 - $msg3");
1083 my ($addid, $addmsg);
1084 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t2->id));
1085 ok ($addid, $addmsg);
1086 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t3->id));
1088 ok ($addid, $addmsg);
1089 my $link = RT::Link->new($RT::SystemUser);
1090 my ($rv, $msg) = $link->Load($addid);
1092 ok ($link->LocalTarget == $t3->id, "Link LocalTarget is correct");
1093 ok ($link->LocalBase == $t1->id, "Link LocalBase is correct");
1095 ok ($t1->HasUnresolvedDependencies, "Ticket ".$t1->Id." has unresolved deps");
1096 ok (!$t1->HasUnresolvedDependencies( Type => 'blah' ), "Ticket ".$t1->Id." has no unresolved blahs");
1097 ok ($t1->HasUnresolvedDependencies( Type => 'approval' ), "Ticket ".$t1->Id." has unresolved approvals");
1098 ok (!$t2->HasUnresolvedDependencies, "Ticket ".$t2->Id." has no unresolved deps");
1101 my ($rid, $rmsg)= $t1->Resolve();
1103 my ($rid2, $rmsg2) = $t2->Resolve();
1105 ($rid, $rmsg)= $t1->Resolve();
1107 my ($rid3,$rmsg3) = $t3->Resolve;
1109 ($rid, $rmsg)= $t1->Resolve();
1117 sub HasUnresolvedDependencies {
1124 my $deps = $self->UnresolvedDependencies;
1127 $deps->Limit( FIELD => 'Type',
1129 VALUE => $args{Type});
1135 if ($deps->Count > 0) {
1144 # {{{ UnresolvedDependencies
1146 =head2 UnresolvedDependencies
1148 Returns an RT::Tickets object of tickets which this ticket depends on
1149 and which have a status of new, open or stalled. (That list comes from
1150 RT::Queue->ActiveStatusArray
1155 sub UnresolvedDependencies {
1157 my $deps = RT::Tickets->new($self->CurrentUser);
1159 my @live_statuses = RT::Queue->ActiveStatusArray();
1160 foreach my $status (@live_statuses) {
1161 $deps->LimitStatus(VALUE => $status);
1163 $deps->LimitDependedOnBy($self->Id);
1171 # {{{ AllDependedOnBy
1173 =head2 AllDependedOnBy
1175 Returns an array of RT::Ticket objects which (directly or indirectly)
1176 depends on this ticket; takes an optional 'Type' argument in the param
1177 hash, which will limit returned tickets to that type, as well as cause
1178 tickets with that type to serve as 'leaf' nodes that stops the recursive
1183 sub AllDependedOnBy {
1185 my $dep = $self->DependedOnBy;
1193 while (my $link = $dep->Next()) {
1194 next unless ($link->BaseURI->IsLocal());
1195 next if $args{_found}{$link->BaseObj->Id};
1198 $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1199 $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1201 elsif ($link->BaseObj->Type eq $args{Type}) {
1202 $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1205 $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1210 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1223 This returns an RT::Links object which references all the tickets that this ticket depends on
1229 return ( $self->_Links( 'Base', 'DependsOn' ) );
1238 This returns an RT::Links object which references all the customers that this object is a member of.
1243 my( $self, %opt ) = @_;
1244 my $Debug = $opt{'Debug'};
1246 unless ( $self->{'Customers'} ) {
1248 $self->{'Customers'} = $self->MemberOf->Clone;
1250 $self->{'Customers'}->Limit(
1252 OPERATOR => 'STARTSWITH',
1253 VALUE => 'freeside://freeside/cust_main/',
1257 warn "->Customers method called on $self; returning ".
1258 ref($self->{'Customers'}). ' object'
1261 return $self->{'Customers'};
1268 =head2 Links DIRECTION [TYPE]
1270 Return links (L<RT::Links>) to/from this object.
1272 DIRECTION is either 'Base' or 'Target'.
1274 TYPE is a type of links to return, it can be omitted to get
1284 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1287 my $type = shift || "";
1289 unless ( $self->{"$field$type"} ) {
1290 $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1291 # at least to myself
1292 $self->{"$field$type"}->Limit( FIELD => $field,
1293 VALUE => $self->URI,
1294 ENTRYAGGREGATOR => 'OR' );
1295 $self->{"$field$type"}->Limit( FIELD => 'Type',
1299 return ( $self->{"$field$type"} );
1310 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1312 Returns C<link id>, C<message> and C<exist> flag.
1320 my %args = ( Target => '',
1327 # Remote_link is the URI of the object that is not this ticket
1331 if ( $args{'Base'} and $args{'Target'} ) {
1332 $RT::Logger->debug( "$self tried to create a link. both base and target were specified\n" );
1333 return ( 0, $self->loc("Can't specifiy both base and target") );
1335 elsif ( $args{'Base'} ) {
1336 $args{'Target'} = $self->URI();
1337 $remote_link = $args{'Base'};
1338 $direction = 'Target';
1340 elsif ( $args{'Target'} ) {
1341 $args{'Base'} = $self->URI();
1342 $remote_link = $args{'Target'};
1343 $direction = 'Base';
1346 return ( 0, $self->loc('Either base or target must be specified') );
1349 # {{{ Check if the link already exists - we don't want duplicates
1351 my $old_link = RT::Link->new( $self->CurrentUser );
1352 $old_link->LoadByParams( Base => $args{'Base'},
1353 Type => $args{'Type'},
1354 Target => $args{'Target'} );
1355 if ( $old_link->Id ) {
1356 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1357 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1363 # Storing the link in the DB.
1364 my $link = RT::Link->new( $self->CurrentUser );
1365 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1366 Base => $args{Base},
1367 Type => $args{Type} );
1370 $RT::Logger->error("Link could not be created: ".$linkmsg);
1371 return ( 0, $self->loc("Link could not be created") );
1375 "Record $args{'Base'} $args{Type} record $args{'Target'}.";
1377 return ( $linkid, $self->loc( "Link created ([_1])", $TransString ) );
1382 # {{{ sub _DeleteLink
1386 Delete a link. takes a paramhash of Base, Target and Type.
1387 Either Base or Target must be null. The null value will
1388 be replaced with this ticket\'s id
1401 #we want one of base and target. we don't care which
1402 #but we only want _one_
1407 if ( $args{'Base'} and $args{'Target'} ) {
1408 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n");
1409 return ( 0, $self->loc("Can't specifiy both base and target") );
1411 elsif ( $args{'Base'} ) {
1412 $args{'Target'} = $self->URI();
1413 $remote_link = $args{'Base'};
1414 $direction = 'Target';
1416 elsif ( $args{'Target'} ) {
1417 $args{'Base'} = $self->URI();
1418 $remote_link = $args{'Target'};
1422 $RT::Logger->error("Base or Target must be specified\n");
1423 return ( 0, $self->loc('Either base or target must be specified') );
1426 my $link = new RT::Link( $self->CurrentUser );
1427 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} . "\n" );
1430 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1434 my $linkid = $link->id;
1437 my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}.";
1438 return ( 1, $self->loc("Link deleted ([_1])", $TransString));
1441 #if it's not a link we can find
1443 $RT::Logger->debug("Couldn't find that link\n");
1444 return ( 0, $self->loc("Link not found") );
1452 # {{{ Routines dealing with transactions
1454 # {{{ sub _NewTransaction
1456 =head2 _NewTransaction PARAMHASH
1458 Private function to create a new RT::Transaction object for this ticket update
1462 sub _NewTransaction {
1469 OldReference => undef,
1470 NewReference => undef,
1471 ReferenceType => undef,
1475 ActivateScrips => 1,
1480 my $old_ref = $args{'OldReference'};
1481 my $new_ref = $args{'NewReference'};
1482 my $ref_type = $args{'ReferenceType'};
1483 if ($old_ref or $new_ref) {
1484 $ref_type ||= ref($old_ref) || ref($new_ref);
1486 $RT::Logger->error("Reference type not specified for transaction");
1489 $old_ref = $old_ref->Id if ref($old_ref);
1490 $new_ref = $new_ref->Id if ref($new_ref);
1493 require RT::Transaction;
1494 my $trans = new RT::Transaction( $self->CurrentUser );
1495 my ( $transaction, $msg ) = $trans->Create(
1496 ObjectId => $self->Id,
1497 ObjectType => ref($self),
1498 TimeTaken => $args{'TimeTaken'},
1499 Type => $args{'Type'},
1500 Data => $args{'Data'},
1501 Field => $args{'Field'},
1502 NewValue => $args{'NewValue'},
1503 OldValue => $args{'OldValue'},
1504 NewReference => $new_ref,
1505 OldReference => $old_ref,
1506 ReferenceType => $ref_type,
1507 MIMEObj => $args{'MIMEObj'},
1508 ActivateScrips => $args{'ActivateScrips'},
1509 CommitScrips => $args{'CommitScrips'},
1512 # Rationalize the object since we may have done things to it during the caching.
1513 $self->Load($self->Id);
1515 $RT::Logger->warning($msg) unless $transaction;
1517 $self->_SetLastUpdated;
1519 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1520 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1522 if ( $RT::UseTransactionBatch and $transaction ) {
1523 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1525 return ( $transaction, $msg, $trans );
1530 # {{{ sub Transactions
1534 Returns an RT::Transactions object of all transactions on this record object
1541 use RT::Transactions;
1542 my $transactions = RT::Transactions->new( $self->CurrentUser );
1544 #If the user has no rights, return an empty object
1545 $transactions->Limit(
1546 FIELD => 'ObjectId',
1549 $transactions->Limit(
1550 FIELD => 'ObjectType',
1551 VALUE => ref($self),
1554 return ($transactions);
1560 # {{{ Routines dealing with custom fields
1564 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1566 # XXX handle multiple types properly
1567 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1568 $cfs->LimitToGlobalOrObjectId(
1569 $self->_LookupId( $self->CustomFieldLookupType ) );
1574 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
1579 my @classes = ($lookup =~ /RT::(\w+)-/g);
1582 foreach my $class (reverse @classes) {
1583 my $method = "${class}Obj";
1584 $object = $object->$method;
1591 =head2 CustomFieldLookupType
1593 Returns the path RT uses to figure out which custom fields apply to this object.
1597 sub CustomFieldLookupType {
1602 #TODO Deprecated API. Destroy in 3.6
1605 $RT::Logger->warning("_LookupTypes call is deprecated at (". join(":",caller)."). Replace with CustomFieldLookupType");
1607 return($self->CustomFieldLookupType);
1611 # {{{ AddCustomFieldValue
1613 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1615 VALUE should be a string.
1616 FIELD can be a CustomField object OR a CustomField ID.
1619 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1620 deletes the old value.
1621 If VALUE is not a valid value for the custom field, returns
1622 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1626 sub AddCustomFieldValue {
1628 $self->_AddCustomFieldValue(@_);
1631 sub _AddCustomFieldValue {
1636 RecordTransaction => 1,
1640 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1642 unless ( $cf->Id ) {
1643 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1646 my $OCFs = $self->CustomFields;
1647 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1648 unless ( $OCFs->Count ) {
1652 "Custom field [_1] does not apply to this object",
1657 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1658 my $values = $cf->ValuesForObject($self);
1660 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1661 return ( 0, $self->loc("Invalid value for custom field") );
1664 # If the custom field only accepts a certain # of values, delete the existing
1665 # value and record a "changed from foo to bar" transaction
1666 unless ( $cf->UnlimitedValues) {
1668 # We need to whack any old values here. In most cases, the custom field should
1669 # only have one value to delete. In the pathalogical case, this custom field
1670 # used to be a multiple and we have many values to whack....
1671 my $cf_values = $values->Count;
1673 if ( $cf_values > $cf->MaxValues ) {
1674 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1675 # execute the same code to "change" the value from old to new
1676 while ( my $value = $values->Next ) {
1678 if ( $i < $cf_values ) {
1679 my ( $val, $msg ) = $cf->DeleteValueForObject(
1681 Content => $value->Content
1686 my ( $TransactionId, $Msg, $TransactionObj ) =
1687 $self->_NewTransaction(
1688 Type => 'CustomField',
1690 OldReference => $value,
1694 $values->RedoSearch if $i; # redo search if have deleted at least one value
1697 my ( $old_value, $old_content );
1698 if ( $old_value = $values->First ) {
1699 $old_content = $old_value->Content();
1700 return (1) if( $old_content eq $args{'Value'} && $old_value->LargeContent eq $args{'LargeContent'});;
1703 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1705 Content => $args{'Value'},
1706 LargeContent => $args{'LargeContent'},
1707 ContentType => $args{'ContentType'},
1710 unless ($new_value_id) {
1711 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) );
1714 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1715 $new_value->Load($new_value_id);
1717 # now that adding the new value was successful, delete the old one
1719 my ( $val, $msg ) = $old_value->Delete();
1725 if ( $args{'RecordTransaction'} ) {
1726 my ( $TransactionId, $Msg, $TransactionObj ) =
1727 $self->_NewTransaction(
1728 Type => 'CustomField',
1730 OldReference => $old_value,
1731 NewReference => $new_value,
1735 if ( $old_value eq '' ) {
1736 return ( 1, $self->loc( "[_1] [_2] added", $cf->Name, $new_value->Content ));
1738 elsif ( $new_value->Content eq '' ) {
1740 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) );
1743 return ( 1, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_value->Content));
1748 # otherwise, just add a new value and record "new value added"
1750 my ($new_value_id, $value_msg) = $cf->AddValueForObject(
1752 Content => $args{'Value'},
1753 LargeContent => $args{'LargeContent'},
1754 ContentType => $args{'ContentType'},
1757 unless ($new_value_id) {
1758 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) );
1760 if ( $args{'RecordTransaction'} ) {
1761 my ( $TransactionId, $Msg, $TransactionObj ) =
1762 $self->_NewTransaction(
1763 Type => 'CustomField',
1765 NewReference => $new_value_id,
1766 ReferenceType => 'RT::ObjectCustomFieldValue',
1768 unless ($TransactionId) {
1770 $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1773 return ( 1, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name));
1780 # {{{ DeleteCustomFieldValue
1782 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1784 Deletes VALUE as a value of CustomField FIELD.
1786 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1788 If VALUE is not a valid value for the custom field, returns
1789 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1793 sub DeleteCustomFieldValue {
1802 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1804 unless ( $cf->Id ) {
1805 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1807 my ( $val, $msg ) = $cf->DeleteValueForObject(
1809 Id => $args{'ValueId'},
1810 Content => $args{'Value'},
1815 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1816 Type => 'CustomField',
1818 OldReference => $val,
1819 ReferenceType => 'RT::ObjectCustomFieldValue',
1821 unless ($TransactionId) {
1822 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1828 "[_1] is no longer a value for custom field [_2]",
1829 $TransactionObj->OldValue, $cf->Name
1836 # {{{ FirstCustomFieldValue
1838 =head2 FirstCustomFieldValue FIELD
1840 Return the content of the first value of CustomField FIELD for this ticket
1841 Takes a field id or name
1845 sub FirstCustomFieldValue {
1848 my $values = $self->CustomFieldValues($field);
1849 if ($values->First) {
1850 return $values->First->Content;
1859 # {{{ CustomFieldValues
1861 =head2 CustomFieldValues FIELD
1863 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1864 id or Name is FIELD for this record.
1866 Returns an RT::ObjectCustomFieldValues object
1870 sub CustomFieldValues {
1875 my $cf = $self->LoadCustomFieldByIdentifier($field);
1877 # we were asked to search on a custom field we couldn't fine
1878 unless ( $cf->id ) {
1879 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1881 return ( $cf->ValuesForObject($self) );
1884 # we're not limiting to a specific custom field;
1885 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1886 $ocfs->LimitToObject($self);
1891 =head2 CustomField IDENTIFER
1893 Find the custom field has id or name IDENTIFIER for this object.
1895 If no valid field is found, returns an empty RT::CustomField object.
1899 sub LoadCustomFieldByIdentifier {
1903 my $cf = RT::CustomField->new($self->CurrentUser);
1905 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1906 $cf->LoadById( $field->id );
1908 elsif ($field =~ /^\d+$/) {
1909 $cf = RT::CustomField->new($self->CurrentUser);
1913 my $cfs = $self->CustomFields($self->CurrentUser);
1914 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
1915 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1931 return $RT::WebPath. "/index.html?q=";
1934 eval "require RT::Record_Vendor";
1935 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
1936 eval "require RT::Record_Local";
1937 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});