1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2012 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
76 our $_TABLE_ATTR = { };
77 use base RT->Config->Get('RecordBaseClass');
83 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
84 $self->CurrentUser(@_);
91 The primary keys for RT classes is 'id'
95 sub _PrimaryKeys { return ['id'] }
96 # short circuit many, many thousands of calls from searchbuilder
97 sub _PrimaryKey { 'id' }
101 Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
102 on a very common codepath
104 C<id> is an alias to C<Id> and is the preferred way to call this method.
109 return shift->{'values'}->{id};
116 Delete this record object from the database.
122 my ($rv) = $self->SUPER::Delete;
124 return ($rv, $self->loc("Object deleted"));
127 return(0, $self->loc("Object could not be deleted"))
133 Returns a string which is this object's type. The type is the class,
134 without the "RT::" prefix.
141 if (ref($self) =~ /^.*::(\w+)$/) {
142 return $self->loc($1);
144 return $self->loc(ref($self));
150 Return this object's attributes as an RT::Attributes object
156 unless ($self->{'attributes'}) {
157 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
158 $self->{'attributes'}->LimitToObject($self);
159 $self->{'attributes'}->OrderByCols({FIELD => 'id'});
161 return ($self->{'attributes'});
165 =head2 AddAttribute { Name, Description, Content }
167 Adds a new attribute for this object.
173 my %args = ( Name => undef,
174 Description => undef,
178 my $attr = RT::Attribute->new( $self->CurrentUser );
179 my ( $id, $msg ) = $attr->Create(
181 Name => $args{'Name'},
182 Description => $args{'Description'},
183 Content => $args{'Content'} );
186 # XXX TODO: Why won't RedoSearch work here?
187 $self->Attributes->_DoSearch;
193 =head2 SetAttribute { Name, Description, Content }
195 Like AddAttribute, but replaces all existing attributes with the same Name.
201 my %args = ( Name => undef,
202 Description => undef,
206 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
207 or return $self->AddAttribute( %args );
209 my $AttributeObj = pop( @AttributeObjs );
210 $_->Delete foreach @AttributeObjs;
212 $AttributeObj->SetDescription( $args{'Description'} );
213 $AttributeObj->SetContent( $args{'Content'} );
215 $self->Attributes->RedoSearch;
219 =head2 DeleteAttribute NAME
221 Deletes all attributes with the matching name for this object.
225 sub DeleteAttribute {
228 my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name );
229 $self->ClearAttributes;
233 =head2 FirstAttribute NAME
235 Returns the first attribute with the matching name for this object (as an
236 L<RT::Attribute> object), or C<undef> if no such attributes exist.
237 If there is more than one attribute with the matching name on the
238 object, the first value that was set is returned.
245 return ($self->Attributes->Named( $name ))[0];
249 sub ClearAttributes {
251 delete $self->{'attributes'};
255 sub _Handle { return $RT::Handle }
259 =head2 Create PARAMHASH
261 Takes a PARAMHASH of Column -> Value pairs.
262 If any Column has a Validate$PARAMNAME subroutine defined and the
263 value provided doesn't pass validation, this routine returns
266 If this object's table has any of the following atetributes defined as
267 'Auto', this routine will automatically fill in their values.
286 foreach my $key ( keys %attribs ) {
287 if (my $method = $self->can("Validate$key")) {
288 if (! $method->( $self, $attribs{$key} ) ) {
290 return ( 0, $self->loc('Invalid value for [_1]', $key) );
301 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
304 sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
306 $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
308 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
309 $attribs{'Creator'} = $self->CurrentUser->id || '0';
311 $attribs{'LastUpdated'} = $now_iso
312 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
314 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
315 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
317 my $id = $self->SUPER::Create(%attribs);
318 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
322 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
329 # If the object was created in the database,
330 # load it up now, so we're sure we get what the database
331 # has. Arguably, this should not be necessary, but there
332 # isn't much we can do about it.
336 return ( $id, $self->loc('Object could not be created') );
344 if (UNIVERSAL::isa('errno',$id)) {
348 $self->Load($id) if ($id);
353 return ( $id, $self->loc('Object created') );
365 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
373 # We don't want to hang onto this
374 $self->ClearAttributes;
376 return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
378 # If this database is case sensitive we need to uncase objects for
381 foreach my $key ( keys %hash ) {
383 # If we've been passed an empty value, we can't do the lookup.
384 # We don't need to explicitly downcase integers or an id.
385 if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
386 my ($op, $val, $func);
387 ($key, $op, $val, $func) =
388 $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
389 $hash{$key}->{operator} = $op;
390 $hash{$key}->{value} = $val;
391 $hash{$key}->{function} = $func;
394 return $self->SUPER::LoadByCols( %hash );
399 # There is room for optimizations in most of those subs:
404 my $obj = RT::Date->new( $self->CurrentUser );
406 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
414 my $obj = RT::Date->new( $self->CurrentUser );
416 $obj->Set( Format => 'sql', Value => $self->Created );
423 # TODO: This should be deprecated
427 return ( $self->CreatedObj->AgeAsString() );
432 # TODO this should be deprecated
434 sub LastUpdatedAsString {
436 if ( $self->LastUpdated ) {
437 return ( $self->LastUpdatedObj->AsString() );
447 # TODO This should be deprecated
449 sub CreatedAsString {
451 return ( $self->CreatedObj->AsString() );
456 # TODO This should be deprecated
458 sub LongSinceUpdateAsString {
460 if ( $self->LastUpdated ) {
462 return ( $self->LastUpdatedObj->AgeAsString() );
483 #if the user is trying to modify the record
484 # TODO: document _why_ this code is here
486 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
490 my $old_val = $self->__Value($args{'Field'});
491 $self->_SetLastUpdated();
492 my $ret = $self->SUPER::_Set(
493 Field => $args{'Field'},
494 Value => $args{'Value'},
495 IsSQL => $args{'IsSQL'}
497 my ($status, $msg) = $ret->as_array();
499 # @values has two values, a status code and a message.
501 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
502 # we want to change the standard "success" message
506 "[_1] changed from [_2] to [_3]",
507 $self->loc( $args{'Field'} ),
508 ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
509 '"' . $self->__Value( $args{'Field'}) . '"'
513 $msg = $self->CurrentUser->loc_fuzzy($msg);
515 return wantarray ? ($status, $msg) : $ret;
521 =head2 _SetLastUpdated
523 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
524 It takes no options. Arguably, this is a bug
528 sub _SetLastUpdated {
531 my $now = RT::Date->new( $self->CurrentUser );
534 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
535 my ( $msg, $val ) = $self->__Set(
536 Field => 'LastUpdated',
540 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
541 my ( $msg, $val ) = $self->__Set(
542 Field => 'LastUpdatedBy',
543 Value => $self->CurrentUser->id
552 Returns an RT::User object with the RT account of the creator of this row
558 unless ( exists $self->{'CreatorObj'} ) {
560 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
561 $self->{'CreatorObj'}->Load( $self->Creator );
563 return ( $self->{'CreatorObj'} );
568 =head2 LastUpdatedByObj
570 Returns an RT::User object of the last user to touch this object
574 sub LastUpdatedByObj {
576 unless ( exists $self->{LastUpdatedByObj} ) {
577 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
578 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
580 return $self->{'LastUpdatedByObj'};
587 Returns this record's URI
593 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
594 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 (defined $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);
642 return undef if (!defined $value);
644 if ( $args{'decode_utf8'} ) {
645 if ( !utf8::is_utf8($value) ) {
646 utf8::decode($value);
650 if ( utf8::is_utf8($value) ) {
651 utf8::encode($value);
659 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
664 'cache_for_sec' => 30,
670 sub _BuildTableAttributes {
672 my $class = ref($self) || $self;
675 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
676 $attributes = $self->_CoreAccessible();
677 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
678 $attributes = $self->_ClassAccessible();
682 foreach my $column (keys %$attributes) {
683 foreach my $attr ( keys %{ $attributes->{$column} } ) {
684 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
687 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
688 next unless UNIVERSAL::can( $self, $method );
689 $attributes = $self->$method();
691 foreach my $column ( keys %$attributes ) {
692 foreach my $attr ( keys %{ $attributes->{$column} } ) {
693 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
700 =head2 _ClassAccessible
702 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
703 DBIx::SearchBuilder::Record
707 sub _ClassAccessible {
709 return $_TABLE_ATTR->{ref($self) || $self};
712 =head2 _Accessible COLUMN ATTRIBUTE
714 returns the value of ATTRIBUTE for COLUMN
722 my $attribute = lc(shift);
723 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
724 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
728 =head2 _EncodeLOB BODY MIME_TYPE
730 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
737 my $MIMEType = shift || '';
738 my $Filename = shift;
740 my $ContentEncoding = 'none';
742 #get the max attachment length from RT
743 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
745 #if the current attachment contains nulls and the
746 #database doesn't support embedded nulls
748 if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
750 # set a flag telling us to mimencode the attachment
751 $ContentEncoding = 'base64';
753 #cut the max attchment size by 25% (for mime-encoding overhead.
754 $RT::Logger->debug("Max size is $MaxSize");
755 $MaxSize = $MaxSize * 3 / 4;
756 # Some databases (postgres) can't handle non-utf8 data
757 } elsif ( !$RT::Handle->BinarySafeBLOBs
758 && $MIMEType !~ /text\/plain/gi
759 && !Encode::is_utf8( $Body, 1 ) ) {
760 $ContentEncoding = 'quoted-printable';
763 #if the attachment is larger than the maximum size
764 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
766 # if we're supposed to truncate large attachments
767 if (RT->Config->Get('TruncateLongAttachments')) {
769 # truncate the attachment to that length.
770 $Body = substr( $Body, 0, $MaxSize );
774 # elsif we're supposed to drop large attachments on the floor,
775 elsif (RT->Config->Get('DropLongAttachments')) {
777 # drop the attachment on the floor
778 $RT::Logger->info( "$self: Dropped an attachment of size "
780 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
781 $Filename .= ".txt" if $Filename;
782 return ("none", "Large attachment dropped", "plain/text", $Filename );
786 # if we need to mimencode the attachment
787 if ( $ContentEncoding eq 'base64' ) {
789 # base64 encode the attachment
790 Encode::_utf8_off($Body);
791 $Body = MIME::Base64::encode_base64($Body);
793 } elsif ($ContentEncoding eq 'quoted-printable') {
794 Encode::_utf8_off($Body);
795 $Body = MIME::QuotedPrint::encode($Body);
799 return ($ContentEncoding, $Body, $MIMEType, $Filename );
805 my $ContentType = shift || '';
806 my $ContentEncoding = shift || 'none';
809 if ( $ContentEncoding eq 'base64' ) {
810 $Content = MIME::Base64::decode_base64($Content);
812 elsif ( $ContentEncoding eq 'quoted-printable' ) {
813 $Content = MIME::QuotedPrint::decode($Content);
815 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
816 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
818 if ( RT::I18N::IsTextualContentType($ContentType) ) {
819 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
824 # A helper table for links mapping to make it easier
825 # to build and parse links between tickets
827 use vars '%LINKDIRMAP';
830 MemberOf => { Base => 'MemberOf',
831 Target => 'HasMember', },
832 RefersTo => { Base => 'RefersTo',
833 Target => 'ReferredToBy', },
834 DependsOn => { Base => 'DependsOn',
835 Target => 'DependedOnBy', },
836 MergedInto => { Base => 'MergedInto',
837 Target => 'MergedInto', },
841 =head2 Update ARGSHASH
843 Updates fields on an object for you using the proper Set methods,
844 skipping unchanged values.
846 ARGSRef => a hashref of attributes => value for the update
847 AttributesRef => an arrayref of keys in ARGSRef that should be updated
848 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
849 when looking up values in ARGSRef
850 Bare attributes are tried before prefixed attributes
852 Returns a list of localized results of the update
861 AttributesRef => undef,
862 AttributePrefix => undef,
866 my $attributes = $args{'AttributesRef'};
867 my $ARGSRef = $args{'ARGSRef'};
870 # gather all new values
871 foreach my $attribute (@$attributes) {
873 if ( defined $ARGSRef->{$attribute} ) {
874 $value = $ARGSRef->{$attribute};
877 defined( $args{'AttributePrefix'} )
879 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
882 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
889 $value =~ s/\r\n/\n/gs;
891 # If Queue is 'General', we want to resolve the queue name for
894 # This is in an eval block because $object might not exist.
895 # and might not have a Name method. But "can" won't find autoloaded
896 # items. If it fails, we don't care
898 no warnings "uninitialized";
901 my $object = $attribute . "Obj";
902 my $name = $self->$object->Name;
903 next if $name eq $value || $name eq ($value || 0);
905 next if $value eq $self->$attribute();
906 next if ($value || 0) eq $self->$attribute();
909 $new_values{$attribute} = $value;
912 return $self->_UpdateAttributes(
913 Attributes => $attributes,
914 NewValues => \%new_values,
918 sub _UpdateAttributes {
928 foreach my $attribute (@{ $args{Attributes} }) {
929 next if !exists($args{NewValues}{$attribute});
931 my $value = $args{NewValues}{$attribute};
932 my $method = "Set$attribute";
933 my ( $code, $msg ) = $self->$method($value);
934 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
936 # Default to $id, but use name if we can get it.
937 my $label = $self->id;
938 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
939 # this requires model names to be loc'ed.
950 push @results, $self->loc( $prefix ) . " $label: ". $msg;
954 "[_1] could not be set to [_2].", # loc
955 "That is already the current value", # loc
956 "No value sent to _Set!", # loc
957 "Illegal value for [_1]", # loc
958 "The new value has been set.", # loc
959 "No column specified", # loc
960 "Immutable field", # loc
961 "Nonexistant field?", # loc
962 "Invalid data", # loc
963 "Couldn't find row", # loc
964 "Missing a primary key?: [_1]", # loc
965 "Found Object", # loc
979 This returns an RT::Links object which references all the tickets
980 which are 'MembersOf' this ticket
986 return ( $self->_Links( 'Target', 'MemberOf' ) );
993 This returns an RT::Links object which references all the tickets that this
994 ticket is a 'MemberOf'
1000 return ( $self->_Links( 'Base', 'MemberOf' ) );
1007 This returns an RT::Links object which shows all references for which this ticket is a base
1013 return ( $self->_Links( 'Base', 'RefersTo' ) );
1020 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1026 return ( $self->_Links( 'Target', 'RefersTo' ) );
1033 This returns an RT::Links object which references all the tickets that depend on this one
1039 return ( $self->_Links( 'Target', 'DependsOn' ) );
1045 =head2 HasUnresolvedDependencies
1047 Takes a paramhash of Type (default to '__any'). Returns the number of
1048 unresolved dependencies, if $self->UnresolvedDependencies returns an
1049 object with one or more members of that type. Returns false
1054 sub HasUnresolvedDependencies {
1061 my $deps = $self->UnresolvedDependencies;
1064 $deps->Limit( FIELD => 'Type',
1066 VALUE => $args{Type});
1072 if ($deps->Count > 0) {
1073 return $deps->Count;
1082 =head2 UnresolvedDependencies
1084 Returns an RT::Tickets object of tickets which this ticket depends on
1085 and which have a status of new, open or stalled. (That list comes from
1086 RT::Queue->ActiveStatusArray
1091 sub UnresolvedDependencies {
1093 my $deps = RT::Tickets->new($self->CurrentUser);
1095 my @live_statuses = RT::Queue->ActiveStatusArray();
1096 foreach my $status (@live_statuses) {
1097 $deps->LimitStatus(VALUE => $status);
1099 $deps->LimitDependedOnBy($self->Id);
1107 =head2 AllDependedOnBy
1109 Returns an array of RT::Ticket objects which (directly or indirectly)
1110 depends on this ticket; takes an optional 'Type' argument in the param
1111 hash, which will limit returned tickets to that type, as well as cause
1112 tickets with that type to serve as 'leaf' nodes that stops the recursive
1117 sub AllDependedOnBy {
1119 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1120 Direction => 'Target', @_ );
1125 Returns an array of RT::Ticket objects which this ticket (directly or
1126 indirectly) depends on; takes an optional 'Type' argument in the param
1127 hash, which will limit returned tickets to that type, as well as cause
1128 tickets with that type to serve as 'leaf' nodes that stops the
1129 recursive dependency search.
1135 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1136 Direction => 'Base', @_ );
1139 sub _AllLinkedTickets {
1151 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1152 while (my $link = $dep->Next()) {
1153 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1154 next unless ($uri->IsLocal());
1155 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1156 next if $args{_found}{$obj->Id};
1159 $args{_found}{$obj->Id} = $obj;
1160 $obj->_AllLinkedTickets( %args, _top => 0 );
1162 elsif ($obj->Type and $obj->Type eq $args{Type}) {
1163 $args{_found}{$obj->Id} = $obj;
1166 $obj->_AllLinkedTickets( %args, _top => 0 );
1171 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1182 This returns an RT::Links object which references all the tickets that this ticket depends on
1188 return ( $self->_Links( 'Base', 'DependsOn' ) );
1197 This returns an RT::Links object which references all the customers that
1198 this object is a member of. This includes both explicitly linked customers
1199 and links implied by services.
1204 my( $self, %opt ) = @_;
1205 my $Debug = $opt{'Debug'};
1207 unless ( $self->{'Customers'} ) {
1209 $self->{'Customers'} = $self->MemberOf->Clone;
1211 for my $fstable (qw(cust_main cust_svc)) {
1213 $self->{'Customers'}->Limit(
1215 OPERATOR => 'STARTSWITH',
1216 VALUE => "freeside://freeside/$fstable",
1217 ENTRYAGGREGATOR => 'OR',
1218 SUBCLAUSE => 'customers',
1223 warn "->Customers method called on $self; returning ".
1224 ref($self->{'Customers'}). ' object'
1227 return $self->{'Customers'};
1236 This returns an RT::Links object which references all the services this
1237 object is a member of.
1242 my( $self, %opt ) = @_;
1244 unless ( $self->{'Services'} ) {
1246 $self->{'Services'} = $self->MemberOf->Clone;
1248 $self->{'Services'}->Limit(
1250 OPERATOR => 'STARTSWITH',
1251 VALUE => "freeside://freeside/cust_svc",
1255 return $self->{'Services'};
1263 =head2 Links DIRECTION [TYPE]
1265 Return links (L<RT::Links>) to/from this object.
1267 DIRECTION is either 'Base' or 'Target'.
1269 TYPE is a type of links to return, it can be omitted to get
1274 sub Links { shift->_Links(@_) }
1279 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1282 my $type = shift || "";
1284 unless ( $self->{"$field$type"} ) {
1285 $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1286 # at least to myself
1287 $self->{"$field$type"}->Limit( FIELD => $field,
1288 VALUE => $self->URI,
1289 ENTRYAGGREGATOR => 'OR' );
1290 $self->{"$field$type"}->Limit( FIELD => 'Type',
1294 return ( $self->{"$field$type"} );
1302 Takes a Type and returns a string that is more human readable.
1308 my %args = ( Type => '',
1311 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1312 $args{Type} =~ s/^\s+//;
1321 Takes either a Target or a Base and returns a string of human friendly text.
1327 my %args = ( Object => undef,
1331 my $text = "URI " . $args{FallBack};
1332 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1333 $text = "Ticket " . $args{Object}->id;
1342 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1344 Returns C<link id>, C<message> and C<exist> flag.
1351 my %args = ( Target => '',
1358 # Remote_link is the URI of the object that is not this ticket
1362 if ( $args{'Base'} and $args{'Target'} ) {
1363 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1364 return ( 0, $self->loc("Can't specifiy both base and target") );
1366 elsif ( $args{'Base'} ) {
1367 $args{'Target'} = $self->URI();
1368 $remote_link = $args{'Base'};
1369 $direction = 'Target';
1371 elsif ( $args{'Target'} ) {
1372 $args{'Base'} = $self->URI();
1373 $remote_link = $args{'Target'};
1374 $direction = 'Base';
1377 return ( 0, $self->loc('Either base or target must be specified') );
1380 # Check if the link already exists - we don't want duplicates
1382 my $old_link = RT::Link->new( $self->CurrentUser );
1383 $old_link->LoadByParams( Base => $args{'Base'},
1384 Type => $args{'Type'},
1385 Target => $args{'Target'} );
1386 if ( $old_link->Id ) {
1387 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1388 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1394 # Storing the link in the DB.
1395 my $link = RT::Link->new( $self->CurrentUser );
1396 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1397 Base => $args{Base},
1398 Type => $args{Type} );
1401 $RT::Logger->error("Link could not be created: ".$linkmsg);
1402 return ( 0, $self->loc("Link could not be created") );
1405 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1406 FallBack => $args{Base});
1407 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1408 FallBack => $args{Target});
1409 my $typetext = $self->FormatType(Type => $args{Type});
1411 "$basetext $typetext $targettext.";
1412 return ( $linkid, $TransString ) ;
1419 Delete a link. takes a paramhash of Base, Target and Type.
1420 Either Base or Target must be null. The null value will
1421 be replaced with this ticket\'s id
1434 #we want one of base and target. we don't care which
1435 #but we only want _one_
1440 if ( $args{'Base'} and $args{'Target'} ) {
1441 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1442 return ( 0, $self->loc("Can't specifiy both base and target") );
1444 elsif ( $args{'Base'} ) {
1445 $args{'Target'} = $self->URI();
1446 $remote_link = $args{'Base'};
1447 $direction = 'Target';
1449 elsif ( $args{'Target'} ) {
1450 $args{'Base'} = $self->URI();
1451 $remote_link = $args{'Target'};
1455 $RT::Logger->error("Base or Target must be specified");
1456 return ( 0, $self->loc('Either base or target must be specified') );
1459 my $link = RT::Link->new( $self->CurrentUser );
1460 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1463 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1467 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1468 FallBack => $args{Base});
1469 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1470 FallBack => $args{Target});
1471 my $typetext = $self->FormatType(Type => $args{Type});
1472 my $linkid = $link->id;
1474 my $TransString = "$basetext no longer $typetext $targettext.";
1475 return ( 1, $TransString);
1478 #if it's not a link we can find
1480 $RT::Logger->debug("Couldn't find that link");
1481 return ( 0, $self->loc("Link not found") );
1486 =head1 LockForUpdate
1488 In a database transaction, gains an exclusive lock on the row, to
1489 prevent race conditions. On SQLite, this is a "RESERVED" lock on the
1497 my $pk = $self->_PrimaryKey;
1498 my $id = @_ ? $_[0] : $self->$pk;
1499 $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
1500 if (RT->Config->Get('DatabaseType') eq "SQLite") {
1501 # SQLite does DB-level locking, upgrading the transaction to
1502 # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
1503 # UPDATE to force the upgade.
1504 return RT->DatabaseHandle->dbh->do(
1505 "UPDATE " .$self->Table.
1506 " SET $pk = $pk WHERE 1 = 0");
1508 return $self->_LoadFromSQL(
1509 "SELECT * FROM ".$self->Table
1510 ." WHERE $pk = ? FOR UPDATE",
1516 =head2 _NewTransaction PARAMHASH
1518 Private function to create a new RT::Transaction object for this ticket update
1522 sub _NewTransaction {
1529 OldReference => undef,
1530 NewReference => undef,
1531 ReferenceType => undef,
1535 ActivateScrips => 1,
1537 SquelchMailTo => undef,
1542 my $in_txn = RT->DatabaseHandle->TransactionDepth;
1543 RT->DatabaseHandle->BeginTransaction unless $in_txn;
1545 $self->LockForUpdate;
1547 my $old_ref = $args{'OldReference'};
1548 my $new_ref = $args{'NewReference'};
1549 my $ref_type = $args{'ReferenceType'};
1550 if ($old_ref or $new_ref) {
1551 $ref_type ||= ref($old_ref) || ref($new_ref);
1553 $RT::Logger->error("Reference type not specified for transaction");
1556 $old_ref = $old_ref->Id if ref($old_ref);
1557 $new_ref = $new_ref->Id if ref($new_ref);
1560 require RT::Transaction;
1561 my $trans = RT::Transaction->new( $self->CurrentUser );
1562 my ( $transaction, $msg ) = $trans->Create(
1563 ObjectId => $self->Id,
1564 ObjectType => ref($self),
1565 TimeTaken => $args{'TimeTaken'},
1566 Type => $args{'Type'},
1567 Data => $args{'Data'},
1568 Field => $args{'Field'},
1569 NewValue => $args{'NewValue'},
1570 OldValue => $args{'OldValue'},
1571 NewReference => $new_ref,
1572 OldReference => $old_ref,
1573 ReferenceType => $ref_type,
1574 MIMEObj => $args{'MIMEObj'},
1575 ActivateScrips => $args{'ActivateScrips'},
1576 CommitScrips => $args{'CommitScrips'},
1577 SquelchMailTo => $args{'SquelchMailTo'},
1578 CustomFields => $args{'CustomFields'},
1581 # Rationalize the object since we may have done things to it during the caching.
1582 $self->Load($self->Id);
1584 $RT::Logger->warning($msg) unless $transaction;
1586 $self->_SetLastUpdated;
1588 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1589 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1591 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1592 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1595 RT->DatabaseHandle->Commit unless $in_txn;
1597 return ( $transaction, $msg, $trans );
1604 Returns an RT::Transactions object of all transactions on this record object
1611 use RT::Transactions;
1612 my $transactions = RT::Transactions->new( $self->CurrentUser );
1614 #If the user has no rights, return an empty object
1615 $transactions->Limit(
1616 FIELD => 'ObjectId',
1619 $transactions->Limit(
1620 FIELD => 'ObjectType',
1621 VALUE => ref($self),
1624 return ($transactions);
1631 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1633 $cfs->SetContextObject( $self );
1634 # XXX handle multiple types properly
1635 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1636 $cfs->LimitToGlobalOrObjectId(
1637 $self->_LookupId( $self->CustomFieldLookupType )
1639 $cfs->ApplySortOrder;
1644 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example,
1645 # for RT::IR classes.
1650 my @classes = ($lookup =~ /RT::(\w+)-/g);
1653 foreach my $class (reverse @classes) {
1654 my $method = "${class}Obj";
1655 $object = $object->$method;
1662 =head2 CustomFieldLookupType
1664 Returns the path RT uses to figure out which custom fields apply to this object.
1668 sub CustomFieldLookupType {
1674 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1676 VALUE should be a string. FIELD can be any identifier of a CustomField
1677 supported by L</LoadCustomFieldByIdentifier> method.
1679 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1680 deletes the old value.
1681 If VALUE is not a valid value for the custom field, returns
1682 (0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1683 $id is ID of created L<ObjectCustomFieldValue> object.
1687 sub AddCustomFieldValue {
1689 $self->_AddCustomFieldValue(@_);
1692 sub _AddCustomFieldValue {
1697 LargeContent => undef,
1698 ContentType => undef,
1699 RecordTransaction => 1,
1703 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1704 unless ( $cf->Id ) {
1705 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1708 my $OCFs = $self->CustomFields;
1709 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1710 unless ( $OCFs->Count ) {
1714 "Custom field [_1] does not apply to this object",
1715 ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
1720 # empty string is not correct value of any CF, so undef it
1721 foreach ( qw(Value LargeContent) ) {
1722 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1725 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1726 return ( 0, $self->loc("Invalid value for custom field") );
1729 # If the custom field only accepts a certain # of values, delete the existing
1730 # value and record a "changed from foo to bar" transaction
1731 unless ( $cf->UnlimitedValues ) {
1733 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1734 my $values = $cf->ValuesForObject($self);
1736 # We need to whack any old values here. In most cases, the custom field should
1737 # only have one value to delete. In the pathalogical case, this custom field
1738 # used to be a multiple and we have many values to whack....
1739 my $cf_values = $values->Count;
1741 if ( $cf_values > $cf->MaxValues ) {
1742 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1743 # execute the same code to "change" the value from old to new
1744 while ( my $value = $values->Next ) {
1746 if ( $i < $cf_values ) {
1747 my ( $val, $msg ) = $cf->DeleteValueForObject(
1749 Content => $value->Content
1754 my ( $TransactionId, $Msg, $TransactionObj ) =
1755 $self->_NewTransaction(
1756 Type => 'CustomField',
1758 OldReference => $value,
1762 $values->RedoSearch if $i; # redo search if have deleted at least one value
1765 my ( $old_value, $old_content );
1766 if ( $old_value = $values->First ) {
1767 $old_content = $old_value->Content;
1768 $old_content = undef if defined $old_content && !length $old_content;
1770 my $is_the_same = 1;
1771 if ( defined $args{'Value'} ) {
1772 $is_the_same = 0 unless defined $old_content
1773 && lc $old_content eq lc $args{'Value'};
1775 $is_the_same = 0 if defined $old_content;
1777 if ( $is_the_same ) {
1778 my $old_content = $old_value->LargeContent;
1779 if ( defined $args{'LargeContent'} ) {
1780 $is_the_same = 0 unless defined $old_content
1781 && $old_content eq $args{'LargeContent'};
1783 $is_the_same = 0 if defined $old_content;
1787 return $old_value->id if $is_the_same;
1790 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1792 Content => $args{'Value'},
1793 LargeContent => $args{'LargeContent'},
1794 ContentType => $args{'ContentType'},
1797 unless ( $new_value_id ) {
1798 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1801 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1802 $new_value->Load( $new_value_id );
1804 # now that adding the new value was successful, delete the old one
1806 my ( $val, $msg ) = $old_value->Delete();
1807 return ( 0, $msg ) unless $val;
1810 if ( $args{'RecordTransaction'} ) {
1811 my ( $TransactionId, $Msg, $TransactionObj ) =
1812 $self->_NewTransaction(
1813 Type => 'CustomField',
1815 OldReference => $old_value,
1816 NewReference => $new_value,
1820 my $new_content = $new_value->Content;
1822 # For datetime, we need to display them in "human" format in result message
1823 #XXX TODO how about date without time?
1824 if ($cf->Type eq 'DateTime') {
1825 my $DateObj = RT::Date->new( $self->CurrentUser );
1828 Value => $new_content,
1830 $new_content = $DateObj->AsString;
1832 if ( defined $old_content && length $old_content ) {
1835 Value => $old_content,
1837 $old_content = $DateObj->AsString;
1841 unless ( defined $old_content && length $old_content ) {
1842 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1844 elsif ( !defined $new_content || !length $new_content ) {
1845 return ( $new_value_id,
1846 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1849 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1854 # otherwise, just add a new value and record "new value added"
1856 my ($new_value_id, $msg) = $cf->AddValueForObject(
1858 Content => $args{'Value'},
1859 LargeContent => $args{'LargeContent'},
1860 ContentType => $args{'ContentType'},
1863 unless ( $new_value_id ) {
1864 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1866 if ( $args{'RecordTransaction'} ) {
1867 my ( $tid, $msg ) = $self->_NewTransaction(
1868 Type => 'CustomField',
1870 NewReference => $new_value_id,
1871 ReferenceType => 'RT::ObjectCustomFieldValue',
1874 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1877 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1883 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1885 Deletes VALUE as a value of CustomField FIELD.
1887 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1889 If VALUE is not a valid value for the custom field, returns
1890 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1894 sub DeleteCustomFieldValue {
1903 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1904 unless ( $cf->Id ) {
1905 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1908 my ( $val, $msg ) = $cf->DeleteValueForObject(
1910 Id => $args{'ValueId'},
1911 Content => $args{'Value'},
1917 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1918 Type => 'CustomField',
1920 OldReference => $val,
1921 ReferenceType => 'RT::ObjectCustomFieldValue',
1923 unless ($TransactionId) {
1924 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1927 my $old_value = $TransactionObj->OldValue;
1928 # For datetime, we need to display them in "human" format in result message
1929 if ( $cf->Type eq 'DateTime' ) {
1930 my $DateObj = RT::Date->new( $self->CurrentUser );
1933 Value => $old_value,
1935 $old_value = $DateObj->AsString;
1940 "[_1] is no longer a value for custom field [_2]",
1941 $old_value, $cf->Name
1948 =head2 FirstCustomFieldValue FIELD
1950 Return the content of the first value of CustomField FIELD for this ticket
1951 Takes a field id or name
1955 sub FirstCustomFieldValue {
1959 my $values = $self->CustomFieldValues( $field );
1960 return undef unless my $first = $values->First;
1961 return $first->Content;
1964 =head2 CustomFieldValuesAsString FIELD
1966 Return the content of the CustomField FIELD for this ticket.
1967 If this is a multi-value custom field, values will be joined with newlines.
1969 Takes a field id or name as the first argument
1971 Takes an optional Separator => "," second and third argument
1972 if you want to join the values using something other than a newline
1976 sub CustomFieldValuesAsString {
1980 my $separator = $args{Separator} || "\n";
1982 my $values = $self->CustomFieldValues( $field );
1983 return join ($separator, grep { defined $_ }
1984 map { $_->Content } @{$values->ItemsArrayRef});
1989 =head2 CustomFieldValues FIELD
1991 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1992 id or Name is FIELD for this record.
1994 Returns an RT::ObjectCustomFieldValues object
1998 sub CustomFieldValues {
2003 my $cf = $self->LoadCustomFieldByIdentifier( $field );
2005 # we were asked to search on a custom field we couldn't find
2006 unless ( $cf->id ) {
2007 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
2008 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
2010 return ( $cf->ValuesForObject($self) );
2013 # we're not limiting to a specific custom field;
2014 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
2015 $ocfs->LimitToObject( $self );
2019 =head2 LoadCustomFieldByIdentifier IDENTIFER
2021 Find the custom field has id or name IDENTIFIER for this object.
2023 If no valid field is found, returns an empty RT::CustomField object.
2027 sub LoadCustomFieldByIdentifier {
2032 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
2033 $cf = RT::CustomField->new($self->CurrentUser);
2034 $cf->SetContextObject( $self );
2035 $cf->LoadById( $field->id );
2037 elsif ($field =~ /^\d+$/) {
2038 $cf = RT::CustomField->new($self->CurrentUser);
2039 $cf->SetContextObject( $self );
2040 $cf->LoadById($field);
2043 my $cfs = $self->CustomFields($self->CurrentUser);
2044 $cfs->SetContextObject( $self );
2045 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
2046 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
2051 sub ACLEquivalenceObjects { }
2053 sub BasicColumns { }
2056 return RT->Config->Get('WebPath'). "/index.html?q=";
2059 RT::Base->_ImportOverlays();