1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
51 RT::Record - Base class for RT record objects
75 our $_TABLE_ATTR = { };
78 my $base = 'DBIx::SearchBuilder::Record::Cachable';
79 if ( $RT::Config && $RT::Config->Get('DontCacheSearchBuilderRecords') ) {
80 $base = 'DBIx::SearchBuilder::Record';
82 eval "require $base" or die $@;
83 our @ISA = 'RT::Base';
90 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
91 $self->CurrentUser(@_);
100 The primary keys for RT classes is 'id'
104 sub _PrimaryKeys { return ['id'] }
110 Delete this record object from the database.
116 my ($rv) = $self->SUPER::Delete;
118 return ($rv, $self->loc("Object deleted"));
121 return(0, $self->loc("Object could not be deleted"))
127 Returns a string which is this object's type. The type is the class,
128 without the "RT::" prefix.
135 if (ref($self) =~ /^.*::(\w+)$/) {
136 return $self->loc($1);
138 return $self->loc(ref($self));
144 Return this object's attributes as an RT::Attributes object
151 unless ($self->{'attributes'}) {
152 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
153 $self->{'attributes'}->LimitToObject($self);
155 return ($self->{'attributes'});
160 =head2 AddAttribute { Name, Description, Content }
162 Adds a new attribute for this object.
168 my %args = ( Name => undef,
169 Description => undef,
173 my $attr = RT::Attribute->new( $self->CurrentUser );
174 my ( $id, $msg ) = $attr->Create(
176 Name => $args{'Name'},
177 Description => $args{'Description'},
178 Content => $args{'Content'} );
181 # XXX TODO: Why won't RedoSearch work here?
182 $self->Attributes->_DoSearch;
188 =head2 SetAttribute { Name, Description, Content }
190 Like AddAttribute, but replaces all existing attributes with the same Name.
196 my %args = ( Name => undef,
197 Description => undef,
201 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
202 or return $self->AddAttribute( %args );
204 my $AttributeObj = pop( @AttributeObjs );
205 $_->Delete foreach @AttributeObjs;
207 $AttributeObj->SetDescription( $args{'Description'} );
208 $AttributeObj->SetContent( $args{'Content'} );
210 $self->Attributes->RedoSearch;
214 =head2 DeleteAttribute NAME
216 Deletes all attributes with the matching name for this object.
220 sub DeleteAttribute {
223 return $self->Attributes->DeleteEntry( Name => $name );
226 =head2 FirstAttribute NAME
228 Returns the first attribute with the matching name for this object (as an
229 L<RT::Attribute> object), or C<undef> if no such attributes exist.
231 Note that if there is more than one attribute with the matching name on the
232 object, the choice of which one to return is basically arbitrary. This may be
233 made well-defined in the future.
240 return ($self->Attributes->Named( $name ))[0];
245 sub _Handle { return $RT::Handle }
251 =head2 Create PARAMHASH
253 Takes a PARAMHASH of Column -> Value pairs.
254 If any Column has a Validate$PARAMNAME subroutine defined and the
255 value provided doesn't pass validation, this routine returns
258 If this object's table has any of the following atetributes defined as
259 'Auto', this routine will automatically fill in their values.
266 foreach my $key ( keys %attribs ) {
267 my $method = "Validate$key";
268 unless ( $self->$method( $attribs{$key} ) ) {
270 return ( 0, $self->loc('Invalid value for [_1]', $key) );
277 my $now = RT::Date->new( $self->CurrentUser );
278 $now->Set( Format => 'unix', Value => time );
279 $attribs{'Created'} = $now->ISO() if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
281 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
282 $attribs{'Creator'} = $self->CurrentUser->id || '0';
284 $attribs{'LastUpdated'} = $now->ISO()
285 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
287 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
288 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
290 my $id = $self->SUPER::Create(%attribs);
291 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
295 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
302 # If the object was created in the database,
303 # load it up now, so we're sure we get what the database
304 # has. Arguably, this should not be necessary, but there
305 # isn't much we can do about it.
309 return ( $id, $self->loc('Object could not be created') );
317 if (UNIVERSAL::isa('errno',$id)) {
321 $self->Load($id) if ($id);
326 return ( $id, $self->loc('Object created') );
340 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
348 # We don't want to hang onto this
349 delete $self->{'attributes'};
351 return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
353 # If this database is case sensitive we need to uncase objects for
356 foreach my $key ( keys %hash ) {
358 # If we've been passed an empty value, we can't do the lookup.
359 # We don't need to explicitly downcase integers or an id.
360 if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
361 my ($op, $val, $func);
362 ($key, $op, $val, $func) =
363 $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
364 $hash{$key}->{operator} = $op;
365 $hash{$key}->{value} = $val;
366 $hash{$key}->{function} = $func;
369 return $self->SUPER::LoadByCols( %hash );
376 # There is room for optimizations in most of those subs:
382 my $obj = new RT::Date( $self->CurrentUser );
384 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
394 my $obj = new RT::Date( $self->CurrentUser );
396 $obj->Set( Format => 'sql', Value => $self->Created );
405 # TODO: This should be deprecated
409 return ( $self->CreatedObj->AgeAsString() );
414 # {{{ LastUpdatedAsString
416 # TODO this should be deprecated
418 sub LastUpdatedAsString {
420 if ( $self->LastUpdated ) {
421 return ( $self->LastUpdatedObj->AsString() );
431 # {{{ CreatedAsString
433 # TODO This should be deprecated
435 sub CreatedAsString {
437 return ( $self->CreatedObj->AsString() );
442 # {{{ LongSinceUpdateAsString
444 # TODO This should be deprecated
446 sub LongSinceUpdateAsString {
448 if ( $self->LastUpdated ) {
450 return ( $self->LastUpdatedObj->AgeAsString() );
474 #if the user is trying to modify the record
475 # TODO: document _why_ this code is here
477 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
481 my $old_val = $self->__Value($args{'Field'});
482 $self->_SetLastUpdated();
483 my $ret = $self->SUPER::_Set(
484 Field => $args{'Field'},
485 Value => $args{'Value'},
486 IsSQL => $args{'IsSQL'}
488 my ($status, $msg) = $ret->as_array();
490 # @values has two values, a status code and a message.
492 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
493 # we want to change the standard "success" message
497 "[_1] changed from [_2] to [_3]",
498 $self->loc( $args{'Field'} ),
499 ( $old_val ? "'$old_val'" : $self->loc("(no value)") ),
500 '"' . $self->__Value( $args{'Field'}) . '"'
504 $msg = $self->CurrentUser->loc_fuzzy($msg);
506 return wantarray ? ($status, $msg) : $ret;
512 # {{{ sub _SetLastUpdated
514 =head2 _SetLastUpdated
516 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
517 It takes no options. Arguably, this is a bug
521 sub _SetLastUpdated {
524 my $now = new RT::Date( $self->CurrentUser );
527 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
528 my ( $msg, $val ) = $self->__Set(
529 Field => 'LastUpdated',
533 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
534 my ( $msg, $val ) = $self->__Set(
535 Field => 'LastUpdatedBy',
536 Value => $self->CurrentUser->id
547 Returns an RT::User object with the RT account of the creator of this row
553 unless ( exists $self->{'CreatorObj'} ) {
555 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
556 $self->{'CreatorObj'}->Load( $self->Creator );
558 return ( $self->{'CreatorObj'} );
563 # {{{ sub LastUpdatedByObj
565 =head2 LastUpdatedByObj
567 Returns an RT::User object of the last user to touch this object
571 sub LastUpdatedByObj {
573 unless ( exists $self->{LastUpdatedByObj} ) {
574 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
575 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
577 return $self->{'LastUpdatedByObj'};
586 Returns this record's URI
592 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
593 return($uri->URIForObject($self));
598 =head2 ValidateName NAME
600 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
607 if ($value && $value=~ /^\d+$/) {
616 =head2 SQLType attribute
618 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
626 return ($self->_Accessible($field, 'type'));
634 my %args = ( decode_utf8 => 1, @_ );
637 $RT::Logger->error("__Value called with undef field");
640 my $value = $self->SUPER::__Value( $field );
641 if( $args{'decode_utf8'} ) {
642 return Encode::decode_utf8( $value ) unless Encode::is_utf8( $value );
644 return Encode::encode_utf8( $value ) if Encode::is_utf8( $value );
649 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
654 'cache_for_sec' => 30,
660 sub _BuildTableAttributes {
662 my $class = ref($self) || $self;
665 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
666 $attributes = $self->_CoreAccessible();
667 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
668 $attributes = $self->_ClassAccessible();
672 foreach my $column (%$attributes) {
673 foreach my $attr ( %{ $attributes->{$column} } ) {
674 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
677 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
678 next unless UNIVERSAL::can( $self, $method );
679 $attributes = $self->$method();
681 foreach my $column (%$attributes) {
682 foreach my $attr ( %{ $attributes->{$column} } ) {
683 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
690 =head2 _ClassAccessible
692 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
693 DBIx::SearchBuilder::Record
697 sub _ClassAccessible {
699 return $_TABLE_ATTR->{ref($self) || $self};
702 =head2 _Accessible COLUMN ATTRIBUTE
704 returns the value of ATTRIBUTE for COLUMN
712 my $attribute = lc(shift);
713 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
714 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
718 =head2 _EncodeLOB BODY MIME_TYPE
720 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
727 my $MIMEType = shift || '';
729 my $ContentEncoding = 'none';
731 #get the max attachment length from RT
732 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
734 #if the current attachment contains nulls and the
735 #database doesn't support embedded nulls
737 if ( RT->Config->Get('AlwaysUseBase64') or
738 ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
740 # set a flag telling us to mimencode the attachment
741 $ContentEncoding = 'base64';
743 #cut the max attchment size by 25% (for mime-encoding overhead.
744 $RT::Logger->debug("Max size is $MaxSize");
745 $MaxSize = $MaxSize * 3 / 4;
746 # Some databases (postgres) can't handle non-utf8 data
747 } elsif ( !$RT::Handle->BinarySafeBLOBs
748 && $MIMEType !~ /text\/plain/gi
749 && !Encode::is_utf8( $Body, 1 ) ) {
750 $ContentEncoding = 'quoted-printable';
753 #if the attachment is larger than the maximum size
754 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
756 # if we're supposed to truncate large attachments
757 if (RT->Config->Get('TruncateLongAttachments')) {
759 # truncate the attachment to that length.
760 $Body = substr( $Body, 0, $MaxSize );
764 # elsif we're supposed to drop large attachments on the floor,
765 elsif (RT->Config->Get('DropLongAttachments')) {
767 # drop the attachment on the floor
768 $RT::Logger->info( "$self: Dropped an attachment of size "
770 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
771 return ("none", "Large attachment dropped" );
775 # if we need to mimencode the attachment
776 if ( $ContentEncoding eq 'base64' ) {
778 # base64 encode the attachment
779 Encode::_utf8_off($Body);
780 $Body = MIME::Base64::encode_base64($Body);
782 } elsif ($ContentEncoding eq 'quoted-printable') {
783 Encode::_utf8_off($Body);
784 $Body = MIME::QuotedPrint::encode($Body);
788 return ($ContentEncoding, $Body);
794 my $ContentType = shift || '';
795 my $ContentEncoding = shift || 'none';
798 if ( $ContentEncoding eq 'base64' ) {
799 $Content = MIME::Base64::decode_base64($Content);
801 elsif ( $ContentEncoding eq 'quoted-printable' ) {
802 $Content = MIME::QuotedPrint::decode($Content);
804 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
805 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
808 if ( RT::I18N::IsTextualContentType($ContentType) ) {
809 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
814 # A helper table for links mapping to make it easier
815 # to build and parse links between tickets
817 use vars '%LINKDIRMAP';
820 MemberOf => { Base => 'MemberOf',
821 Target => 'HasMember', },
822 RefersTo => { Base => 'RefersTo',
823 Target => 'ReferredToBy', },
824 DependsOn => { Base => 'DependsOn',
825 Target => 'DependedOnBy', },
826 MergedInto => { Base => 'MergedInto',
827 Target => 'MergedInto', },
831 =head2 Update ARGSHASH
833 Updates fields on an object for you using the proper Set methods,
834 skipping unchanged values.
836 ARGSRef => a hashref of attributes => value for the update
837 AttributesRef => an arrayref of keys in ARGSRef that should be updated
838 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
839 when looking up values in ARGSRef
840 Bare attributes are tried before prefixed attributes
842 Returns a list of localized results of the update
851 AttributesRef => undef,
852 AttributePrefix => undef,
856 my $attributes = $args{'AttributesRef'};
857 my $ARGSRef = $args{'ARGSRef'};
860 foreach my $attribute (@$attributes) {
862 if ( defined $ARGSRef->{$attribute} ) {
863 $value = $ARGSRef->{$attribute};
866 defined( $args{'AttributePrefix'} )
868 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
871 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
878 $value =~ s/\r\n/\n/gs;
881 # If Queue is 'General', we want to resolve the queue name for
884 # This is in an eval block because $object might not exist.
885 # and might not have a Name method. But "can" won't find autoloaded
886 # items. If it fails, we don't care
888 no warnings "uninitialized";
891 my $object = $attribute . "Obj";
892 my $name = $self->$object->Name;
893 next if $name eq $value || $name eq ($value || 0);
895 next if $value eq $self->$attribute();
896 next if ($value || 0) eq $self->$attribute();
899 my $method = "Set$attribute";
900 my ( $code, $msg ) = $self->$method($value);
901 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
903 # Default to $id, but use name if we can get it.
904 my $label = $self->id;
905 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
906 # this requires model names to be loc'ed.
916 push @results, $self->loc( $prefix ) . " $label: ". $msg;
920 "[_1] could not be set to [_2].", # loc
921 "That is already the current value", # loc
922 "No value sent to _Set!\n", # loc
923 "Illegal value for [_1]", # loc
924 "The new value has been set.", # loc
925 "No column specified", # loc
926 "Immutable field", # loc
927 "Nonexistant field?", # loc
928 "Invalid data", # loc
929 "Couldn't find row", # loc
930 "Missing a primary key?: [_1]", # loc
931 "Found Object", # loc
940 # {{{ Routines dealing with Links
942 # {{{ Link Collections
948 This returns an RT::Links object which references all the tickets
949 which are 'MembersOf' this ticket
955 return ( $self->_Links( 'Target', 'MemberOf' ) );
964 This returns an RT::Links object which references all the tickets that this
965 ticket is a 'MemberOf'
971 return ( $self->_Links( 'Base', 'MemberOf' ) );
980 This returns an RT::Links object which shows all references for which this ticket is a base
986 return ( $self->_Links( 'Base', 'RefersTo' ) );
995 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1001 return ( $self->_Links( 'Target', 'RefersTo' ) );
1010 This returns an RT::Links object which references all the tickets that depend on this one
1016 return ( $self->_Links( 'Target', 'DependsOn' ) );
1023 =head2 HasUnresolvedDependencies
1025 Takes a paramhash of Type (default to '__any'). Returns the number of
1026 unresolved dependencies, if $self->UnresolvedDependencies returns an
1027 object with one or more members of that type. Returns false
1032 sub HasUnresolvedDependencies {
1039 my $deps = $self->UnresolvedDependencies;
1042 $deps->Limit( FIELD => 'Type',
1044 VALUE => $args{Type});
1050 if ($deps->Count > 0) {
1051 return $deps->Count;
1059 # {{{ UnresolvedDependencies
1061 =head2 UnresolvedDependencies
1063 Returns an RT::Tickets object of tickets which this ticket depends on
1064 and which have a status of new, open or stalled. (That list comes from
1065 RT::Queue->ActiveStatusArray
1070 sub UnresolvedDependencies {
1072 my $deps = RT::Tickets->new($self->CurrentUser);
1074 my @live_statuses = RT::Queue->ActiveStatusArray();
1075 foreach my $status (@live_statuses) {
1076 $deps->LimitStatus(VALUE => $status);
1078 $deps->LimitDependedOnBy($self->Id);
1086 # {{{ AllDependedOnBy
1088 =head2 AllDependedOnBy
1090 Returns an array of RT::Ticket objects which (directly or indirectly)
1091 depends on this ticket; takes an optional 'Type' argument in the param
1092 hash, which will limit returned tickets to that type, as well as cause
1093 tickets with that type to serve as 'leaf' nodes that stops the recursive
1098 sub AllDependedOnBy {
1100 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1101 Direction => 'Target', @_ );
1106 Returns an array of RT::Ticket objects which this ticket (directly or
1107 indirectly) depends on; takes an optional 'Type' argument in the param
1108 hash, which will limit returned tickets to that type, as well as cause
1109 tickets with that type to serve as 'leaf' nodes that stops the
1110 recursive dependency search.
1116 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1117 Direction => 'Base', @_ );
1120 sub _AllLinkedTickets {
1132 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1133 while (my $link = $dep->Next()) {
1134 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1135 next unless ($uri->IsLocal());
1136 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1137 next if $args{_found}{$obj->Id};
1140 $args{_found}{$obj->Id} = $obj;
1141 $obj->_AllLinkedTickets( %args, _top => 0 );
1143 elsif ($obj->Type eq $args{Type}) {
1144 $args{_found}{$obj->Id} = $obj;
1147 $obj->_AllLinkedTickets( %args, _top => 0 );
1152 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1165 This returns an RT::Links object which references all the tickets that this ticket depends on
1171 return ( $self->_Links( 'Base', 'DependsOn' ) );
1180 This returns an RT::Links object which references all the customers that
1181 this object is a member of. This includes both explicitly linked customers
1182 and links implied by services.
1187 my( $self, %opt ) = @_;
1188 my $Debug = $opt{'Debug'};
1190 unless ( $self->{'Customers'} ) {
1192 $self->{'Customers'} = $self->MemberOf->Clone;
1194 for my $fstable (qw(cust_main cust_svc)) {
1196 $self->{'Customers'}->Limit(
1198 OPERATOR => 'STARTSWITH',
1199 VALUE => "freeside://freeside/$fstable",
1200 ENTRYAGGREGATOR => 'OR',
1201 SUBCLAUSE => 'customers',
1206 warn "->Customers method called on $self; returning ".
1207 ref($self->{'Customers'}). ' object'
1210 return $self->{'Customers'};
1219 This returns an RT::Links object which references all the services this
1220 object is a member of.
1225 my( $self, %opt ) = @_;
1227 unless ( $self->{'Services'} ) {
1229 $self->{'Services'} = $self->MemberOf->Clone;
1231 $self->{'Services'}->Limit(
1233 OPERATOR => 'STARTSWITH',
1234 VALUE => "freeside://freeside/cust_svc",
1238 return $self->{'Services'};
1245 =head2 Links DIRECTION [TYPE]
1247 Return links (L<RT::Links>) to/from this object.
1249 DIRECTION is either 'Base' or 'Target'.
1251 TYPE is a type of links to return, it can be omitted to get
1261 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1264 my $type = shift || "";
1266 unless ( $self->{"$field$type"} ) {
1267 $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1268 # at least to myself
1269 $self->{"$field$type"}->Limit( FIELD => $field,
1270 VALUE => $self->URI,
1271 ENTRYAGGREGATOR => 'OR' );
1272 $self->{"$field$type"}->Limit( FIELD => 'Type',
1276 return ( $self->{"$field$type"} );
1283 # {{{ sub FormatType
1287 Takes a Type and returns a string that is more human readable.
1293 my %args = ( Type => '',
1296 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1297 $args{Type} =~ s/^\s+//;
1304 # {{{ sub FormatLink
1308 Takes either a Target or a Base and returns a string of human friendly text.
1314 my %args = ( Object => undef,
1318 my $text = "URI " . $args{FallBack};
1319 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1320 $text = "Ticket " . $args{Object}->id;
1331 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1333 Returns C<link id>, C<message> and C<exist> flag.
1340 my %args = ( Target => '',
1347 # Remote_link is the URI of the object that is not this ticket
1351 if ( $args{'Base'} and $args{'Target'} ) {
1352 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1353 return ( 0, $self->loc("Can't specifiy both base and target") );
1355 elsif ( $args{'Base'} ) {
1356 $args{'Target'} = $self->URI();
1357 $remote_link = $args{'Base'};
1358 $direction = 'Target';
1360 elsif ( $args{'Target'} ) {
1361 $args{'Base'} = $self->URI();
1362 $remote_link = $args{'Target'};
1363 $direction = 'Base';
1366 return ( 0, $self->loc('Either base or target must be specified') );
1369 # {{{ Check if the link already exists - we don't want duplicates
1371 my $old_link = RT::Link->new( $self->CurrentUser );
1372 $old_link->LoadByParams( Base => $args{'Base'},
1373 Type => $args{'Type'},
1374 Target => $args{'Target'} );
1375 if ( $old_link->Id ) {
1376 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1377 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1383 # Storing the link in the DB.
1384 my $link = RT::Link->new( $self->CurrentUser );
1385 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1386 Base => $args{Base},
1387 Type => $args{Type} );
1390 $RT::Logger->error("Link could not be created: ".$linkmsg);
1391 return ( 0, $self->loc("Link could not be created") );
1394 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1395 FallBack => $args{Base});
1396 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1397 FallBack => $args{Target});
1398 my $typetext = $self->FormatType(Type => $args{Type});
1400 "$basetext $typetext $targettext.";
1401 return ( $linkid, $TransString ) ;
1406 # {{{ sub _DeleteLink
1410 Delete a link. takes a paramhash of Base, Target and Type.
1411 Either Base or Target must be null. The null value will
1412 be replaced with this ticket\'s id
1425 #we want one of base and target. we don't care which
1426 #but we only want _one_
1431 if ( $args{'Base'} and $args{'Target'} ) {
1432 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1433 return ( 0, $self->loc("Can't specifiy both base and target") );
1435 elsif ( $args{'Base'} ) {
1436 $args{'Target'} = $self->URI();
1437 $remote_link = $args{'Base'};
1438 $direction = 'Target';
1440 elsif ( $args{'Target'} ) {
1441 $args{'Base'} = $self->URI();
1442 $remote_link = $args{'Target'};
1446 $RT::Logger->error("Base or Target must be specified");
1447 return ( 0, $self->loc('Either base or target must be specified') );
1450 my $link = new RT::Link( $self->CurrentUser );
1451 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1454 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1458 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1459 FallBack => $args{Base});
1460 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1461 FallBack => $args{Target});
1462 my $typetext = $self->FormatType(Type => $args{Type});
1463 my $linkid = $link->id;
1465 my $TransString = "$basetext no longer $typetext $targettext.";
1466 return ( 1, $TransString);
1469 #if it's not a link we can find
1471 $RT::Logger->debug("Couldn't find that link");
1472 return ( 0, $self->loc("Link not found") );
1480 # {{{ Routines dealing with transactions
1482 # {{{ sub _NewTransaction
1484 =head2 _NewTransaction PARAMHASH
1486 Private function to create a new RT::Transaction object for this ticket update
1490 sub _NewTransaction {
1497 OldReference => undef,
1498 NewReference => undef,
1499 ReferenceType => undef,
1503 ActivateScrips => 1,
1509 my $old_ref = $args{'OldReference'};
1510 my $new_ref = $args{'NewReference'};
1511 my $ref_type = $args{'ReferenceType'};
1512 if ($old_ref or $new_ref) {
1513 $ref_type ||= ref($old_ref) || ref($new_ref);
1515 $RT::Logger->error("Reference type not specified for transaction");
1518 $old_ref = $old_ref->Id if ref($old_ref);
1519 $new_ref = $new_ref->Id if ref($new_ref);
1522 require RT::Transaction;
1523 my $trans = new RT::Transaction( $self->CurrentUser );
1524 my ( $transaction, $msg ) = $trans->Create(
1525 ObjectId => $self->Id,
1526 ObjectType => ref($self),
1527 TimeTaken => $args{'TimeTaken'},
1528 Type => $args{'Type'},
1529 Data => $args{'Data'},
1530 Field => $args{'Field'},
1531 NewValue => $args{'NewValue'},
1532 OldValue => $args{'OldValue'},
1533 NewReference => $new_ref,
1534 OldReference => $old_ref,
1535 ReferenceType => $ref_type,
1536 MIMEObj => $args{'MIMEObj'},
1537 ActivateScrips => $args{'ActivateScrips'},
1538 CommitScrips => $args{'CommitScrips'},
1539 CustomFields => $args{'CustomFields'},
1542 # Rationalize the object since we may have done things to it during the caching.
1543 $self->Load($self->Id);
1545 $RT::Logger->warning($msg) unless $transaction;
1547 $self->_SetLastUpdated;
1549 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1550 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1552 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1553 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1555 return ( $transaction, $msg, $trans );
1560 # {{{ sub Transactions
1564 Returns an RT::Transactions object of all transactions on this record object
1571 use RT::Transactions;
1572 my $transactions = RT::Transactions->new( $self->CurrentUser );
1574 #If the user has no rights, return an empty object
1575 $transactions->Limit(
1576 FIELD => 'ObjectId',
1579 $transactions->Limit(
1580 FIELD => 'ObjectType',
1581 VALUE => ref($self),
1584 return ($transactions);
1590 # {{{ Routines dealing with custom fields
1594 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1596 $cfs->SetContextObject( $self );
1597 # XXX handle multiple types properly
1598 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1599 $cfs->LimitToGlobalOrObjectId(
1600 $self->_LookupId( $self->CustomFieldLookupType )
1602 $cfs->ApplySortOrder;
1607 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
1612 my @classes = ($lookup =~ /RT::(\w+)-/g);
1615 foreach my $class (reverse @classes) {
1616 my $method = "${class}Obj";
1617 $object = $object->$method;
1624 =head2 CustomFieldLookupType
1626 Returns the path RT uses to figure out which custom fields apply to this object.
1630 sub CustomFieldLookupType {
1635 # {{{ AddCustomFieldValue
1637 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1639 VALUE should be a string. FIELD can be any identifier of a CustomField
1640 supported by L</LoadCustomFieldByIdentifier> method.
1642 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1643 deletes the old value.
1644 If VALUE is not a valid value for the custom field, returns
1645 (0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1646 $id is ID of created L<ObjectCustomFieldValue> object.
1650 sub AddCustomFieldValue {
1652 $self->_AddCustomFieldValue(@_);
1655 sub _AddCustomFieldValue {
1660 LargeContent => undef,
1661 ContentType => undef,
1662 RecordTransaction => 1,
1666 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1667 unless ( $cf->Id ) {
1668 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1671 my $OCFs = $self->CustomFields;
1672 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1673 unless ( $OCFs->Count ) {
1677 "Custom field [_1] does not apply to this object",
1683 # empty string is not correct value of any CF, so undef it
1684 foreach ( qw(Value LargeContent) ) {
1685 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1688 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1689 return ( 0, $self->loc("Invalid value for custom field") );
1692 # If the custom field only accepts a certain # of values, delete the existing
1693 # value and record a "changed from foo to bar" transaction
1694 unless ( $cf->UnlimitedValues ) {
1696 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1697 my $values = $cf->ValuesForObject($self);
1699 # We need to whack any old values here. In most cases, the custom field should
1700 # only have one value to delete. In the pathalogical case, this custom field
1701 # used to be a multiple and we have many values to whack....
1702 my $cf_values = $values->Count;
1704 if ( $cf_values > $cf->MaxValues ) {
1705 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1706 # execute the same code to "change" the value from old to new
1707 while ( my $value = $values->Next ) {
1709 if ( $i < $cf_values ) {
1710 my ( $val, $msg ) = $cf->DeleteValueForObject(
1712 Content => $value->Content
1717 my ( $TransactionId, $Msg, $TransactionObj ) =
1718 $self->_NewTransaction(
1719 Type => 'CustomField',
1721 OldReference => $value,
1725 $values->RedoSearch if $i; # redo search if have deleted at least one value
1728 my ( $old_value, $old_content );
1729 if ( $old_value = $values->First ) {
1730 $old_content = $old_value->Content;
1731 $old_content = undef if defined $old_content && !length $old_content;
1733 my $is_the_same = 1;
1734 if ( defined $args{'Value'} ) {
1735 $is_the_same = 0 unless defined $old_content
1736 && lc $old_content eq lc $args{'Value'};
1738 $is_the_same = 0 if defined $old_content;
1740 if ( $is_the_same ) {
1741 my $old_content = $old_value->LargeContent;
1742 if ( defined $args{'LargeContent'} ) {
1743 $is_the_same = 0 unless defined $old_content
1744 && $old_content eq $args{'LargeContent'};
1746 $is_the_same = 0 if defined $old_content;
1750 return $old_value->id if $is_the_same;
1753 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1755 Content => $args{'Value'},
1756 LargeContent => $args{'LargeContent'},
1757 ContentType => $args{'ContentType'},
1760 unless ( $new_value_id ) {
1761 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1764 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1765 $new_value->Load( $new_value_id );
1767 # now that adding the new value was successful, delete the old one
1769 my ( $val, $msg ) = $old_value->Delete();
1770 return ( 0, $msg ) unless $val;
1773 if ( $args{'RecordTransaction'} ) {
1774 my ( $TransactionId, $Msg, $TransactionObj ) =
1775 $self->_NewTransaction(
1776 Type => 'CustomField',
1778 OldReference => $old_value,
1779 NewReference => $new_value,
1783 my $new_content = $new_value->Content;
1785 # For date, we need to display them in "human" format in result message
1786 if ($cf->Type eq 'Date') {
1787 my $DateObj = new RT::Date( $self->CurrentUser );
1790 Value => $new_content,
1792 $new_content = $DateObj->AsString;
1794 if ( defined $old_content && length $old_content ) {
1797 Value => $old_content,
1799 $old_content = $DateObj->AsString;
1803 unless ( defined $old_content && length $old_content ) {
1804 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1806 elsif ( !defined $new_content || !length $new_content ) {
1807 return ( $new_value_id,
1808 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1811 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1816 # otherwise, just add a new value and record "new value added"
1818 my ($new_value_id, $msg) = $cf->AddValueForObject(
1820 Content => $args{'Value'},
1821 LargeContent => $args{'LargeContent'},
1822 ContentType => $args{'ContentType'},
1825 unless ( $new_value_id ) {
1826 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1828 if ( $args{'RecordTransaction'} ) {
1829 my ( $tid, $msg ) = $self->_NewTransaction(
1830 Type => 'CustomField',
1832 NewReference => $new_value_id,
1833 ReferenceType => 'RT::ObjectCustomFieldValue',
1836 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1839 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1845 # {{{ DeleteCustomFieldValue
1847 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1849 Deletes VALUE as a value of CustomField FIELD.
1851 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1853 If VALUE is not a valid value for the custom field, returns
1854 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1858 sub DeleteCustomFieldValue {
1867 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1868 unless ( $cf->Id ) {
1869 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1872 my ( $val, $msg ) = $cf->DeleteValueForObject(
1874 Id => $args{'ValueId'},
1875 Content => $args{'Value'},
1881 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1882 Type => 'CustomField',
1884 OldReference => $val,
1885 ReferenceType => 'RT::ObjectCustomFieldValue',
1887 unless ($TransactionId) {
1888 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1891 my $old_value = $TransactionObj->OldValue;
1892 # For date, we need to display them in "human" format in result message
1893 if ( $cf->Type eq 'Date' ) {
1894 my $DateObj = new RT::Date( $self->CurrentUser );
1897 Value => $old_value,
1899 $old_value = $DateObj->AsString;
1904 "[_1] is no longer a value for custom field [_2]",
1905 $old_value, $cf->Name
1912 # {{{ FirstCustomFieldValue
1914 =head2 FirstCustomFieldValue FIELD
1916 Return the content of the first value of CustomField FIELD for this ticket
1917 Takes a field id or name
1921 sub FirstCustomFieldValue {
1925 my $values = $self->CustomFieldValues( $field );
1926 return undef unless my $first = $values->First;
1927 return $first->Content;
1930 =head2 CustomFieldValuesAsString FIELD
1932 Return the content of the CustomField FIELD for this ticket.
1933 If this is a multi-value custom field, values will be joined with newlines.
1935 Takes a field id or name as the first argument
1937 Takes an optional Separator => "," second and third argument
1938 if you want to join the values using something other than a newline
1942 sub CustomFieldValuesAsString {
1946 my $separator = $args{Separator} || "\n";
1948 my $values = $self->CustomFieldValues( $field );
1949 return join ($separator, grep { defined $_ }
1950 map { $_->Content } @{$values->ItemsArrayRef});
1954 # {{{ CustomFieldValues
1956 =head2 CustomFieldValues FIELD
1958 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1959 id or Name is FIELD for this record.
1961 Returns an RT::ObjectCustomFieldValues object
1965 sub CustomFieldValues {
1970 my $cf = $self->LoadCustomFieldByIdentifier( $field );
1972 # we were asked to search on a custom field we couldn't find
1973 unless ( $cf->id ) {
1974 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
1975 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1977 return ( $cf->ValuesForObject($self) );
1980 # we're not limiting to a specific custom field;
1981 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1982 $ocfs->LimitToObject( $self );
1986 =head2 LoadCustomFieldByIdentifier IDENTIFER
1988 Find the custom field has id or name IDENTIFIER for this object.
1990 If no valid field is found, returns an empty RT::CustomField object.
1994 sub LoadCustomFieldByIdentifier {
1999 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
2000 $cf = RT::CustomField->new($self->CurrentUser);
2001 $cf->SetContextObject( $self );
2002 $cf->LoadById( $field->id );
2004 elsif ($field =~ /^\d+$/) {
2005 $cf = RT::CustomField->new($self->CurrentUser);
2006 $cf->SetContextObject( $self );
2007 $cf->LoadById($field);
2010 my $cfs = $self->CustomFields($self->CurrentUser);
2011 $cfs->SetContextObject( $self );
2012 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
2013 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
2018 sub ACLEquivalenceObjects { }
2020 sub BasicColumns { }
2023 return RT->Config->Get('WebPath'). "/index.html?q=";
2026 RT::Base->_ImportOverlays();