1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2013 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
504 if ($self->SQLType( $args{'Field'}) =~ /text/) {
507 $self->loc( $args{'Field'} ),
511 "[_1] changed from [_2] to [_3]",
512 $self->loc( $args{'Field'} ),
513 ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
514 '"' . $self->__Value( $args{'Field'}) . '"',
518 $msg = $self->CurrentUser->loc_fuzzy($msg);
521 return wantarray ? ($status, $msg) : $ret;
526 =head2 _SetLastUpdated
528 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
529 It takes no options. Arguably, this is a bug
533 sub _SetLastUpdated {
536 my $now = RT::Date->new( $self->CurrentUser );
539 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
540 my ( $msg, $val ) = $self->__Set(
541 Field => 'LastUpdated',
545 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
546 my ( $msg, $val ) = $self->__Set(
547 Field => 'LastUpdatedBy',
548 Value => $self->CurrentUser->id
557 Returns an RT::User object with the RT account of the creator of this row
563 unless ( exists $self->{'CreatorObj'} ) {
565 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
566 $self->{'CreatorObj'}->Load( $self->Creator );
568 return ( $self->{'CreatorObj'} );
573 =head2 LastUpdatedByObj
575 Returns an RT::User object of the last user to touch this object
579 sub LastUpdatedByObj {
581 unless ( exists $self->{LastUpdatedByObj} ) {
582 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
583 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
585 return $self->{'LastUpdatedByObj'};
592 Returns this record's URI
598 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
599 return($uri->URIForObject($self));
603 =head2 ValidateName NAME
605 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
612 if (defined $value && $value=~ /^\d+$/) {
621 =head2 SQLType attribute
623 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
631 return ($self->_Accessible($field, 'type'));
639 my %args = ( decode_utf8 => 1, @_ );
642 $RT::Logger->error("__Value called with undef field");
645 my $value = $self->SUPER::__Value($field);
647 return undef if (!defined $value);
649 if ( $args{'decode_utf8'} ) {
650 if ( !utf8::is_utf8($value) ) {
651 utf8::decode($value);
655 if ( utf8::is_utf8($value) ) {
656 utf8::encode($value);
664 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
669 'cache_for_sec' => 30,
675 sub _BuildTableAttributes {
677 my $class = ref($self) || $self;
680 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
681 $attributes = $self->_CoreAccessible();
682 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
683 $attributes = $self->_ClassAccessible();
687 foreach my $column (keys %$attributes) {
688 foreach my $attr ( keys %{ $attributes->{$column} } ) {
689 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
692 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
693 next unless UNIVERSAL::can( $self, $method );
694 $attributes = $self->$method();
696 foreach my $column ( keys %$attributes ) {
697 foreach my $attr ( keys %{ $attributes->{$column} } ) {
698 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
705 =head2 _ClassAccessible
707 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
708 DBIx::SearchBuilder::Record
712 sub _ClassAccessible {
714 return $_TABLE_ATTR->{ref($self) || $self};
717 =head2 _Accessible COLUMN ATTRIBUTE
719 returns the value of ATTRIBUTE for COLUMN
727 my $attribute = lc(shift);
728 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
729 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
733 =head2 _EncodeLOB BODY MIME_TYPE
735 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
742 my $MIMEType = shift || '';
743 my $Filename = shift;
745 my $ContentEncoding = 'none';
747 #get the max attachment length from RT
748 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
750 #if the current attachment contains nulls and the
751 #database doesn't support embedded nulls
753 if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
755 # set a flag telling us to mimencode the attachment
756 $ContentEncoding = 'base64';
758 #cut the max attchment size by 25% (for mime-encoding overhead.
759 $RT::Logger->debug("Max size is $MaxSize");
760 $MaxSize = $MaxSize * 3 / 4;
761 # Some databases (postgres) can't handle non-utf8 data
762 } elsif ( !$RT::Handle->BinarySafeBLOBs
763 && $MIMEType !~ /text\/plain/gi
764 && !Encode::is_utf8( $Body, 1 ) ) {
765 $ContentEncoding = 'quoted-printable';
768 #if the attachment is larger than the maximum size
769 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
771 # if we're supposed to truncate large attachments
772 if (RT->Config->Get('TruncateLongAttachments')) {
774 # truncate the attachment to that length.
775 $Body = substr( $Body, 0, $MaxSize );
779 # elsif we're supposed to drop large attachments on the floor,
780 elsif (RT->Config->Get('DropLongAttachments')) {
782 # drop the attachment on the floor
783 $RT::Logger->info( "$self: Dropped an attachment of size "
785 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
786 $Filename .= ".txt" if $Filename;
787 return ("none", "Large attachment dropped", "plain/text", $Filename );
791 # if we need to mimencode the attachment
792 if ( $ContentEncoding eq 'base64' ) {
794 # base64 encode the attachment
795 Encode::_utf8_off($Body);
796 $Body = MIME::Base64::encode_base64($Body);
798 } elsif ($ContentEncoding eq 'quoted-printable') {
799 Encode::_utf8_off($Body);
800 $Body = MIME::QuotedPrint::encode($Body);
804 return ($ContentEncoding, $Body, $MIMEType, $Filename );
810 my $ContentType = shift || '';
811 my $ContentEncoding = shift || 'none';
814 if ( $ContentEncoding eq 'base64' ) {
815 $Content = MIME::Base64::decode_base64($Content);
817 elsif ( $ContentEncoding eq 'quoted-printable' ) {
818 $Content = MIME::QuotedPrint::decode($Content);
820 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
821 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
823 if ( RT::I18N::IsTextualContentType($ContentType) ) {
824 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
829 # A helper table for links mapping to make it easier
830 # to build and parse links between tickets
832 use vars '%LINKDIRMAP';
835 MemberOf => { Base => 'MemberOf',
836 Target => 'HasMember', },
837 RefersTo => { Base => 'RefersTo',
838 Target => 'ReferredToBy', },
839 DependsOn => { Base => 'DependsOn',
840 Target => 'DependedOnBy', },
841 MergedInto => { Base => 'MergedInto',
842 Target => 'MergedInto', },
846 =head2 Update ARGSHASH
848 Updates fields on an object for you using the proper Set methods,
849 skipping unchanged values.
851 ARGSRef => a hashref of attributes => value for the update
852 AttributesRef => an arrayref of keys in ARGSRef that should be updated
853 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
854 when looking up values in ARGSRef
855 Bare attributes are tried before prefixed attributes
857 Returns a list of localized results of the update
866 AttributesRef => undef,
867 AttributePrefix => undef,
871 my $attributes = $args{'AttributesRef'};
872 my $ARGSRef = $args{'ARGSRef'};
875 # gather all new values
876 foreach my $attribute (@$attributes) {
878 if ( defined $ARGSRef->{$attribute} ) {
879 $value = $ARGSRef->{$attribute};
882 defined( $args{'AttributePrefix'} )
884 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
887 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
894 $value =~ s/\r\n/\n/gs;
896 my $truncated_value = $self->TruncateValue($attribute, $value);
898 # If Queue is 'General', we want to resolve the queue name for
901 # This is in an eval block because $object might not exist.
902 # and might not have a Name method. But "can" won't find autoloaded
903 # items. If it fails, we don't care
905 no warnings "uninitialized";
908 my $object = $attribute . "Obj";
909 my $name = $self->$object->Name;
910 next if $name eq $value || $name eq ($value || 0);
913 my $current = $self->$attribute();
914 # RT::Queue->Lifecycle returns a Lifecycle object instead of name
915 $current = eval { $current->Name } if ref $current;
916 next if $truncated_value eq $current;
917 next if ( $truncated_value || 0 ) eq $current;
920 $new_values{$attribute} = $value;
923 return $self->_UpdateAttributes(
924 Attributes => $attributes,
925 NewValues => \%new_values,
929 sub _UpdateAttributes {
939 foreach my $attribute (@{ $args{Attributes} }) {
940 next if !exists($args{NewValues}{$attribute});
942 my $value = $args{NewValues}{$attribute};
943 my $method = "Set$attribute";
944 my ( $code, $msg ) = $self->$method($value);
945 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
947 # Default to $id, but use name if we can get it.
948 my $label = $self->id;
949 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
950 # this requires model names to be loc'ed.
961 push @results, $self->loc( $prefix ) . " $label: ". $msg;
965 "[_1] could not be set to [_2].", # loc
966 "That is already the current value", # loc
967 "No value sent to _Set!", # loc
968 "Illegal value for [_1]", # loc
969 "The new value has been set.", # loc
970 "No column specified", # loc
971 "Immutable field", # loc
972 "Nonexistant field?", # loc
973 "Invalid data", # loc
974 "Couldn't find row", # loc
975 "Missing a primary key?: [_1]", # loc
976 "Found Object", # loc
990 This returns an RT::Links object which references all the tickets
991 which are 'MembersOf' this ticket
997 return ( $self->_Links( 'Target', 'MemberOf' ) );
1004 This returns an RT::Links object which references all the tickets that this
1005 ticket is a 'MemberOf'
1011 return ( $self->_Links( 'Base', 'MemberOf' ) );
1018 This returns an RT::Links object which shows all references for which this ticket is a base
1024 return ( $self->_Links( 'Base', 'RefersTo' ) );
1031 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1037 return ( $self->_Links( 'Target', 'RefersTo' ) );
1044 This returns an RT::Links object which references all the tickets that depend on this one
1050 return ( $self->_Links( 'Target', 'DependsOn' ) );
1056 =head2 HasUnresolvedDependencies
1058 Takes a paramhash of Type (default to '__any'). Returns the number of
1059 unresolved dependencies, if $self->UnresolvedDependencies returns an
1060 object with one or more members of that type. Returns false
1065 sub HasUnresolvedDependencies {
1072 my $deps = $self->UnresolvedDependencies;
1075 $deps->Limit( FIELD => 'Type',
1077 VALUE => $args{Type});
1083 if ($deps->Count > 0) {
1084 return $deps->Count;
1093 =head2 UnresolvedDependencies
1095 Returns an RT::Tickets object of tickets which this ticket depends on
1096 and which have a status of new, open or stalled. (That list comes from
1097 RT::Queue->ActiveStatusArray
1102 sub UnresolvedDependencies {
1104 my $deps = RT::Tickets->new($self->CurrentUser);
1106 my @live_statuses = RT::Queue->ActiveStatusArray();
1107 foreach my $status (@live_statuses) {
1108 $deps->LimitStatus(VALUE => $status);
1110 $deps->LimitDependedOnBy($self->Id);
1118 =head2 AllDependedOnBy
1120 Returns an array of RT::Ticket objects which (directly or indirectly)
1121 depends on this ticket; takes an optional 'Type' argument in the param
1122 hash, which will limit returned tickets to that type, as well as cause
1123 tickets with that type to serve as 'leaf' nodes that stops the recursive
1128 sub AllDependedOnBy {
1130 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1131 Direction => 'Target', @_ );
1136 Returns an array of RT::Ticket objects which this ticket (directly or
1137 indirectly) depends on; takes an optional 'Type' argument in the param
1138 hash, which will limit returned tickets to that type, as well as cause
1139 tickets with that type to serve as 'leaf' nodes that stops the
1140 recursive dependency search.
1146 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1147 Direction => 'Base', @_ );
1150 sub _AllLinkedTickets {
1162 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1163 while (my $link = $dep->Next()) {
1164 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1165 next unless ($uri->IsLocal());
1166 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1167 next if $args{_found}{$obj->Id};
1170 $args{_found}{$obj->Id} = $obj;
1171 $obj->_AllLinkedTickets( %args, _top => 0 );
1173 elsif ($obj->Type and $obj->Type eq $args{Type}) {
1174 $args{_found}{$obj->Id} = $obj;
1177 $obj->_AllLinkedTickets( %args, _top => 0 );
1182 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1193 This returns an RT::Links object which references all the tickets that this ticket depends on
1199 return ( $self->_Links( 'Base', 'DependsOn' ) );
1208 This returns an RT::Links object which references all the customers that
1209 this object is a member of. This includes both explicitly linked customers
1210 and links implied by services.
1215 my( $self, %opt ) = @_;
1216 my $Debug = $opt{'Debug'};
1218 unless ( $self->{'Customers'} ) {
1220 $self->{'Customers'} = $self->MemberOf->Clone;
1222 for my $fstable (qw(cust_main cust_svc)) {
1224 $self->{'Customers'}->Limit(
1226 OPERATOR => 'STARTSWITH',
1227 VALUE => "freeside://freeside/$fstable",
1228 ENTRYAGGREGATOR => 'OR',
1229 SUBCLAUSE => 'customers',
1234 warn "->Customers method called on $self; returning ".
1235 ref($self->{'Customers'}). ' object'
1238 return $self->{'Customers'};
1247 This returns an RT::Links object which references all the services this
1248 object is a member of.
1253 my( $self, %opt ) = @_;
1255 unless ( $self->{'Services'} ) {
1257 $self->{'Services'} = $self->MemberOf->Clone;
1259 $self->{'Services'}->Limit(
1261 OPERATOR => 'STARTSWITH',
1262 VALUE => "freeside://freeside/cust_svc",
1266 return $self->{'Services'};
1274 =head2 Links DIRECTION [TYPE]
1276 Return links (L<RT::Links>) to/from this object.
1278 DIRECTION is either 'Base' or 'Target'.
1280 TYPE is a type of links to return, it can be omitted to get
1285 sub Links { shift->_Links(@_) }
1290 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1293 my $type = shift || "";
1295 unless ( $self->{"$field$type"} ) {
1296 $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1297 # at least to myself
1298 $self->{"$field$type"}->Limit( FIELD => $field,
1299 VALUE => $self->URI,
1300 ENTRYAGGREGATOR => 'OR' );
1301 $self->{"$field$type"}->Limit( FIELD => 'Type',
1305 return ( $self->{"$field$type"} );
1313 Takes a Type and returns a string that is more human readable.
1319 my %args = ( Type => '',
1322 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1323 $args{Type} =~ s/^\s+//;
1332 Takes either a Target or a Base and returns a string of human friendly text.
1338 my %args = ( Object => undef,
1342 my $text = "URI " . $args{FallBack};
1343 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1344 $text = "Ticket " . $args{Object}->id;
1353 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1355 Returns C<link id>, C<message> and C<exist> flag.
1362 my %args = ( Target => '',
1369 # Remote_link is the URI of the object that is not this ticket
1373 if ( $args{'Base'} and $args{'Target'} ) {
1374 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1375 return ( 0, $self->loc("Can't specifiy both base and target") );
1377 elsif ( $args{'Base'} ) {
1378 $args{'Target'} = $self->URI();
1379 $remote_link = $args{'Base'};
1380 $direction = 'Target';
1382 elsif ( $args{'Target'} ) {
1383 $args{'Base'} = $self->URI();
1384 $remote_link = $args{'Target'};
1385 $direction = 'Base';
1388 return ( 0, $self->loc('Either base or target must be specified') );
1391 # Check if the link already exists - we don't want duplicates
1393 my $old_link = RT::Link->new( $self->CurrentUser );
1394 $old_link->LoadByParams( Base => $args{'Base'},
1395 Type => $args{'Type'},
1396 Target => $args{'Target'} );
1397 if ( $old_link->Id ) {
1398 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1399 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1405 # Storing the link in the DB.
1406 my $link = RT::Link->new( $self->CurrentUser );
1407 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1408 Base => $args{Base},
1409 Type => $args{Type} );
1412 $RT::Logger->error("Link could not be created: ".$linkmsg);
1413 return ( 0, $self->loc("Link could not be created") );
1416 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1417 FallBack => $args{Base});
1418 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1419 FallBack => $args{Target});
1420 my $typetext = $self->FormatType(Type => $args{Type});
1422 "$basetext $typetext $targettext.";
1423 return ( $linkid, $TransString ) ;
1430 Delete a link. takes a paramhash of Base, Target and Type.
1431 Either Base or Target must be null. The null value will
1432 be replaced with this ticket's id
1445 #we want one of base and target. we don't care which
1446 #but we only want _one_
1451 if ( $args{'Base'} and $args{'Target'} ) {
1452 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1453 return ( 0, $self->loc("Can't specifiy both base and target") );
1455 elsif ( $args{'Base'} ) {
1456 $args{'Target'} = $self->URI();
1457 $remote_link = $args{'Base'};
1458 $direction = 'Target';
1460 elsif ( $args{'Target'} ) {
1461 $args{'Base'} = $self->URI();
1462 $remote_link = $args{'Target'};
1466 $RT::Logger->error("Base or Target must be specified");
1467 return ( 0, $self->loc('Either base or target must be specified') );
1470 my $link = RT::Link->new( $self->CurrentUser );
1471 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1474 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1478 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1479 FallBack => $args{Base});
1480 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1481 FallBack => $args{Target});
1482 my $typetext = $self->FormatType(Type => $args{Type});
1483 my $linkid = $link->id;
1485 my $TransString = "$basetext no longer $typetext $targettext.";
1486 return ( 1, $TransString);
1489 #if it's not a link we can find
1491 $RT::Logger->debug("Couldn't find that link");
1492 return ( 0, $self->loc("Link not found") );
1497 =head1 LockForUpdate
1499 In a database transaction, gains an exclusive lock on the row, to
1500 prevent race conditions. On SQLite, this is a "RESERVED" lock on the
1508 my $pk = $self->_PrimaryKey;
1509 my $id = @_ ? $_[0] : $self->$pk;
1510 $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
1511 if (RT->Config->Get('DatabaseType') eq "SQLite") {
1512 # SQLite does DB-level locking, upgrading the transaction to
1513 # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
1514 # UPDATE to force the upgade.
1515 return RT->DatabaseHandle->dbh->do(
1516 "UPDATE " .$self->Table.
1517 " SET $pk = $pk WHERE 1 = 0");
1519 return $self->_LoadFromSQL(
1520 "SELECT * FROM ".$self->Table
1521 ." WHERE $pk = ? FOR UPDATE",
1527 =head2 _NewTransaction PARAMHASH
1529 Private function to create a new RT::Transaction object for this ticket update
1533 sub _NewTransaction {
1540 OldReference => undef,
1541 NewReference => undef,
1542 ReferenceType => undef,
1546 ActivateScrips => 1,
1548 SquelchMailTo => undef,
1553 my $in_txn = RT->DatabaseHandle->TransactionDepth;
1554 RT->DatabaseHandle->BeginTransaction unless $in_txn;
1556 $self->LockForUpdate;
1558 my $old_ref = $args{'OldReference'};
1559 my $new_ref = $args{'NewReference'};
1560 my $ref_type = $args{'ReferenceType'};
1561 if ($old_ref or $new_ref) {
1562 $ref_type ||= ref($old_ref) || ref($new_ref);
1564 $RT::Logger->error("Reference type not specified for transaction");
1567 $old_ref = $old_ref->Id if ref($old_ref);
1568 $new_ref = $new_ref->Id if ref($new_ref);
1571 require RT::Transaction;
1572 my $trans = RT::Transaction->new( $self->CurrentUser );
1573 my ( $transaction, $msg ) = $trans->Create(
1574 ObjectId => $self->Id,
1575 ObjectType => ref($self),
1576 TimeTaken => $args{'TimeTaken'},
1577 Type => $args{'Type'},
1578 Data => $args{'Data'},
1579 Field => $args{'Field'},
1580 NewValue => $args{'NewValue'},
1581 OldValue => $args{'OldValue'},
1582 NewReference => $new_ref,
1583 OldReference => $old_ref,
1584 ReferenceType => $ref_type,
1585 MIMEObj => $args{'MIMEObj'},
1586 ActivateScrips => $args{'ActivateScrips'},
1587 CommitScrips => $args{'CommitScrips'},
1588 SquelchMailTo => $args{'SquelchMailTo'},
1589 CustomFields => $args{'CustomFields'},
1592 # Rationalize the object since we may have done things to it during the caching.
1593 $self->Load($self->Id);
1595 $RT::Logger->warning($msg) unless $transaction;
1597 $self->_SetLastUpdated;
1599 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1600 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1602 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1603 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1606 RT->DatabaseHandle->Commit unless $in_txn;
1608 return ( $transaction, $msg, $trans );
1615 Returns an RT::Transactions object of all transactions on this record object
1622 use RT::Transactions;
1623 my $transactions = RT::Transactions->new( $self->CurrentUser );
1625 #If the user has no rights, return an empty object
1626 $transactions->Limit(
1627 FIELD => 'ObjectId',
1630 $transactions->Limit(
1631 FIELD => 'ObjectType',
1632 VALUE => ref($self),
1635 return ($transactions);
1642 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1644 $cfs->SetContextObject( $self );
1645 # XXX handle multiple types properly
1646 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1647 $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId );
1648 $cfs->ApplySortOrder;
1653 # TODO: This _only_ works for RT::Foo classes. it doesn't work, for
1654 # example, for RT::IR::Foo classes.
1656 sub CustomFieldLookupId {
1658 my $lookup = shift || $self->CustomFieldLookupType;
1659 my @classes = ($lookup =~ /RT::(\w+)-/g);
1661 # Work on "RT::Queue", for instance
1662 return $self->Id unless @classes;
1665 # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
1666 my $final = shift @classes;
1667 foreach my $class (reverse @classes) {
1668 my $method = "${class}Obj";
1669 $object = $object->$method;
1672 my $id = $object->$final;
1673 unless (defined $id) {
1674 my $method = "${final}Obj";
1675 $id = $object->$method->Id;
1681 =head2 CustomFieldLookupType
1683 Returns the path RT uses to figure out which custom fields apply to this object.
1687 sub CustomFieldLookupType {
1693 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1695 VALUE should be a string. FIELD can be any identifier of a CustomField
1696 supported by L</LoadCustomFieldByIdentifier> method.
1698 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1699 deletes the old value.
1700 If VALUE is not a valid value for the custom field, returns
1701 (0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1702 $id is ID of created L<ObjectCustomFieldValue> object.
1706 sub AddCustomFieldValue {
1708 $self->_AddCustomFieldValue(@_);
1711 sub _AddCustomFieldValue {
1716 LargeContent => undef,
1717 ContentType => undef,
1718 RecordTransaction => 1,
1722 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1723 unless ( $cf->Id ) {
1724 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1727 my $OCFs = $self->CustomFields;
1728 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1729 unless ( $OCFs->Count ) {
1733 "Custom field [_1] does not apply to this object",
1734 ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
1739 # empty string is not correct value of any CF, so undef it
1740 foreach ( qw(Value LargeContent) ) {
1741 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1744 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1745 return ( 0, $self->loc("Invalid value for custom field") );
1748 # If the custom field only accepts a certain # of values, delete the existing
1749 # value and record a "changed from foo to bar" transaction
1750 unless ( $cf->UnlimitedValues ) {
1752 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1753 my $values = $cf->ValuesForObject($self);
1755 # We need to whack any old values here. In most cases, the custom field should
1756 # only have one value to delete. In the pathalogical case, this custom field
1757 # used to be a multiple and we have many values to whack....
1758 my $cf_values = $values->Count;
1760 if ( $cf_values > $cf->MaxValues ) {
1761 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1762 # execute the same code to "change" the value from old to new
1763 while ( my $value = $values->Next ) {
1765 if ( $i < $cf_values ) {
1766 my ( $val, $msg ) = $cf->DeleteValueForObject(
1768 Content => $value->Content
1773 my ( $TransactionId, $Msg, $TransactionObj ) =
1774 $self->_NewTransaction(
1775 Type => 'CustomField',
1777 OldReference => $value,
1781 $values->RedoSearch if $i; # redo search if have deleted at least one value
1784 my ( $old_value, $old_content );
1785 if ( $old_value = $values->First ) {
1786 $old_content = $old_value->Content;
1787 $old_content = undef if defined $old_content && !length $old_content;
1789 my $is_the_same = 1;
1790 if ( defined $args{'Value'} ) {
1791 $is_the_same = 0 unless defined $old_content
1792 && lc $old_content eq lc $args{'Value'};
1794 $is_the_same = 0 if defined $old_content;
1796 if ( $is_the_same ) {
1797 my $old_content = $old_value->LargeContent;
1798 if ( defined $args{'LargeContent'} ) {
1799 $is_the_same = 0 unless defined $old_content
1800 && $old_content eq $args{'LargeContent'};
1802 $is_the_same = 0 if defined $old_content;
1806 return $old_value->id if $is_the_same;
1809 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1811 Content => $args{'Value'},
1812 LargeContent => $args{'LargeContent'},
1813 ContentType => $args{'ContentType'},
1816 unless ( $new_value_id ) {
1817 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1820 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1821 $new_value->Load( $new_value_id );
1823 # now that adding the new value was successful, delete the old one
1825 my ( $val, $msg ) = $old_value->Delete();
1826 return ( 0, $msg ) unless $val;
1829 if ( $args{'RecordTransaction'} ) {
1830 my ( $TransactionId, $Msg, $TransactionObj ) =
1831 $self->_NewTransaction(
1832 Type => 'CustomField',
1834 OldReference => $old_value,
1835 NewReference => $new_value,
1839 my $new_content = $new_value->Content;
1841 # For datetime, we need to display them in "human" format in result message
1842 #XXX TODO how about date without time?
1843 if ($cf->Type eq 'DateTime') {
1844 my $DateObj = RT::Date->new( $self->CurrentUser );
1847 Value => $new_content,
1849 $new_content = $DateObj->AsString;
1851 if ( defined $old_content && length $old_content ) {
1854 Value => $old_content,
1856 $old_content = $DateObj->AsString;
1860 unless ( defined $old_content && length $old_content ) {
1861 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1863 elsif ( !defined $new_content || !length $new_content ) {
1864 return ( $new_value_id,
1865 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1868 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1873 # otherwise, just add a new value and record "new value added"
1875 my ($new_value_id, $msg) = $cf->AddValueForObject(
1877 Content => $args{'Value'},
1878 LargeContent => $args{'LargeContent'},
1879 ContentType => $args{'ContentType'},
1882 unless ( $new_value_id ) {
1883 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1885 if ( $args{'RecordTransaction'} ) {
1886 my ( $tid, $msg ) = $self->_NewTransaction(
1887 Type => 'CustomField',
1889 NewReference => $new_value_id,
1890 ReferenceType => 'RT::ObjectCustomFieldValue',
1893 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1896 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1902 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1904 Deletes VALUE as a value of CustomField FIELD.
1906 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1908 If VALUE is not a valid value for the custom field, returns
1909 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1913 sub DeleteCustomFieldValue {
1922 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1923 unless ( $cf->Id ) {
1924 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1927 my ( $val, $msg ) = $cf->DeleteValueForObject(
1929 Id => $args{'ValueId'},
1930 Content => $args{'Value'},
1936 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1937 Type => 'CustomField',
1939 OldReference => $val,
1940 ReferenceType => 'RT::ObjectCustomFieldValue',
1942 unless ($TransactionId) {
1943 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1946 my $old_value = $TransactionObj->OldValue;
1947 # For datetime, we need to display them in "human" format in result message
1948 if ( $cf->Type eq 'DateTime' ) {
1949 my $DateObj = RT::Date->new( $self->CurrentUser );
1952 Value => $old_value,
1954 $old_value = $DateObj->AsString;
1959 "[_1] is no longer a value for custom field [_2]",
1960 $old_value, $cf->Name
1967 =head2 FirstCustomFieldValue FIELD
1969 Return the content of the first value of CustomField FIELD for this ticket
1970 Takes a field id or name
1974 sub FirstCustomFieldValue {
1978 my $values = $self->CustomFieldValues( $field );
1979 return undef unless my $first = $values->First;
1980 return $first->Content;
1983 =head2 CustomFieldValuesAsString FIELD
1985 Return the content of the CustomField FIELD for this ticket.
1986 If this is a multi-value custom field, values will be joined with newlines.
1988 Takes a field id or name as the first argument
1990 Takes an optional Separator => "," second and third argument
1991 if you want to join the values using something other than a newline
1995 sub CustomFieldValuesAsString {
1999 my $separator = $args{Separator} || "\n";
2001 my $values = $self->CustomFieldValues( $field );
2002 return join ($separator, grep { defined $_ }
2003 map { $_->Content } @{$values->ItemsArrayRef});
2008 =head2 CustomFieldValues FIELD
2010 Return a ObjectCustomFieldValues object of all values of the CustomField whose
2011 id or Name is FIELD for this record.
2013 Returns an RT::ObjectCustomFieldValues object
2017 sub CustomFieldValues {
2022 my $cf = $self->LoadCustomFieldByIdentifier( $field );
2024 # we were asked to search on a custom field we couldn't find
2025 unless ( $cf->id ) {
2026 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
2027 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
2029 return ( $cf->ValuesForObject($self) );
2032 # we're not limiting to a specific custom field;
2033 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
2034 $ocfs->LimitToObject( $self );
2038 =head2 LoadCustomFieldByIdentifier IDENTIFER
2040 Find the custom field has id or name IDENTIFIER for this object.
2042 If no valid field is found, returns an empty RT::CustomField object.
2046 sub LoadCustomFieldByIdentifier {
2051 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
2052 $cf = RT::CustomField->new($self->CurrentUser);
2053 $cf->SetContextObject( $self );
2054 $cf->LoadById( $field->id );
2056 elsif ($field =~ /^\d+$/) {
2057 $cf = RT::CustomField->new($self->CurrentUser);
2058 $cf->SetContextObject( $self );
2059 $cf->LoadById($field);
2062 my $cfs = $self->CustomFields($self->CurrentUser);
2063 $cfs->SetContextObject( $self );
2064 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
2065 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
2070 sub ACLEquivalenceObjects { }
2072 sub BasicColumns { }
2075 return RT->Config->Get('WebPath'). "/index.html?q=";
2078 RT::Base->_ImportOverlays();