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 if ( $args{'decode_utf8'} ) {
643 if ( !utf8::is_utf8($value) ) {
644 utf8::decode($value);
648 if ( utf8::is_utf8($value) ) {
649 utf8::encode($value);
657 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
662 'cache_for_sec' => 30,
668 sub _BuildTableAttributes {
670 my $class = ref($self) || $self;
673 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
674 $attributes = $self->_CoreAccessible();
675 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
676 $attributes = $self->_ClassAccessible();
680 foreach my $column (keys %$attributes) {
681 foreach my $attr ( keys %{ $attributes->{$column} } ) {
682 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
685 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
686 next unless UNIVERSAL::can( $self, $method );
687 $attributes = $self->$method();
689 foreach my $column ( keys %$attributes ) {
690 foreach my $attr ( keys %{ $attributes->{$column} } ) {
691 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
698 =head2 _ClassAccessible
700 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
701 DBIx::SearchBuilder::Record
705 sub _ClassAccessible {
707 return $_TABLE_ATTR->{ref($self) || $self};
710 =head2 _Accessible COLUMN ATTRIBUTE
712 returns the value of ATTRIBUTE for COLUMN
720 my $attribute = lc(shift);
721 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
722 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
726 =head2 _EncodeLOB BODY MIME_TYPE
728 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
735 my $MIMEType = shift || '';
736 my $Filename = shift;
738 my $ContentEncoding = 'none';
740 #get the max attachment length from RT
741 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
743 #if the current attachment contains nulls and the
744 #database doesn't support embedded nulls
746 if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
748 # set a flag telling us to mimencode the attachment
749 $ContentEncoding = 'base64';
751 #cut the max attchment size by 25% (for mime-encoding overhead.
752 $RT::Logger->debug("Max size is $MaxSize");
753 $MaxSize = $MaxSize * 3 / 4;
754 # Some databases (postgres) can't handle non-utf8 data
755 } elsif ( !$RT::Handle->BinarySafeBLOBs
756 && $MIMEType !~ /text\/plain/gi
757 && !Encode::is_utf8( $Body, 1 ) ) {
758 $ContentEncoding = 'quoted-printable';
761 #if the attachment is larger than the maximum size
762 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
764 # if we're supposed to truncate large attachments
765 if (RT->Config->Get('TruncateLongAttachments')) {
767 # truncate the attachment to that length.
768 $Body = substr( $Body, 0, $MaxSize );
772 # elsif we're supposed to drop large attachments on the floor,
773 elsif (RT->Config->Get('DropLongAttachments')) {
775 # drop the attachment on the floor
776 $RT::Logger->info( "$self: Dropped an attachment of size "
778 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
779 $Filename .= ".txt" if $Filename;
780 return ("none", "Large attachment dropped", "plain/text", $Filename );
784 # if we need to mimencode the attachment
785 if ( $ContentEncoding eq 'base64' ) {
787 # base64 encode the attachment
788 Encode::_utf8_off($Body);
789 $Body = MIME::Base64::encode_base64($Body);
791 } elsif ($ContentEncoding eq 'quoted-printable') {
792 Encode::_utf8_off($Body);
793 $Body = MIME::QuotedPrint::encode($Body);
797 return ($ContentEncoding, $Body, $MIMEType, $Filename );
803 my $ContentType = shift || '';
804 my $ContentEncoding = shift || 'none';
807 if ( $ContentEncoding eq 'base64' ) {
808 $Content = MIME::Base64::decode_base64($Content);
810 elsif ( $ContentEncoding eq 'quoted-printable' ) {
811 $Content = MIME::QuotedPrint::decode($Content);
813 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
814 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
816 if ( RT::I18N::IsTextualContentType($ContentType) ) {
817 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
822 # A helper table for links mapping to make it easier
823 # to build and parse links between tickets
825 use vars '%LINKDIRMAP';
828 MemberOf => { Base => 'MemberOf',
829 Target => 'HasMember', },
830 RefersTo => { Base => 'RefersTo',
831 Target => 'ReferredToBy', },
832 DependsOn => { Base => 'DependsOn',
833 Target => 'DependedOnBy', },
834 MergedInto => { Base => 'MergedInto',
835 Target => 'MergedInto', },
839 =head2 Update ARGSHASH
841 Updates fields on an object for you using the proper Set methods,
842 skipping unchanged values.
844 ARGSRef => a hashref of attributes => value for the update
845 AttributesRef => an arrayref of keys in ARGSRef that should be updated
846 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
847 when looking up values in ARGSRef
848 Bare attributes are tried before prefixed attributes
850 Returns a list of localized results of the update
859 AttributesRef => undef,
860 AttributePrefix => undef,
864 my $attributes = $args{'AttributesRef'};
865 my $ARGSRef = $args{'ARGSRef'};
868 # gather all new values
869 foreach my $attribute (@$attributes) {
871 if ( defined $ARGSRef->{$attribute} ) {
872 $value = $ARGSRef->{$attribute};
875 defined( $args{'AttributePrefix'} )
877 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
880 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
887 $value =~ s/\r\n/\n/gs;
889 # If Queue is 'General', we want to resolve the queue name for
892 # This is in an eval block because $object might not exist.
893 # and might not have a Name method. But "can" won't find autoloaded
894 # items. If it fails, we don't care
896 no warnings "uninitialized";
899 my $object = $attribute . "Obj";
900 my $name = $self->$object->Name;
901 next if $name eq $value || $name eq ($value || 0);
903 next if $value eq $self->$attribute();
904 next if ($value || 0) eq $self->$attribute();
907 $new_values{$attribute} = $value;
910 return $self->_UpdateAttributes(
911 Attributes => $attributes,
912 NewValues => \%new_values,
916 sub _UpdateAttributes {
926 foreach my $attribute (@{ $args{Attributes} }) {
927 next if !exists($args{NewValues}{$attribute});
929 my $value = $args{NewValues}{$attribute};
930 my $method = "Set$attribute";
931 my ( $code, $msg ) = $self->$method($value);
932 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
934 # Default to $id, but use name if we can get it.
935 my $label = $self->id;
936 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
937 # this requires model names to be loc'ed.
948 push @results, $self->loc( $prefix ) . " $label: ". $msg;
952 "[_1] could not be set to [_2].", # loc
953 "That is already the current value", # loc
954 "No value sent to _Set!", # loc
955 "Illegal value for [_1]", # loc
956 "The new value has been set.", # loc
957 "No column specified", # loc
958 "Immutable field", # loc
959 "Nonexistant field?", # loc
960 "Invalid data", # loc
961 "Couldn't find row", # loc
962 "Missing a primary key?: [_1]", # loc
963 "Found Object", # loc
977 This returns an RT::Links object which references all the tickets
978 which are 'MembersOf' this ticket
984 return ( $self->_Links( 'Target', 'MemberOf' ) );
991 This returns an RT::Links object which references all the tickets that this
992 ticket is a 'MemberOf'
998 return ( $self->_Links( 'Base', 'MemberOf' ) );
1005 This returns an RT::Links object which shows all references for which this ticket is a base
1011 return ( $self->_Links( 'Base', 'RefersTo' ) );
1018 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1024 return ( $self->_Links( 'Target', 'RefersTo' ) );
1031 This returns an RT::Links object which references all the tickets that depend on this one
1037 return ( $self->_Links( 'Target', 'DependsOn' ) );
1043 =head2 HasUnresolvedDependencies
1045 Takes a paramhash of Type (default to '__any'). Returns the number of
1046 unresolved dependencies, if $self->UnresolvedDependencies returns an
1047 object with one or more members of that type. Returns false
1052 sub HasUnresolvedDependencies {
1059 my $deps = $self->UnresolvedDependencies;
1062 $deps->Limit( FIELD => 'Type',
1064 VALUE => $args{Type});
1070 if ($deps->Count > 0) {
1071 return $deps->Count;
1080 =head2 UnresolvedDependencies
1082 Returns an RT::Tickets object of tickets which this ticket depends on
1083 and which have a status of new, open or stalled. (That list comes from
1084 RT::Queue->ActiveStatusArray
1089 sub UnresolvedDependencies {
1091 my $deps = RT::Tickets->new($self->CurrentUser);
1093 my @live_statuses = RT::Queue->ActiveStatusArray();
1094 foreach my $status (@live_statuses) {
1095 $deps->LimitStatus(VALUE => $status);
1097 $deps->LimitDependedOnBy($self->Id);
1105 =head2 AllDependedOnBy
1107 Returns an array of RT::Ticket objects which (directly or indirectly)
1108 depends on this ticket; takes an optional 'Type' argument in the param
1109 hash, which will limit returned tickets to that type, as well as cause
1110 tickets with that type to serve as 'leaf' nodes that stops the recursive
1115 sub AllDependedOnBy {
1117 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1118 Direction => 'Target', @_ );
1123 Returns an array of RT::Ticket objects which this ticket (directly or
1124 indirectly) depends on; takes an optional 'Type' argument in the param
1125 hash, which will limit returned tickets to that type, as well as cause
1126 tickets with that type to serve as 'leaf' nodes that stops the
1127 recursive dependency search.
1133 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1134 Direction => 'Base', @_ );
1137 sub _AllLinkedTickets {
1149 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1150 while (my $link = $dep->Next()) {
1151 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1152 next unless ($uri->IsLocal());
1153 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1154 next if $args{_found}{$obj->Id};
1157 $args{_found}{$obj->Id} = $obj;
1158 $obj->_AllLinkedTickets( %args, _top => 0 );
1160 elsif ($obj->Type and $obj->Type eq $args{Type}) {
1161 $args{_found}{$obj->Id} = $obj;
1164 $obj->_AllLinkedTickets( %args, _top => 0 );
1169 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1180 This returns an RT::Links object which references all the tickets that this ticket depends on
1186 return ( $self->_Links( 'Base', 'DependsOn' ) );
1195 This returns an RT::Links object which references all the customers that
1196 this object is a member of. This includes both explicitly linked customers
1197 and links implied by services.
1202 my( $self, %opt ) = @_;
1203 my $Debug = $opt{'Debug'};
1205 unless ( $self->{'Customers'} ) {
1207 $self->{'Customers'} = $self->MemberOf->Clone;
1209 for my $fstable (qw(cust_main cust_svc)) {
1211 $self->{'Customers'}->Limit(
1213 OPERATOR => 'STARTSWITH',
1214 VALUE => "freeside://freeside/$fstable",
1215 ENTRYAGGREGATOR => 'OR',
1216 SUBCLAUSE => 'customers',
1221 warn "->Customers method called on $self; returning ".
1222 ref($self->{'Customers'}). ' object'
1225 return $self->{'Customers'};
1234 This returns an RT::Links object which references all the services this
1235 object is a member of.
1240 my( $self, %opt ) = @_;
1242 unless ( $self->{'Services'} ) {
1244 $self->{'Services'} = $self->MemberOf->Clone;
1246 $self->{'Services'}->Limit(
1248 OPERATOR => 'STARTSWITH',
1249 VALUE => "freeside://freeside/cust_svc",
1253 return $self->{'Services'};
1261 =head2 Links DIRECTION [TYPE]
1263 Return links (L<RT::Links>) to/from this object.
1265 DIRECTION is either 'Base' or 'Target'.
1267 TYPE is a type of links to return, it can be omitted to get
1272 sub Links { shift->_Links(@_) }
1277 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1280 my $type = shift || "";
1282 unless ( $self->{"$field$type"} ) {
1283 $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1284 # at least to myself
1285 $self->{"$field$type"}->Limit( FIELD => $field,
1286 VALUE => $self->URI,
1287 ENTRYAGGREGATOR => 'OR' );
1288 $self->{"$field$type"}->Limit( FIELD => 'Type',
1292 return ( $self->{"$field$type"} );
1300 Takes a Type and returns a string that is more human readable.
1306 my %args = ( Type => '',
1309 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1310 $args{Type} =~ s/^\s+//;
1319 Takes either a Target or a Base and returns a string of human friendly text.
1325 my %args = ( Object => undef,
1329 my $text = "URI " . $args{FallBack};
1330 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1331 $text = "Ticket " . $args{Object}->id;
1340 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1342 Returns C<link id>, C<message> and C<exist> flag.
1349 my %args = ( Target => '',
1356 # Remote_link is the URI of the object that is not this ticket
1360 if ( $args{'Base'} and $args{'Target'} ) {
1361 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1362 return ( 0, $self->loc("Can't specifiy both base and target") );
1364 elsif ( $args{'Base'} ) {
1365 $args{'Target'} = $self->URI();
1366 $remote_link = $args{'Base'};
1367 $direction = 'Target';
1369 elsif ( $args{'Target'} ) {
1370 $args{'Base'} = $self->URI();
1371 $remote_link = $args{'Target'};
1372 $direction = 'Base';
1375 return ( 0, $self->loc('Either base or target must be specified') );
1378 # Check if the link already exists - we don't want duplicates
1380 my $old_link = RT::Link->new( $self->CurrentUser );
1381 $old_link->LoadByParams( Base => $args{'Base'},
1382 Type => $args{'Type'},
1383 Target => $args{'Target'} );
1384 if ( $old_link->Id ) {
1385 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1386 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1392 # Storing the link in the DB.
1393 my $link = RT::Link->new( $self->CurrentUser );
1394 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1395 Base => $args{Base},
1396 Type => $args{Type} );
1399 $RT::Logger->error("Link could not be created: ".$linkmsg);
1400 return ( 0, $self->loc("Link could not be created") );
1403 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1404 FallBack => $args{Base});
1405 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1406 FallBack => $args{Target});
1407 my $typetext = $self->FormatType(Type => $args{Type});
1409 "$basetext $typetext $targettext.";
1410 return ( $linkid, $TransString ) ;
1417 Delete a link. takes a paramhash of Base, Target and Type.
1418 Either Base or Target must be null. The null value will
1419 be replaced with this ticket\'s id
1432 #we want one of base and target. we don't care which
1433 #but we only want _one_
1438 if ( $args{'Base'} and $args{'Target'} ) {
1439 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1440 return ( 0, $self->loc("Can't specifiy both base and target") );
1442 elsif ( $args{'Base'} ) {
1443 $args{'Target'} = $self->URI();
1444 $remote_link = $args{'Base'};
1445 $direction = 'Target';
1447 elsif ( $args{'Target'} ) {
1448 $args{'Base'} = $self->URI();
1449 $remote_link = $args{'Target'};
1453 $RT::Logger->error("Base or Target must be specified");
1454 return ( 0, $self->loc('Either base or target must be specified') );
1457 my $link = RT::Link->new( $self->CurrentUser );
1458 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1461 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1465 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1466 FallBack => $args{Base});
1467 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1468 FallBack => $args{Target});
1469 my $typetext = $self->FormatType(Type => $args{Type});
1470 my $linkid = $link->id;
1472 my $TransString = "$basetext no longer $typetext $targettext.";
1473 return ( 1, $TransString);
1476 #if it's not a link we can find
1478 $RT::Logger->debug("Couldn't find that link");
1479 return ( 0, $self->loc("Link not found") );
1487 =head2 _NewTransaction PARAMHASH
1489 Private function to create a new RT::Transaction object for this ticket update
1493 sub _NewTransaction {
1500 OldReference => undef,
1501 NewReference => undef,
1502 ReferenceType => undef,
1506 ActivateScrips => 1,
1508 SquelchMailTo => undef,
1513 my $old_ref = $args{'OldReference'};
1514 my $new_ref = $args{'NewReference'};
1515 my $ref_type = $args{'ReferenceType'};
1516 if ($old_ref or $new_ref) {
1517 $ref_type ||= ref($old_ref) || ref($new_ref);
1519 $RT::Logger->error("Reference type not specified for transaction");
1522 $old_ref = $old_ref->Id if ref($old_ref);
1523 $new_ref = $new_ref->Id if ref($new_ref);
1526 require RT::Transaction;
1527 my $trans = RT::Transaction->new( $self->CurrentUser );
1528 my ( $transaction, $msg ) = $trans->Create(
1529 ObjectId => $self->Id,
1530 ObjectType => ref($self),
1531 TimeTaken => $args{'TimeTaken'},
1532 Type => $args{'Type'},
1533 Data => $args{'Data'},
1534 Field => $args{'Field'},
1535 NewValue => $args{'NewValue'},
1536 OldValue => $args{'OldValue'},
1537 NewReference => $new_ref,
1538 OldReference => $old_ref,
1539 ReferenceType => $ref_type,
1540 MIMEObj => $args{'MIMEObj'},
1541 ActivateScrips => $args{'ActivateScrips'},
1542 CommitScrips => $args{'CommitScrips'},
1543 SquelchMailTo => $args{'SquelchMailTo'},
1544 CustomFields => $args{'CustomFields'},
1547 # Rationalize the object since we may have done things to it during the caching.
1548 $self->Load($self->Id);
1550 $RT::Logger->warning($msg) unless $transaction;
1552 $self->_SetLastUpdated;
1554 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1555 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1557 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1558 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1560 return ( $transaction, $msg, $trans );
1567 Returns an RT::Transactions object of all transactions on this record object
1574 use RT::Transactions;
1575 my $transactions = RT::Transactions->new( $self->CurrentUser );
1577 #If the user has no rights, return an empty object
1578 $transactions->Limit(
1579 FIELD => 'ObjectId',
1582 $transactions->Limit(
1583 FIELD => 'ObjectType',
1584 VALUE => ref($self),
1587 return ($transactions);
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,
1608 # for RT::IR classes.
1613 my @classes = ($lookup =~ /RT::(\w+)-/g);
1616 foreach my $class (reverse @classes) {
1617 my $method = "${class}Obj";
1618 $object = $object->$method;
1625 =head2 CustomFieldLookupType
1627 Returns the path RT uses to figure out which custom fields apply to this object.
1631 sub CustomFieldLookupType {
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 datetime, we need to display them in "human" format in result message
1786 #XXX TODO how about date without time?
1787 if ($cf->Type eq 'DateTime') {
1788 my $DateObj = RT::Date->new( $self->CurrentUser );
1791 Value => $new_content,
1793 $new_content = $DateObj->AsString;
1795 if ( defined $old_content && length $old_content ) {
1798 Value => $old_content,
1800 $old_content = $DateObj->AsString;
1804 unless ( defined $old_content && length $old_content ) {
1805 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1807 elsif ( !defined $new_content || !length $new_content ) {
1808 return ( $new_value_id,
1809 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1812 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1817 # otherwise, just add a new value and record "new value added"
1819 my ($new_value_id, $msg) = $cf->AddValueForObject(
1821 Content => $args{'Value'},
1822 LargeContent => $args{'LargeContent'},
1823 ContentType => $args{'ContentType'},
1826 unless ( $new_value_id ) {
1827 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1829 if ( $args{'RecordTransaction'} ) {
1830 my ( $tid, $msg ) = $self->_NewTransaction(
1831 Type => 'CustomField',
1833 NewReference => $new_value_id,
1834 ReferenceType => 'RT::ObjectCustomFieldValue',
1837 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1840 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1846 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1848 Deletes VALUE as a value of CustomField FIELD.
1850 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1852 If VALUE is not a valid value for the custom field, returns
1853 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1857 sub DeleteCustomFieldValue {
1866 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1867 unless ( $cf->Id ) {
1868 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1871 my ( $val, $msg ) = $cf->DeleteValueForObject(
1873 Id => $args{'ValueId'},
1874 Content => $args{'Value'},
1880 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1881 Type => 'CustomField',
1883 OldReference => $val,
1884 ReferenceType => 'RT::ObjectCustomFieldValue',
1886 unless ($TransactionId) {
1887 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1890 my $old_value = $TransactionObj->OldValue;
1891 # For datetime, we need to display them in "human" format in result message
1892 if ( $cf->Type eq 'DateTime' ) {
1893 my $DateObj = RT::Date->new( $self->CurrentUser );
1896 Value => $old_value,
1898 $old_value = $DateObj->AsString;
1903 "[_1] is no longer a value for custom field [_2]",
1904 $old_value, $cf->Name
1911 =head2 FirstCustomFieldValue FIELD
1913 Return the content of the first value of CustomField FIELD for this ticket
1914 Takes a field id or name
1918 sub FirstCustomFieldValue {
1922 my $values = $self->CustomFieldValues( $field );
1923 return undef unless my $first = $values->First;
1924 return $first->Content;
1927 =head2 CustomFieldValuesAsString FIELD
1929 Return the content of the CustomField FIELD for this ticket.
1930 If this is a multi-value custom field, values will be joined with newlines.
1932 Takes a field id or name as the first argument
1934 Takes an optional Separator => "," second and third argument
1935 if you want to join the values using something other than a newline
1939 sub CustomFieldValuesAsString {
1943 my $separator = $args{Separator} || "\n";
1945 my $values = $self->CustomFieldValues( $field );
1946 return join ($separator, grep { defined $_ }
1947 map { $_->Content } @{$values->ItemsArrayRef});
1952 =head2 CustomFieldValues FIELD
1954 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1955 id or Name is FIELD for this record.
1957 Returns an RT::ObjectCustomFieldValues object
1961 sub CustomFieldValues {
1966 my $cf = $self->LoadCustomFieldByIdentifier( $field );
1968 # we were asked to search on a custom field we couldn't find
1969 unless ( $cf->id ) {
1970 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
1971 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1973 return ( $cf->ValuesForObject($self) );
1976 # we're not limiting to a specific custom field;
1977 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1978 $ocfs->LimitToObject( $self );
1982 =head2 LoadCustomFieldByIdentifier IDENTIFER
1984 Find the custom field has id or name IDENTIFIER for this object.
1986 If no valid field is found, returns an empty RT::CustomField object.
1990 sub LoadCustomFieldByIdentifier {
1995 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1996 $cf = RT::CustomField->new($self->CurrentUser);
1997 $cf->SetContextObject( $self );
1998 $cf->LoadById( $field->id );
2000 elsif ($field =~ /^\d+$/) {
2001 $cf = RT::CustomField->new($self->CurrentUser);
2002 $cf->SetContextObject( $self );
2003 $cf->LoadById($field);
2006 my $cfs = $self->CustomFields($self->CurrentUser);
2007 $cfs->SetContextObject( $self );
2008 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
2009 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
2014 sub ACLEquivalenceObjects { }
2016 sub BasicColumns { }
2019 return RT->Config->Get('WebPath'). "/index.html?q=";
2022 RT::Base->_ImportOverlays();