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);
80 use DBIx::SearchBuilder::Record::Cachable;
83 our $_TABLE_ATTR = { };
86 if ( $RT::DontCacheSearchBuilderRecords ) {
87 push (@ISA, 'DBIx::SearchBuilder::Record');
89 push (@ISA, 'DBIx::SearchBuilder::Record::Cachable');
97 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
98 $self->CurrentUser(@_);
107 The primary keys for RT classes is 'id'
120 Delete this record object from the database.
126 my ($rv) = $self->SUPER::Delete;
128 return ($rv, $self->loc("Object deleted"));
131 return(0, $self->loc("Object could not be deleted"))
137 Returns a string which is this object's type. The type is the class,
138 without the "RT::" prefix.
142 my $ticket = RT::Ticket->new($RT::SystemUser);
143 my $group = RT::Group->new($RT::SystemUser);
144 is($ticket->ObjectTypeStr, 'Ticket', "Ticket returns correct typestring");
145 is($group->ObjectTypeStr, 'Group', "Group returns correct typestring");
153 if (ref($self) =~ /^.*::(\w+)$/) {
154 return $self->loc($1);
156 return $self->loc(ref($self));
162 Return this object's attributes as an RT::Attributes object
169 unless ($self->{'attributes'}) {
170 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
171 $self->{'attributes'}->LimitToObject($self);
173 return ($self->{'attributes'});
178 =head2 AddAttribute { Name, Description, Content }
180 Adds a new attribute for this object.
186 my %args = ( Name => undef,
187 Description => undef,
191 my $attr = RT::Attribute->new( $self->CurrentUser );
192 my ( $id, $msg ) = $attr->Create(
194 Name => $args{'Name'},
195 Description => $args{'Description'},
196 Content => $args{'Content'} );
199 # XXX TODO: Why won't RedoSearch work here?
200 $self->Attributes->_DoSearch;
206 =head2 SetAttribute { Name, Description, Content }
208 Like AddAttribute, but replaces all existing attributes with the same Name.
214 my %args = ( Name => undef,
215 Description => undef,
219 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
220 or return $self->AddAttribute( %args );
222 my $AttributeObj = pop( @AttributeObjs );
223 $_->Delete foreach @AttributeObjs;
225 $AttributeObj->SetDescription( $args{'Description'} );
226 $AttributeObj->SetContent( $args{'Content'} );
228 $self->Attributes->RedoSearch;
232 =head2 DeleteAttribute NAME
234 Deletes all attributes with the matching name for this object.
238 sub DeleteAttribute {
241 return $self->Attributes->DeleteEntry( Name => $name );
244 =head2 FirstAttribute NAME
246 Returns the first attribute with the matching name for this object (as an
247 L<RT::Attribute> object), or C<undef> if no such attributes exist.
249 Note that if there is more than one attribute with the matching name on the
250 object, the choice of which one to return is basically arbitrary. This may be
251 made well-defined in the future.
258 return ($self->Attributes->Named( $name ))[0];
265 return ($RT::Handle);
272 =head2 Create PARAMHASH
274 Takes a PARAMHASH of Column -> Value pairs.
275 If any Column has a Validate$PARAMNAME subroutine defined and the
276 value provided doesn't pass validation, this routine returns
279 If this object's table has any of the following atetributes defined as
280 'Auto', this routine will automatically fill in their values.
287 foreach my $key ( keys %attribs ) {
288 my $method = "Validate$key";
289 unless ( $self->$method( $attribs{$key} ) ) {
291 return ( 0, $self->loc('Invalid value for [_1]', $key) );
298 my $now = RT::Date->new( $self->CurrentUser );
299 $now->Set( Format => 'unix', Value => time );
300 $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
302 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
303 $attribs{'Creator'} = $self->CurrentUser->id || '0';
305 $attribs{'LastUpdated'} = $now->ISO()
306 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
308 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
309 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
311 my $id = $self->SUPER::Create(%attribs);
312 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
316 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
323 # If the object was created in the database,
324 # load it up now, so we're sure we get what the database
325 # has. Arguably, this should not be necessary, but there
326 # isn't much we can do about it.
330 return ( $id, $self->loc('Object could not be created') );
338 if (UNIVERSAL::isa('errno',$id)) {
344 $self->Load($id) if ($id);
349 return ( $id, $self->loc('Object created') );
363 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
372 # We don't want to hang onto this
373 delete $self->{'attributes'};
375 # If this database is case sensitive we need to uncase objects for
377 if ( $self->_Handle->CaseSensitive ) {
379 foreach my $key ( keys %hash ) {
381 # If we've been passed an empty value, we can't do the lookup.
382 # We don't need to explicitly downcase integers or an id.
384 || !defined( $hash{$key} )
385 || $hash{$key} =~ /^\d+$/
388 $newhash{$key} = $hash{$key};
391 my ($op, $val, $func);
392 ($key, $op, $val, $func) = $self->_Handle->_MakeClauseCaseInsensitive($key, '=', $hash{$key});
393 $newhash{$key}->{operator} = $op;
394 $newhash{$key}->{value} = $val;
395 $newhash{$key}->{function} = $func;
399 # We've clobbered everything we care about. bash the old hash
400 # and replace it with the new hash
403 $self->SUPER::LoadByCols(%hash);
410 # There is room for optimizations in most of those subs:
416 my $obj = new RT::Date( $self->CurrentUser );
418 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
428 my $obj = new RT::Date( $self->CurrentUser );
430 $obj->Set( Format => 'sql', Value => $self->Created );
439 # TODO: This should be deprecated
443 return ( $self->CreatedObj->AgeAsString() );
448 # {{{ LastUpdatedAsString
450 # TODO this should be deprecated
452 sub LastUpdatedAsString {
454 if ( $self->LastUpdated ) {
455 return ( $self->LastUpdatedObj->AsString() );
465 # {{{ CreatedAsString
467 # TODO This should be deprecated
469 sub CreatedAsString {
471 return ( $self->CreatedObj->AsString() );
476 # {{{ LongSinceUpdateAsString
478 # TODO This should be deprecated
480 sub LongSinceUpdateAsString {
482 if ( $self->LastUpdated ) {
484 return ( $self->LastUpdatedObj->AgeAsString() );
508 #if the user is trying to modify the record
509 # TODO: document _why_ this code is here
511 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
515 my $old_val = $self->__Value($args{'Field'});
516 $self->_SetLastUpdated();
517 my $ret = $self->SUPER::_Set(
518 Field => $args{'Field'},
519 Value => $args{'Value'},
520 IsSQL => $args{'IsSQL'}
522 my ($status, $msg) = $ret->as_array();
524 # @values has two values, a status code and a message.
526 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
527 # we want to change the standard "success" message
531 "[_1] changed from [_2] to [_3]",
533 ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
534 '"' . $self->__Value( $args{'Field'}) . '"'
538 $msg = $self->CurrentUser->loc_fuzzy($msg);
540 return wantarray ? ($status, $msg) : $ret;
546 # {{{ sub _SetLastUpdated
548 =head2 _SetLastUpdated
550 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
551 It takes no options. Arguably, this is a bug
555 sub _SetLastUpdated {
558 my $now = new RT::Date( $self->CurrentUser );
561 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
562 my ( $msg, $val ) = $self->__Set(
563 Field => 'LastUpdated',
567 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
568 my ( $msg, $val ) = $self->__Set(
569 Field => 'LastUpdatedBy',
570 Value => $self->CurrentUser->id
581 Returns an RT::User object with the RT account of the creator of this row
587 unless ( exists $self->{'CreatorObj'} ) {
589 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
590 $self->{'CreatorObj'}->Load( $self->Creator );
592 return ( $self->{'CreatorObj'} );
597 # {{{ sub LastUpdatedByObj
599 =head2 LastUpdatedByObj
601 Returns an RT::User object of the last user to touch this object
605 sub LastUpdatedByObj {
607 unless ( exists $self->{LastUpdatedByObj} ) {
608 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
609 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
611 return $self->{'LastUpdatedByObj'};
620 Returns this record's URI
626 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
627 return($uri->URIForObject($self));
632 =head2 ValidateName NAME
634 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
641 if ($value && $value=~ /^\d+$/) {
650 =head2 SQLType attribute
652 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
660 return ($self->_Accessible($field, 'type'));
669 my %args = ( decode_utf8 => 1,
672 unless (defined $field && $field) {
673 $RT::Logger->error("$self __Value called with undef field");
675 my $value = $self->SUPER::__Value($field);
677 return('') if ( !defined($value) || $value eq '');
679 if( $args{'decode_utf8'} ) {
680 # XXX: is_utf8 check should be here unless Encode bug would be fixed
681 # see http://rt.cpan.org/NoAuth/Bug.html?id=14559
682 return Encode::decode_utf8($value) unless Encode::is_utf8($value);
684 # check is_utf8 here just to be shure
685 return Encode::encode_utf8($value) if Encode::is_utf8($value);
690 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
695 'cache_for_sec' => 30,
701 sub _BuildTableAttributes {
705 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
706 $attributes = $self->_CoreAccessible();
707 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
708 $attributes = $self->_ClassAccessible();
712 foreach my $column (%$attributes) {
713 foreach my $attr ( %{ $attributes->{$column} } ) {
714 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
717 if ( UNIVERSAL::can( $self, '_OverlayAccessible' ) ) {
718 $attributes = $self->_OverlayAccessible();
720 foreach my $column (%$attributes) {
721 foreach my $attr ( %{ $attributes->{$column} } ) {
722 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
726 if ( UNIVERSAL::can( $self, '_VendorAccessible' ) ) {
727 $attributes = $self->_VendorAccessible();
729 foreach my $column (%$attributes) {
730 foreach my $attr ( %{ $attributes->{$column} } ) {
731 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
735 if ( UNIVERSAL::can( $self, '_LocalAccessible' ) ) {
736 $attributes = $self->_LocalAccessible();
738 foreach my $column (%$attributes) {
739 foreach my $attr ( %{ $attributes->{$column} } ) {
740 $_TABLE_ATTR->{ref($self)}->{$column}->{$attr} = $attributes->{$column}->{$attr};
748 =head2 _ClassAccessible
750 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
751 DBIx::SearchBuilder::Record
755 sub _ClassAccessible {
757 return $_TABLE_ATTR->{ref($self)};
760 =head2 _Accessible COLUMN ATTRIBUTE
762 returns the value of ATTRIBUTE for COLUMN
770 my $attribute = lc(shift);
771 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
772 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
776 =head2 _EncodeLOB BODY MIME_TYPE
778 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
785 my $MIMEType = shift;
787 my $ContentEncoding = 'none';
789 #get the max attachment length from RT
790 my $MaxSize = $RT::MaxAttachmentSize;
792 #if the current attachment contains nulls and the
793 #database doesn't support embedded nulls
795 if ( $RT::AlwaysUseBase64 or
796 ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
798 # set a flag telling us to mimencode the attachment
799 $ContentEncoding = 'base64';
801 #cut the max attchment size by 25% (for mime-encoding overhead.
802 $RT::Logger->debug("Max size is $MaxSize\n");
803 $MaxSize = $MaxSize * 3 / 4;
804 # Some databases (postgres) can't handle non-utf8 data
805 } elsif ( !$RT::Handle->BinarySafeBLOBs
806 && $MIMEType !~ /text\/plain/gi
807 && !Encode::is_utf8( $Body, 1 ) ) {
808 $ContentEncoding = 'quoted-printable';
811 #if the attachment is larger than the maximum size
812 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
814 # if we're supposed to truncate large attachments
815 if ($RT::TruncateLongAttachments) {
817 # truncate the attachment to that length.
818 $Body = substr( $Body, 0, $MaxSize );
822 # elsif we're supposed to drop large attachments on the floor,
823 elsif ($RT::DropLongAttachments) {
825 # drop the attachment on the floor
826 $RT::Logger->info( "$self: Dropped an attachment of size "
827 . length($Body) . "\n"
828 . "It started: " . substr( $Body, 0, 60 ) . "\n"
830 return ("none", "Large attachment dropped" );
834 # if we need to mimencode the attachment
835 if ( $ContentEncoding eq 'base64' ) {
837 # base64 encode the attachment
838 Encode::_utf8_off($Body);
839 $Body = MIME::Base64::encode_base64($Body);
841 } elsif ($ContentEncoding eq 'quoted-printable') {
842 Encode::_utf8_off($Body);
843 $Body = MIME::QuotedPrint::encode($Body);
847 return ($ContentEncoding, $Body);
853 my $ContentType = shift;
854 my $ContentEncoding = shift;
857 if ( $ContentEncoding eq 'base64' ) {
858 $Content = MIME::Base64::decode_base64($Content);
860 elsif ( $ContentEncoding eq 'quoted-printable' ) {
861 $Content = MIME::QuotedPrint::decode($Content);
863 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
864 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
867 if ( RT::I18N::IsTextualContentType($ContentType) ) {
868 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
874 # A helper table for links mapping to make it easier
875 # to build and parse links between tickets
877 use vars '%LINKDIRMAP';
880 MemberOf => { Base => 'MemberOf',
881 Target => 'HasMember', },
882 RefersTo => { Base => 'RefersTo',
883 Target => 'ReferredToBy', },
884 DependsOn => { Base => 'DependsOn',
885 Target => 'DependedOnBy', },
886 MergedInto => { Base => 'MergedInto',
887 Target => 'MergedInto', },
891 =head2 Update ARGSHASH
893 Updates fields on an object for you using the proper Set methods,
894 skipping unchanged values.
896 ARGSRef => a hashref of attributes => value for the update
897 AttributesRef => an arrayref of keys in ARGSRef that should be updated
898 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
899 when looking up values in ARGSRef
900 Bare attributes are tried before prefixed attributes
902 Returns a list of localized results of the update
911 AttributesRef => undef,
912 AttributePrefix => undef,
916 my $attributes = $args{'AttributesRef'};
917 my $ARGSRef = $args{'ARGSRef'};
920 foreach my $attribute (@$attributes) {
922 if ( defined $ARGSRef->{$attribute} ) {
923 $value = $ARGSRef->{$attribute};
926 defined( $args{'AttributePrefix'} )
928 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
931 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
938 $value =~ s/\r\n/\n/gs;
941 # If Queue is 'General', we want to resolve the queue name for
944 # This is in an eval block because $object might not exist.
945 # and might not have a Name method. But "can" won't find autoloaded
946 # items. If it fails, we don't care
948 my $object = $attribute . "Obj";
949 next if ($self->$object->Name eq $value);
951 next if ( $value eq $self->$attribute() );
952 my $method = "Set$attribute";
953 my ( $code, $msg ) = $self->$method($value);
954 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
956 # Default to $id, but use name if we can get it.
957 my $label = $self->id;
958 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
959 push @results, $self->loc( "$prefix [_1]", $label ) . ': '. $msg;
963 "[_1] could not be set to [_2].", # loc
964 "That is already the current value", # loc
965 "No value sent to _Set!\n", # loc
966 "Illegal value for [_1]", # loc
967 "The new value has been set.", # loc
968 "No column specified", # loc
969 "Immutable field", # loc
970 "Nonexistant field?", # loc
971 "Invalid data", # loc
972 "Couldn't find row", # loc
973 "Missing a primary key?: [_1]", # loc
974 "Found Object", # loc
983 # {{{ Routines dealing with Links
985 # {{{ Link Collections
991 This returns an RT::Links object which references all the tickets
992 which are 'MembersOf' this ticket
998 return ( $self->_Links( 'Target', 'MemberOf' ) );
1007 This returns an RT::Links object which references all the tickets that this
1008 ticket is a 'MemberOf'
1014 return ( $self->_Links( 'Base', 'MemberOf' ) );
1023 This returns an RT::Links object which shows all references for which this ticket is a base
1029 return ( $self->_Links( 'Base', 'RefersTo' ) );
1038 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1044 return ( $self->_Links( 'Target', 'RefersTo' ) );
1053 This returns an RT::Links object which references all the tickets that depend on this one
1059 return ( $self->_Links( 'Target', 'DependsOn' ) );
1066 =head2 HasUnresolvedDependencies
1068 Takes a paramhash of Type (default to '__any'). Returns true if
1069 $self->UnresolvedDependencies returns an object with one or more members
1070 of that type. Returns false otherwise
1075 my $t1 = RT::Ticket->new($RT::SystemUser);
1076 my ($id, $trans, $msg) = $t1->Create(Subject => 'DepTest1', Queue => 'general');
1077 ok($id, "Created dep test 1 - $msg");
1079 my $t2 = RT::Ticket->new($RT::SystemUser);
1080 my ($id2, $trans, $msg2) = $t2->Create(Subject => 'DepTest2', Queue => 'general');
1081 ok($id2, "Created dep test 2 - $msg2");
1082 my $t3 = RT::Ticket->new($RT::SystemUser);
1083 my ($id3, $trans, $msg3) = $t3->Create(Subject => 'DepTest3', Queue => 'general', Type => 'approval');
1084 ok($id3, "Created dep test 3 - $msg3");
1085 my ($addid, $addmsg);
1086 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t2->id));
1087 ok ($addid, $addmsg);
1088 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t3->id));
1090 ok ($addid, $addmsg);
1091 my $link = RT::Link->new($RT::SystemUser);
1092 my ($rv, $msg) = $link->Load($addid);
1094 ok ($link->LocalTarget == $t3->id, "Link LocalTarget is correct");
1095 ok ($link->LocalBase == $t1->id, "Link LocalBase is correct");
1097 ok ($t1->HasUnresolvedDependencies, "Ticket ".$t1->Id." has unresolved deps");
1098 ok (!$t1->HasUnresolvedDependencies( Type => 'blah' ), "Ticket ".$t1->Id." has no unresolved blahs");
1099 ok ($t1->HasUnresolvedDependencies( Type => 'approval' ), "Ticket ".$t1->Id." has unresolved approvals");
1100 ok (!$t2->HasUnresolvedDependencies, "Ticket ".$t2->Id." has no unresolved deps");
1103 my ($rid, $rmsg)= $t1->Resolve();
1105 my ($rid2, $rmsg2) = $t2->Resolve();
1107 ($rid, $rmsg)= $t1->Resolve();
1109 my ($rid3,$rmsg3) = $t3->Resolve;
1111 ($rid, $rmsg)= $t1->Resolve();
1119 sub HasUnresolvedDependencies {
1126 my $deps = $self->UnresolvedDependencies;
1129 $deps->Limit( FIELD => 'Type',
1131 VALUE => $args{Type});
1137 if ($deps->Count > 0) {
1146 # {{{ UnresolvedDependencies
1148 =head2 UnresolvedDependencies
1150 Returns an RT::Tickets object of tickets which this ticket depends on
1151 and which have a status of new, open or stalled. (That list comes from
1152 RT::Queue->ActiveStatusArray
1157 sub UnresolvedDependencies {
1159 my $deps = RT::Tickets->new($self->CurrentUser);
1161 my @live_statuses = RT::Queue->ActiveStatusArray();
1162 foreach my $status (@live_statuses) {
1163 $deps->LimitStatus(VALUE => $status);
1165 $deps->LimitDependedOnBy($self->Id);
1173 # {{{ AllDependedOnBy
1175 =head2 AllDependedOnBy
1177 Returns an array of RT::Ticket objects which (directly or indirectly)
1178 depends on this ticket; takes an optional 'Type' argument in the param
1179 hash, which will limit returned tickets to that type, as well as cause
1180 tickets with that type to serve as 'leaf' nodes that stops the recursive
1185 sub AllDependedOnBy {
1187 my $dep = $self->DependedOnBy;
1195 while (my $link = $dep->Next()) {
1196 next unless ($link->BaseURI->IsLocal());
1197 next if $args{_found}{$link->BaseObj->Id};
1200 $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1201 $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1203 elsif ($link->BaseObj->Type eq $args{Type}) {
1204 $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1207 $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1212 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1225 This returns an RT::Links object which references all the tickets that this ticket depends on
1231 return ( $self->_Links( 'Base', 'DependsOn' ) );
1240 This returns an RT::Links object which references all the customers that this object is a member of.
1245 my( $self, %opt ) = @_;
1246 my $Debug = $opt{'Debug'};
1248 unless ( $self->{'Customers'} ) {
1250 $self->{'Customers'} = $self->MemberOf->Clone;
1252 $self->{'Customers'}->Limit(
1254 OPERATOR => 'STARTSWITH',
1255 VALUE => 'freeside://freeside/cust_main/',
1259 warn "->Customers method called on $self; returning ".
1260 ref($self->{'Customers'}). ' object'
1263 return $self->{'Customers'};
1270 =head2 Links DIRECTION [TYPE]
1272 Return links (L<RT::Links>) to/from this object.
1274 DIRECTION is either 'Base' or 'Target'.
1276 TYPE is a type of links to return, it can be omitted to get
1286 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1289 my $type = shift || "";
1291 unless ( $self->{"$field$type"} ) {
1292 $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1293 # at least to myself
1294 $self->{"$field$type"}->Limit( FIELD => $field,
1295 VALUE => $self->URI,
1296 ENTRYAGGREGATOR => 'OR' );
1297 $self->{"$field$type"}->Limit( FIELD => 'Type',
1301 return ( $self->{"$field$type"} );
1312 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1314 Returns C<link id>, C<message> and C<exist> flag.
1322 my %args = ( Target => '',
1329 # Remote_link is the URI of the object that is not this ticket
1333 if ( $args{'Base'} and $args{'Target'} ) {
1334 $RT::Logger->debug( "$self tried to create a link. both base and target were specified\n" );
1335 return ( 0, $self->loc("Can't specifiy both base and target") );
1337 elsif ( $args{'Base'} ) {
1338 $args{'Target'} = $self->URI();
1339 $remote_link = $args{'Base'};
1340 $direction = 'Target';
1342 elsif ( $args{'Target'} ) {
1343 $args{'Base'} = $self->URI();
1344 $remote_link = $args{'Target'};
1345 $direction = 'Base';
1348 return ( 0, $self->loc('Either base or target must be specified') );
1351 # {{{ Check if the link already exists - we don't want duplicates
1353 my $old_link = RT::Link->new( $self->CurrentUser );
1354 $old_link->LoadByParams( Base => $args{'Base'},
1355 Type => $args{'Type'},
1356 Target => $args{'Target'} );
1357 if ( $old_link->Id ) {
1358 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1359 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1365 # Storing the link in the DB.
1366 my $link = RT::Link->new( $self->CurrentUser );
1367 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1368 Base => $args{Base},
1369 Type => $args{Type} );
1372 $RT::Logger->error("Link could not be created: ".$linkmsg);
1373 return ( 0, $self->loc("Link could not be created") );
1377 "Record $args{'Base'} $args{Type} record $args{'Target'}.";
1379 return ( $linkid, $self->loc( "Link created ([_1])", $TransString ) );
1384 # {{{ sub _DeleteLink
1388 Delete a link. takes a paramhash of Base, Target and Type.
1389 Either Base or Target must be null. The null value will
1390 be replaced with this ticket\'s id
1403 #we want one of base and target. we don't care which
1404 #but we only want _one_
1409 if ( $args{'Base'} and $args{'Target'} ) {
1410 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n");
1411 return ( 0, $self->loc("Can't specifiy both base and target") );
1413 elsif ( $args{'Base'} ) {
1414 $args{'Target'} = $self->URI();
1415 $remote_link = $args{'Base'};
1416 $direction = 'Target';
1418 elsif ( $args{'Target'} ) {
1419 $args{'Base'} = $self->URI();
1420 $remote_link = $args{'Target'};
1424 $RT::Logger->error("Base or Target must be specified\n");
1425 return ( 0, $self->loc('Either base or target must be specified') );
1428 my $link = new RT::Link( $self->CurrentUser );
1429 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} . "\n" );
1432 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1436 my $linkid = $link->id;
1439 my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}.";
1440 return ( 1, $self->loc("Link deleted ([_1])", $TransString));
1443 #if it's not a link we can find
1445 $RT::Logger->debug("Couldn't find that link\n");
1446 return ( 0, $self->loc("Link not found") );
1454 # {{{ Routines dealing with transactions
1456 # {{{ sub _NewTransaction
1458 =head2 _NewTransaction PARAMHASH
1460 Private function to create a new RT::Transaction object for this ticket update
1464 sub _NewTransaction {
1471 OldReference => undef,
1472 NewReference => undef,
1473 ReferenceType => undef,
1477 ActivateScrips => 1,
1482 my $old_ref = $args{'OldReference'};
1483 my $new_ref = $args{'NewReference'};
1484 my $ref_type = $args{'ReferenceType'};
1485 if ($old_ref or $new_ref) {
1486 $ref_type ||= ref($old_ref) || ref($new_ref);
1488 $RT::Logger->error("Reference type not specified for transaction");
1491 $old_ref = $old_ref->Id if ref($old_ref);
1492 $new_ref = $new_ref->Id if ref($new_ref);
1495 require RT::Transaction;
1496 my $trans = new RT::Transaction( $self->CurrentUser );
1497 my ( $transaction, $msg ) = $trans->Create(
1498 ObjectId => $self->Id,
1499 ObjectType => ref($self),
1500 TimeTaken => $args{'TimeTaken'},
1501 Type => $args{'Type'},
1502 Data => $args{'Data'},
1503 Field => $args{'Field'},
1504 NewValue => $args{'NewValue'},
1505 OldValue => $args{'OldValue'},
1506 NewReference => $new_ref,
1507 OldReference => $old_ref,
1508 ReferenceType => $ref_type,
1509 MIMEObj => $args{'MIMEObj'},
1510 ActivateScrips => $args{'ActivateScrips'},
1511 CommitScrips => $args{'CommitScrips'},
1514 # Rationalize the object since we may have done things to it during the caching.
1515 $self->Load($self->Id);
1517 $RT::Logger->warning($msg) unless $transaction;
1519 $self->_SetLastUpdated;
1521 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1522 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1524 if ( $RT::UseTransactionBatch and $transaction ) {
1525 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1527 return ( $transaction, $msg, $trans );
1532 # {{{ sub Transactions
1536 Returns an RT::Transactions object of all transactions on this record object
1543 use RT::Transactions;
1544 my $transactions = RT::Transactions->new( $self->CurrentUser );
1546 #If the user has no rights, return an empty object
1547 $transactions->Limit(
1548 FIELD => 'ObjectId',
1551 $transactions->Limit(
1552 FIELD => 'ObjectType',
1553 VALUE => ref($self),
1556 return ($transactions);
1562 # {{{ Routines dealing with custom fields
1566 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1568 # XXX handle multiple types properly
1569 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1570 $cfs->LimitToGlobalOrObjectId(
1571 $self->_LookupId( $self->CustomFieldLookupType ) );
1576 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
1581 my @classes = ($lookup =~ /RT::(\w+)-/g);
1584 foreach my $class (reverse @classes) {
1585 my $method = "${class}Obj";
1586 $object = $object->$method;
1593 =head2 CustomFieldLookupType
1595 Returns the path RT uses to figure out which custom fields apply to this object.
1599 sub CustomFieldLookupType {
1604 #TODO Deprecated API. Destroy in 3.6
1607 $RT::Logger->warning("_LookupTypes call is deprecated at (". join(":",caller)."). Replace with CustomFieldLookupType");
1609 return($self->CustomFieldLookupType);
1613 # {{{ AddCustomFieldValue
1615 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1617 VALUE should be a string.
1618 FIELD can be a CustomField object OR a CustomField ID.
1621 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1622 deletes the old value.
1623 If VALUE is not a valid value for the custom field, returns
1624 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1628 sub AddCustomFieldValue {
1630 $self->_AddCustomFieldValue(@_);
1633 sub _AddCustomFieldValue {
1638 RecordTransaction => 1,
1642 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1644 unless ( $cf->Id ) {
1645 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1648 my $OCFs = $self->CustomFields;
1649 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1650 unless ( $OCFs->Count ) {
1654 "Custom field [_1] does not apply to this object",
1659 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1660 my $values = $cf->ValuesForObject($self);
1662 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1663 return ( 0, $self->loc("Invalid value for custom field") );
1666 # If the custom field only accepts a certain # of values, delete the existing
1667 # value and record a "changed from foo to bar" transaction
1668 unless ( $cf->UnlimitedValues) {
1670 # We need to whack any old values here. In most cases, the custom field should
1671 # only have one value to delete. In the pathalogical case, this custom field
1672 # used to be a multiple and we have many values to whack....
1673 my $cf_values = $values->Count;
1675 if ( $cf_values > $cf->MaxValues ) {
1676 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1677 # execute the same code to "change" the value from old to new
1678 while ( my $value = $values->Next ) {
1680 if ( $i < $cf_values ) {
1681 my ( $val, $msg ) = $cf->DeleteValueForObject(
1683 Content => $value->Content
1688 my ( $TransactionId, $Msg, $TransactionObj ) =
1689 $self->_NewTransaction(
1690 Type => 'CustomField',
1692 OldReference => $value,
1696 $values->RedoSearch if $i; # redo search if have deleted at least one value
1699 my ( $old_value, $old_content );
1700 if ( $old_value = $values->First ) {
1701 $old_content = $old_value->Content();
1702 return (1) if( $old_content eq $args{'Value'} && $old_value->LargeContent eq $args{'LargeContent'});;
1705 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1707 Content => $args{'Value'},
1708 LargeContent => $args{'LargeContent'},
1709 ContentType => $args{'ContentType'},
1712 unless ($new_value_id) {
1713 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) );
1716 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1717 $new_value->Load($new_value_id);
1719 # now that adding the new value was successful, delete the old one
1721 my ( $val, $msg ) = $old_value->Delete();
1727 if ( $args{'RecordTransaction'} ) {
1728 my ( $TransactionId, $Msg, $TransactionObj ) =
1729 $self->_NewTransaction(
1730 Type => 'CustomField',
1732 OldReference => $old_value,
1733 NewReference => $new_value,
1737 if ( $old_value eq '' ) {
1738 return ( 1, $self->loc( "[_1] [_2] added", $cf->Name, $new_value->Content ));
1740 elsif ( $new_value->Content eq '' ) {
1742 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) );
1745 return ( 1, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_value->Content));
1750 # otherwise, just add a new value and record "new value added"
1752 my ($new_value_id, $value_msg) = $cf->AddValueForObject(
1754 Content => $args{'Value'},
1755 LargeContent => $args{'LargeContent'},
1756 ContentType => $args{'ContentType'},
1759 unless ($new_value_id) {
1760 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg) );
1762 if ( $args{'RecordTransaction'} ) {
1763 my ( $TransactionId, $Msg, $TransactionObj ) =
1764 $self->_NewTransaction(
1765 Type => 'CustomField',
1767 NewReference => $new_value_id,
1768 ReferenceType => 'RT::ObjectCustomFieldValue',
1770 unless ($TransactionId) {
1772 $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1775 return ( 1, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name));
1782 # {{{ DeleteCustomFieldValue
1784 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1786 Deletes VALUE as a value of CustomField FIELD.
1788 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1790 If VALUE is not a valid value for the custom field, returns
1791 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1795 sub DeleteCustomFieldValue {
1804 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1806 unless ( $cf->Id ) {
1807 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1809 my ( $val, $msg ) = $cf->DeleteValueForObject(
1811 Id => $args{'ValueId'},
1812 Content => $args{'Value'},
1817 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1818 Type => 'CustomField',
1820 OldReference => $val,
1821 ReferenceType => 'RT::ObjectCustomFieldValue',
1823 unless ($TransactionId) {
1824 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1830 "[_1] is no longer a value for custom field [_2]",
1831 $TransactionObj->OldValue, $cf->Name
1838 # {{{ FirstCustomFieldValue
1840 =head2 FirstCustomFieldValue FIELD
1842 Return the content of the first value of CustomField FIELD for this ticket
1843 Takes a field id or name
1847 sub FirstCustomFieldValue {
1850 my $values = $self->CustomFieldValues($field);
1851 if ($values->First) {
1852 return $values->First->Content;
1861 # {{{ CustomFieldValues
1863 =head2 CustomFieldValues FIELD
1865 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1866 id or Name is FIELD for this record.
1868 Returns an RT::ObjectCustomFieldValues object
1872 sub CustomFieldValues {
1877 my $cf = $self->LoadCustomFieldByIdentifier($field);
1879 # we were asked to search on a custom field we couldn't fine
1880 unless ( $cf->id ) {
1881 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1883 return ( $cf->ValuesForObject($self) );
1886 # we're not limiting to a specific custom field;
1887 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1888 $ocfs->LimitToObject($self);
1893 =head2 CustomField IDENTIFER
1895 Find the custom field has id or name IDENTIFIER for this object.
1897 If no valid field is found, returns an empty RT::CustomField object.
1901 sub LoadCustomFieldByIdentifier {
1905 my $cf = RT::CustomField->new($self->CurrentUser);
1907 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1908 $cf->LoadById( $field->id );
1910 elsif ($field =~ /^\d+$/) {
1911 $cf = RT::CustomField->new($self->CurrentUser);
1915 my $cfs = $self->CustomFields($self->CurrentUser);
1916 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
1917 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1933 return $RT::WebPath. "/index.html?q=";
1936 eval "require RT::Record_Vendor";
1937 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
1938 eval "require RT::Record_Local";
1939 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});