Upgrade to 4.0.8 with mod of ExternalAuth + absolute paths to ticket-menu.
[usit-rt.git] / lib / RT / Record.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
6# <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
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
16# from www.gnu.org.
17#
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.
22#
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.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
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.)
37#
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.
46#
47# END BPS TAGGED BLOCK }}}
48
49=head1 NAME
50
51 RT::Record - Base class for RT record objects
52
53=head1 SYNOPSIS
54
55
56=head1 DESCRIPTION
57
58
59
60=head1 METHODS
61
62=cut
63
64package RT::Record;
65
66use strict;
67use warnings;
68
69
70use RT::Date;
71use RT::User;
72use RT::Attributes;
73use Encode qw();
74
75our $_TABLE_ATTR = { };
76use base RT->Config->Get('RecordBaseClass');
77use base 'RT::Base';
78
79
80sub _Init {
81 my $self = shift;
82 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
83 $self->CurrentUser(@_);
84}
85
86
87
88=head2 _PrimaryKeys
89
90The primary keys for RT classes is 'id'
91
92=cut
93
94sub _PrimaryKeys { return ['id'] }
95# short circuit many, many thousands of calls from searchbuilder
96sub _PrimaryKey { 'id' }
97
98=head2 Id
99
100Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
101on a very common codepath
102
103C<id> is an alias to C<Id> and is the preferred way to call this method.
104
105=cut
106
107sub Id {
108 return shift->{'values'}->{id};
109}
110
111*id = \&Id;
112
113=head2 Delete
114
115Delete this record object from the database.
116
117=cut
118
119sub Delete {
120 my $self = shift;
121 my ($rv) = $self->SUPER::Delete;
122 if ($rv) {
123 return ($rv, $self->loc("Object deleted"));
124 } else {
125
126 return(0, $self->loc("Object could not be deleted"))
127 }
128}
129
130=head2 ObjectTypeStr
131
132Returns a string which is this object's type. The type is the class,
133without the "RT::" prefix.
134
135
136=cut
137
138sub ObjectTypeStr {
139 my $self = shift;
140 if (ref($self) =~ /^.*::(\w+)$/) {
141 return $self->loc($1);
142 } else {
143 return $self->loc(ref($self));
144 }
145}
146
147=head2 Attributes
148
149Return this object's attributes as an RT::Attributes object
150
151=cut
152
153sub Attributes {
154 my $self = shift;
155 unless ($self->{'attributes'}) {
156 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
157 $self->{'attributes'}->LimitToObject($self);
158 $self->{'attributes'}->OrderByCols({FIELD => 'id'});
159 }
160 return ($self->{'attributes'});
161}
162
163
164=head2 AddAttribute { Name, Description, Content }
165
166Adds a new attribute for this object.
167
168=cut
169
170sub AddAttribute {
171 my $self = shift;
172 my %args = ( Name => undef,
173 Description => undef,
174 Content => undef,
175 @_ );
176
177 my $attr = RT::Attribute->new( $self->CurrentUser );
178 my ( $id, $msg ) = $attr->Create(
179 Object => $self,
180 Name => $args{'Name'},
181 Description => $args{'Description'},
182 Content => $args{'Content'} );
183
184
185 # XXX TODO: Why won't RedoSearch work here?
186 $self->Attributes->_DoSearch;
187
188 return ($id, $msg);
189}
190
191
192=head2 SetAttribute { Name, Description, Content }
193
194Like AddAttribute, but replaces all existing attributes with the same Name.
195
196=cut
197
198sub SetAttribute {
199 my $self = shift;
200 my %args = ( Name => undef,
201 Description => undef,
202 Content => undef,
203 @_ );
204
205 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
206 or return $self->AddAttribute( %args );
207
208 my $AttributeObj = pop( @AttributeObjs );
209 $_->Delete foreach @AttributeObjs;
210
211 $AttributeObj->SetDescription( $args{'Description'} );
212 $AttributeObj->SetContent( $args{'Content'} );
213
214 $self->Attributes->RedoSearch;
215 return 1;
216}
217
218=head2 DeleteAttribute NAME
219
220Deletes all attributes with the matching name for this object.
221
222=cut
223
224sub DeleteAttribute {
225 my $self = shift;
226 my $name = shift;
227 my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name );
228 $self->ClearAttributes;
229 return ($val,$msg);
230}
231
232=head2 FirstAttribute NAME
233
234Returns the first attribute with the matching name for this object (as an
235L<RT::Attribute> object), or C<undef> if no such attributes exist.
236If there is more than one attribute with the matching name on the
237object, the first value that was set is returned.
238
239=cut
240
241sub FirstAttribute {
242 my $self = shift;
243 my $name = shift;
244 return ($self->Attributes->Named( $name ))[0];
245}
246
247
248sub ClearAttributes {
249 my $self = shift;
250 delete $self->{'attributes'};
251
252}
253
254sub _Handle { return $RT::Handle }
255
256
257
258=head2 Create PARAMHASH
259
260Takes a PARAMHASH of Column -> Value pairs.
261If any Column has a Validate$PARAMNAME subroutine defined and the
262value provided doesn't pass validation, this routine returns
263an error.
264
265If this object's table has any of the following atetributes defined as
266'Auto', this routine will automatically fill in their values.
267
268=over
269
270=item Created
271
272=item Creator
273
274=item LastUpdated
275
276=item LastUpdatedBy
277
278=back
279
280=cut
281
282sub Create {
283 my $self = shift;
284 my %attribs = (@_);
285 foreach my $key ( keys %attribs ) {
286 if (my $method = $self->can("Validate$key")) {
287 if (! $method->( $self, $attribs{$key} ) ) {
288 if (wantarray) {
289 return ( 0, $self->loc('Invalid value for [_1]', $key) );
290 }
291 else {
292 return (0);
293 }
294 }
295 }
296 }
297
298
299
300 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
301
302 my $now_iso =
303 sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
304
305 $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
306
307 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
308 $attribs{'Creator'} = $self->CurrentUser->id || '0';
309 }
310 $attribs{'LastUpdated'} = $now_iso
311 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
312
313 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
314 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
315
316 my $id = $self->SUPER::Create(%attribs);
317 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
318 if ( $id->errno ) {
319 if (wantarray) {
320 return ( 0,
321 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
322 }
323 else {
324 return (0);
325 }
326 }
327 }
328 # If the object was created in the database,
329 # load it up now, so we're sure we get what the database
330 # has. Arguably, this should not be necessary, but there
331 # isn't much we can do about it.
332
333 unless ($id) {
334 if (wantarray) {
335 return ( $id, $self->loc('Object could not be created') );
336 }
337 else {
338 return ($id);
339 }
340
341 }
342
343 if (UNIVERSAL::isa('errno',$id)) {
344 return(undef);
345 }
346
347 $self->Load($id) if ($id);
348
349
350
351 if (wantarray) {
352 return ( $id, $self->loc('Object created') );
353 }
354 else {
355 return ($id);
356 }
357
358}
359
360
361
362=head2 LoadByCols
363
364Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
365DB is case sensitive
366
367=cut
368
369sub LoadByCols {
370 my $self = shift;
371
372 # We don't want to hang onto this
373 $self->ClearAttributes;
374
375 return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
376
377 # If this database is case sensitive we need to uncase objects for
378 # explicit loading
379 my %hash = (@_);
380 foreach my $key ( keys %hash ) {
381
382 # If we've been passed an empty value, we can't do the lookup.
383 # We don't need to explicitly downcase integers or an id.
384 if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
385 my ($op, $val, $func);
386 ($key, $op, $val, $func) =
387 $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
388 $hash{$key}->{operator} = $op;
389 $hash{$key}->{value} = $val;
390 $hash{$key}->{function} = $func;
391 }
392 }
393 return $self->SUPER::LoadByCols( %hash );
394}
395
396
397
398# There is room for optimizations in most of those subs:
399
400
401sub LastUpdatedObj {
402 my $self = shift;
403 my $obj = RT::Date->new( $self->CurrentUser );
404
405 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
406 return $obj;
407}
408
409
410
411sub CreatedObj {
412 my $self = shift;
413 my $obj = RT::Date->new( $self->CurrentUser );
414
415 $obj->Set( Format => 'sql', Value => $self->Created );
416
417 return $obj;
418}
419
420
421#
422# TODO: This should be deprecated
423#
424sub AgeAsString {
425 my $self = shift;
426 return ( $self->CreatedObj->AgeAsString() );
427}
428
429
430
431# TODO this should be deprecated
432
433sub LastUpdatedAsString {
434 my $self = shift;
435 if ( $self->LastUpdated ) {
436 return ( $self->LastUpdatedObj->AsString() );
437
438 }
439 else {
440 return "never";
441 }
442}
443
444
445#
446# TODO This should be deprecated
447#
448sub CreatedAsString {
449 my $self = shift;
450 return ( $self->CreatedObj->AsString() );
451}
452
453
454#
455# TODO This should be deprecated
456#
457sub LongSinceUpdateAsString {
458 my $self = shift;
459 if ( $self->LastUpdated ) {
460
461 return ( $self->LastUpdatedObj->AgeAsString() );
462
463 }
464 else {
465 return "never";
466 }
467}
468
469
470
471#
472sub _Set {
473 my $self = shift;
474
475 my %args = (
476 Field => undef,
477 Value => undef,
478 IsSQL => undef,
479 @_
480 );
481
482 #if the user is trying to modify the record
483 # TODO: document _why_ this code is here
484
485 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
486 $args{'Value'} = 0;
487 }
488
489 my $old_val = $self->__Value($args{'Field'});
490 $self->_SetLastUpdated();
491 my $ret = $self->SUPER::_Set(
492 Field => $args{'Field'},
493 Value => $args{'Value'},
494 IsSQL => $args{'IsSQL'}
495 );
496 my ($status, $msg) = $ret->as_array();
497
498 # @values has two values, a status code and a message.
499
500 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
501 # we want to change the standard "success" message
502 if ($status) {
503 $msg =
504 $self->loc(
505 "[_1] changed from [_2] to [_3]",
506 $self->loc( $args{'Field'} ),
507 ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
508 '"' . $self->__Value( $args{'Field'}) . '"'
509 );
510 } else {
511
512 $msg = $self->CurrentUser->loc_fuzzy($msg);
513 }
514 return wantarray ? ($status, $msg) : $ret;
515
516}
517
518
519
520=head2 _SetLastUpdated
521
522This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
523It takes no options. Arguably, this is a bug
524
525=cut
526
527sub _SetLastUpdated {
528 my $self = shift;
529 use RT::Date;
530 my $now = RT::Date->new( $self->CurrentUser );
531 $now->SetToNow();
532
533 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
534 my ( $msg, $val ) = $self->__Set(
535 Field => 'LastUpdated',
536 Value => $now->ISO
537 );
538 }
539 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
540 my ( $msg, $val ) = $self->__Set(
541 Field => 'LastUpdatedBy',
542 Value => $self->CurrentUser->id
543 );
544 }
545}
546
547
548
549=head2 CreatorObj
550
551Returns an RT::User object with the RT account of the creator of this row
552
553=cut
554
555sub CreatorObj {
556 my $self = shift;
557 unless ( exists $self->{'CreatorObj'} ) {
558
559 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
560 $self->{'CreatorObj'}->Load( $self->Creator );
561 }
562 return ( $self->{'CreatorObj'} );
563}
564
565
566
567=head2 LastUpdatedByObj
568
569 Returns an RT::User object of the last user to touch this object
570
571=cut
572
573sub LastUpdatedByObj {
574 my $self = shift;
575 unless ( exists $self->{LastUpdatedByObj} ) {
576 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
577 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
578 }
579 return $self->{'LastUpdatedByObj'};
580}
581
582
583
584=head2 URI
585
586Returns this record's URI
587
588=cut
589
590sub URI {
591 my $self = shift;
592 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
593 return($uri->URIForObject($self));
594}
595
596
597=head2 ValidateName NAME
598
599Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
600
601=cut
602
603sub ValidateName {
604 my $self = shift;
605 my $value = shift;
606 if (defined $value && $value=~ /^\d+$/) {
607 return(0);
608 } else {
609 return(1);
610 }
611}
612
613
614
615=head2 SQLType attribute
616
617return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
618
619=cut
620
621sub SQLType {
622 my $self = shift;
623 my $field = shift;
624
625 return ($self->_Accessible($field, 'type'));
626
627
628}
629
630sub __Value {
631 my $self = shift;
632 my $field = shift;
633 my %args = ( decode_utf8 => 1, @_ );
634
635 unless ($field) {
636 $RT::Logger->error("__Value called with undef field");
637 }
638
639 my $value = $self->SUPER::__Value($field);
640
dab09ea8
MKG
641 return undef if (!defined $value);
642
84fb5b46
MKG
643 if ( $args{'decode_utf8'} ) {
644 if ( !utf8::is_utf8($value) ) {
645 utf8::decode($value);
646 }
647 }
648 else {
649 if ( utf8::is_utf8($value) ) {
650 utf8::encode($value);
651 }
652 }
653
654 return $value;
655
656}
657
658# Set up defaults for DBIx::SearchBuilder::Record::Cachable
659
660sub _CacheConfig {
661 {
662 'cache_p' => 1,
663 'cache_for_sec' => 30,
664 }
665}
666
667
668
669sub _BuildTableAttributes {
670 my $self = shift;
671 my $class = ref($self) || $self;
672
673 my $attributes;
674 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
675 $attributes = $self->_CoreAccessible();
676 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
677 $attributes = $self->_ClassAccessible();
678
679 }
680
681 foreach my $column (keys %$attributes) {
682 foreach my $attr ( keys %{ $attributes->{$column} } ) {
683 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
684 }
685 }
686 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
687 next unless UNIVERSAL::can( $self, $method );
688 $attributes = $self->$method();
689
690 foreach my $column ( keys %$attributes ) {
691 foreach my $attr ( keys %{ $attributes->{$column} } ) {
692 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
693 }
694 }
695 }
696}
697
698
699=head2 _ClassAccessible
700
701Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
702DBIx::SearchBuilder::Record
703
704=cut
705
706sub _ClassAccessible {
707 my $self = shift;
708 return $_TABLE_ATTR->{ref($self) || $self};
709}
710
711=head2 _Accessible COLUMN ATTRIBUTE
712
713returns the value of ATTRIBUTE for COLUMN
714
715
716=cut
717
718sub _Accessible {
719 my $self = shift;
720 my $column = shift;
721 my $attribute = lc(shift);
722 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
723 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
724
725}
726
727=head2 _EncodeLOB BODY MIME_TYPE
728
729Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
730
731=cut
732
733sub _EncodeLOB {
734 my $self = shift;
735 my $Body = shift;
736 my $MIMEType = shift || '';
737 my $Filename = shift;
738
739 my $ContentEncoding = 'none';
740
741 #get the max attachment length from RT
742 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
743
744 #if the current attachment contains nulls and the
745 #database doesn't support embedded nulls
746
747 if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
748
749 # set a flag telling us to mimencode the attachment
750 $ContentEncoding = 'base64';
751
752 #cut the max attchment size by 25% (for mime-encoding overhead.
753 $RT::Logger->debug("Max size is $MaxSize");
754 $MaxSize = $MaxSize * 3 / 4;
755 # Some databases (postgres) can't handle non-utf8 data
756 } elsif ( !$RT::Handle->BinarySafeBLOBs
757 && $MIMEType !~ /text\/plain/gi
758 && !Encode::is_utf8( $Body, 1 ) ) {
759 $ContentEncoding = 'quoted-printable';
760 }
761
762 #if the attachment is larger than the maximum size
763 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
764
765 # if we're supposed to truncate large attachments
766 if (RT->Config->Get('TruncateLongAttachments')) {
767
768 # truncate the attachment to that length.
769 $Body = substr( $Body, 0, $MaxSize );
770
771 }
772
773 # elsif we're supposed to drop large attachments on the floor,
774 elsif (RT->Config->Get('DropLongAttachments')) {
775
776 # drop the attachment on the floor
777 $RT::Logger->info( "$self: Dropped an attachment of size "
778 . length($Body));
779 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
780 $Filename .= ".txt" if $Filename;
781 return ("none", "Large attachment dropped", "plain/text", $Filename );
782 }
783 }
784
785 # if we need to mimencode the attachment
786 if ( $ContentEncoding eq 'base64' ) {
787
788 # base64 encode the attachment
789 Encode::_utf8_off($Body);
790 $Body = MIME::Base64::encode_base64($Body);
791
792 } elsif ($ContentEncoding eq 'quoted-printable') {
793 Encode::_utf8_off($Body);
794 $Body = MIME::QuotedPrint::encode($Body);
795 }
796
797
798 return ($ContentEncoding, $Body, $MIMEType, $Filename );
799
800}
801
802sub _DecodeLOB {
803 my $self = shift;
804 my $ContentType = shift || '';
805 my $ContentEncoding = shift || 'none';
806 my $Content = shift;
807
808 if ( $ContentEncoding eq 'base64' ) {
809 $Content = MIME::Base64::decode_base64($Content);
810 }
811 elsif ( $ContentEncoding eq 'quoted-printable' ) {
812 $Content = MIME::QuotedPrint::decode($Content);
813 }
814 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
815 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
816 }
817 if ( RT::I18N::IsTextualContentType($ContentType) ) {
818 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
819 }
820 return ($Content);
821}
822
823# A helper table for links mapping to make it easier
824# to build and parse links between tickets
825
826use vars '%LINKDIRMAP';
827
828%LINKDIRMAP = (
829 MemberOf => { Base => 'MemberOf',
830 Target => 'HasMember', },
831 RefersTo => { Base => 'RefersTo',
832 Target => 'ReferredToBy', },
833 DependsOn => { Base => 'DependsOn',
834 Target => 'DependedOnBy', },
835 MergedInto => { Base => 'MergedInto',
836 Target => 'MergedInto', },
837
838);
839
840=head2 Update ARGSHASH
841
842Updates fields on an object for you using the proper Set methods,
843skipping unchanged values.
844
845 ARGSRef => a hashref of attributes => value for the update
846 AttributesRef => an arrayref of keys in ARGSRef that should be updated
847 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
848 when looking up values in ARGSRef
849 Bare attributes are tried before prefixed attributes
850
851Returns a list of localized results of the update
852
853=cut
854
855sub Update {
856 my $self = shift;
857
858 my %args = (
859 ARGSRef => undef,
860 AttributesRef => undef,
861 AttributePrefix => undef,
862 @_
863 );
864
865 my $attributes = $args{'AttributesRef'};
866 my $ARGSRef = $args{'ARGSRef'};
867 my %new_values;
868
869 # gather all new values
870 foreach my $attribute (@$attributes) {
871 my $value;
872 if ( defined $ARGSRef->{$attribute} ) {
873 $value = $ARGSRef->{$attribute};
874 }
875 elsif (
876 defined( $args{'AttributePrefix'} )
877 && defined(
878 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
879 )
880 ) {
881 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
882
883 }
884 else {
885 next;
886 }
887
888 $value =~ s/\r\n/\n/gs;
889
890 # If Queue is 'General', we want to resolve the queue name for
891 # the object.
892
893 # This is in an eval block because $object might not exist.
894 # and might not have a Name method. But "can" won't find autoloaded
895 # items. If it fails, we don't care
896 do {
897 no warnings "uninitialized";
898 local $@;
899 eval {
900 my $object = $attribute . "Obj";
901 my $name = $self->$object->Name;
902 next if $name eq $value || $name eq ($value || 0);
903 };
904 next if $value eq $self->$attribute();
905 next if ($value || 0) eq $self->$attribute();
906 };
907
908 $new_values{$attribute} = $value;
909 }
910
911 return $self->_UpdateAttributes(
912 Attributes => $attributes,
913 NewValues => \%new_values,
914 );
915}
916
917sub _UpdateAttributes {
918 my $self = shift;
919 my %args = (
920 Attributes => [],
921 NewValues => {},
922 @_,
923 );
924
925 my @results;
926
927 foreach my $attribute (@{ $args{Attributes} }) {
928 next if !exists($args{NewValues}{$attribute});
929
930 my $value = $args{NewValues}{$attribute};
931 my $method = "Set$attribute";
932 my ( $code, $msg ) = $self->$method($value);
933 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
934
935 # Default to $id, but use name if we can get it.
936 my $label = $self->id;
937 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
938 # this requires model names to be loc'ed.
939
940=for loc
941
942 "Ticket" # loc
943 "User" # loc
944 "Group" # loc
945 "Queue" # loc
946
947=cut
948
949 push @results, $self->loc( $prefix ) . " $label: ". $msg;
950
951=for loc
952
953 "[_1] could not be set to [_2].", # loc
954 "That is already the current value", # loc
955 "No value sent to _Set!", # loc
956 "Illegal value for [_1]", # loc
957 "The new value has been set.", # loc
958 "No column specified", # loc
959 "Immutable field", # loc
960 "Nonexistant field?", # loc
961 "Invalid data", # loc
962 "Couldn't find row", # loc
963 "Missing a primary key?: [_1]", # loc
964 "Found Object", # loc
965
966=cut
967
968 }
969
970 return @results;
971}
972
973
974
975
976=head2 Members
977
978 This returns an RT::Links object which references all the tickets
979which are 'MembersOf' this ticket
980
981=cut
982
983sub Members {
984 my $self = shift;
985 return ( $self->_Links( 'Target', 'MemberOf' ) );
986}
987
988
989
990=head2 MemberOf
991
992 This returns an RT::Links object which references all the tickets that this
993ticket is a 'MemberOf'
994
995=cut
996
997sub MemberOf {
998 my $self = shift;
999 return ( $self->_Links( 'Base', 'MemberOf' ) );
1000}
1001
1002
1003
1004=head2 RefersTo
1005
1006 This returns an RT::Links object which shows all references for which this ticket is a base
1007
1008=cut
1009
1010sub RefersTo {
1011 my $self = shift;
1012 return ( $self->_Links( 'Base', 'RefersTo' ) );
1013}
1014
1015
1016
1017=head2 ReferredToBy
1018
1019This returns an L<RT::Links> object which shows all references for which this ticket is a target
1020
1021=cut
1022
1023sub ReferredToBy {
1024 my $self = shift;
1025 return ( $self->_Links( 'Target', 'RefersTo' ) );
1026}
1027
1028
1029
1030=head2 DependedOnBy
1031
1032 This returns an RT::Links object which references all the tickets that depend on this one
1033
1034=cut
1035
1036sub DependedOnBy {
1037 my $self = shift;
1038 return ( $self->_Links( 'Target', 'DependsOn' ) );
1039}
1040
1041
1042
1043
1044=head2 HasUnresolvedDependencies
1045
1046Takes a paramhash of Type (default to '__any'). Returns the number of
1047unresolved dependencies, if $self->UnresolvedDependencies returns an
1048object with one or more members of that type. Returns false
1049otherwise.
1050
1051=cut
1052
1053sub HasUnresolvedDependencies {
1054 my $self = shift;
1055 my %args = (
1056 Type => undef,
1057 @_
1058 );
1059
1060 my $deps = $self->UnresolvedDependencies;
1061
1062 if ($args{Type}) {
1063 $deps->Limit( FIELD => 'Type',
1064 OPERATOR => '=',
1065 VALUE => $args{Type});
1066 }
1067 else {
1068 $deps->IgnoreType;
1069 }
1070
1071 if ($deps->Count > 0) {
1072 return $deps->Count;
1073 }
1074 else {
1075 return (undef);
1076 }
1077}
1078
1079
1080
1081=head2 UnresolvedDependencies
1082
1083Returns an RT::Tickets object of tickets which this ticket depends on
1084and which have a status of new, open or stalled. (That list comes from
1085RT::Queue->ActiveStatusArray
1086
1087=cut
1088
1089
1090sub UnresolvedDependencies {
1091 my $self = shift;
1092 my $deps = RT::Tickets->new($self->CurrentUser);
1093
1094 my @live_statuses = RT::Queue->ActiveStatusArray();
1095 foreach my $status (@live_statuses) {
1096 $deps->LimitStatus(VALUE => $status);
1097 }
1098 $deps->LimitDependedOnBy($self->Id);
1099
1100 return($deps);
1101
1102}
1103
1104
1105
1106=head2 AllDependedOnBy
1107
1108Returns an array of RT::Ticket objects which (directly or indirectly)
1109depends on this ticket; takes an optional 'Type' argument in the param
1110hash, which will limit returned tickets to that type, as well as cause
1111tickets with that type to serve as 'leaf' nodes that stops the recursive
1112dependency search.
1113
1114=cut
1115
1116sub AllDependedOnBy {
1117 my $self = shift;
1118 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1119 Direction => 'Target', @_ );
1120}
1121
1122=head2 AllDependsOn
1123
1124Returns an array of RT::Ticket objects which this ticket (directly or
1125indirectly) depends on; takes an optional 'Type' argument in the param
1126hash, which will limit returned tickets to that type, as well as cause
1127tickets with that type to serve as 'leaf' nodes that stops the
1128recursive dependency search.
1129
1130=cut
1131
1132sub AllDependsOn {
1133 my $self = shift;
1134 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1135 Direction => 'Base', @_ );
1136}
1137
1138sub _AllLinkedTickets {
1139 my $self = shift;
1140
1141 my %args = (
1142 LinkType => undef,
1143 Direction => undef,
1144 Type => undef,
1145 _found => {},
1146 _top => 1,
1147 @_
1148 );
1149
1150 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1151 while (my $link = $dep->Next()) {
1152 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1153 next unless ($uri->IsLocal());
1154 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1155 next if $args{_found}{$obj->Id};
1156
1157 if (!$args{Type}) {
1158 $args{_found}{$obj->Id} = $obj;
1159 $obj->_AllLinkedTickets( %args, _top => 0 );
1160 }
1161 elsif ($obj->Type and $obj->Type eq $args{Type}) {
1162 $args{_found}{$obj->Id} = $obj;
1163 }
1164 else {
1165 $obj->_AllLinkedTickets( %args, _top => 0 );
1166 }
1167 }
1168
1169 if ($args{_top}) {
1170 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1171 }
1172 else {
1173 return 1;
1174 }
1175}
1176
1177
1178
1179=head2 DependsOn
1180
1181 This returns an RT::Links object which references all the tickets that this ticket depends on
1182
1183=cut
1184
1185sub DependsOn {
1186 my $self = shift;
1187 return ( $self->_Links( 'Base', 'DependsOn' ) );
1188}
1189
1190
1191
1192
1193
1194
1195=head2 Links DIRECTION [TYPE]
1196
1197Return links (L<RT::Links>) to/from this object.
1198
1199DIRECTION is either 'Base' or 'Target'.
1200
1201TYPE is a type of links to return, it can be omitted to get
1202links of any type.
1203
1204=cut
1205
1206sub Links { shift->_Links(@_) }
1207
1208sub _Links {
1209 my $self = shift;
1210
1211 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1212 #tobias meant by $f
1213 my $field = shift;
1214 my $type = shift || "";
1215
1216 unless ( $self->{"$field$type"} ) {
1217 $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1218 # at least to myself
1219 $self->{"$field$type"}->Limit( FIELD => $field,
1220 VALUE => $self->URI,
1221 ENTRYAGGREGATOR => 'OR' );
1222 $self->{"$field$type"}->Limit( FIELD => 'Type',
1223 VALUE => $type )
1224 if ($type);
1225 }
1226 return ( $self->{"$field$type"} );
1227}
1228
1229
1230
1231
1232=head2 FormatType
1233
1234Takes a Type and returns a string that is more human readable.
1235
1236=cut
1237
1238sub FormatType{
1239 my $self = shift;
1240 my %args = ( Type => '',
1241 @_
1242 );
1243 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1244 $args{Type} =~ s/^\s+//;
1245 return $args{Type};
1246}
1247
1248
1249
1250
1251=head2 FormatLink
1252
1253Takes either a Target or a Base and returns a string of human friendly text.
1254
1255=cut
1256
1257sub FormatLink {
1258 my $self = shift;
1259 my %args = ( Object => undef,
1260 FallBack => '',
1261 @_
1262 );
1263 my $text = "URI " . $args{FallBack};
1264 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1265 $text = "Ticket " . $args{Object}->id;
1266 }
1267 return $text;
1268}
1269
1270
1271
1272=head2 _AddLink
1273
1274Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1275
1276Returns C<link id>, C<message> and C<exist> flag.
1277
1278
1279=cut
1280
1281sub _AddLink {
1282 my $self = shift;
1283 my %args = ( Target => '',
1284 Base => '',
1285 Type => '',
1286 Silent => undef,
1287 @_ );
1288
1289
1290 # Remote_link is the URI of the object that is not this ticket
1291 my $remote_link;
1292 my $direction;
1293
1294 if ( $args{'Base'} and $args{'Target'} ) {
1295 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1296 return ( 0, $self->loc("Can't specifiy both base and target") );
1297 }
1298 elsif ( $args{'Base'} ) {
1299 $args{'Target'} = $self->URI();
1300 $remote_link = $args{'Base'};
1301 $direction = 'Target';
1302 }
1303 elsif ( $args{'Target'} ) {
1304 $args{'Base'} = $self->URI();
1305 $remote_link = $args{'Target'};
1306 $direction = 'Base';
1307 }
1308 else {
1309 return ( 0, $self->loc('Either base or target must be specified') );
1310 }
1311
1312 # Check if the link already exists - we don't want duplicates
1313 use RT::Link;
1314 my $old_link = RT::Link->new( $self->CurrentUser );
1315 $old_link->LoadByParams( Base => $args{'Base'},
1316 Type => $args{'Type'},
1317 Target => $args{'Target'} );
1318 if ( $old_link->Id ) {
1319 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1320 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1321 }
1322
1323 # }}}
1324
1325
1326 # Storing the link in the DB.
1327 my $link = RT::Link->new( $self->CurrentUser );
1328 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1329 Base => $args{Base},
1330 Type => $args{Type} );
1331
1332 unless ($linkid) {
1333 $RT::Logger->error("Link could not be created: ".$linkmsg);
1334 return ( 0, $self->loc("Link could not be created") );
1335 }
1336
1337 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1338 FallBack => $args{Base});
1339 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1340 FallBack => $args{Target});
1341 my $typetext = $self->FormatType(Type => $args{Type});
1342 my $TransString =
1343 "$basetext $typetext $targettext.";
1344 return ( $linkid, $TransString ) ;
1345}
1346
1347
1348
1349=head2 _DeleteLink
1350
1351Delete a link. takes a paramhash of Base, Target and Type.
1352Either Base or Target must be null. The null value will
1353be replaced with this ticket\'s id
1354
1355=cut
1356
1357sub _DeleteLink {
1358 my $self = shift;
1359 my %args = (
1360 Base => undef,
1361 Target => undef,
1362 Type => undef,
1363 @_
1364 );
1365
1366 #we want one of base and target. we don't care which
1367 #but we only want _one_
1368
1369 my $direction;
1370 my $remote_link;
1371
1372 if ( $args{'Base'} and $args{'Target'} ) {
1373 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1374 return ( 0, $self->loc("Can't specifiy both base and target") );
1375 }
1376 elsif ( $args{'Base'} ) {
1377 $args{'Target'} = $self->URI();
1378 $remote_link = $args{'Base'};
1379 $direction = 'Target';
1380 }
1381 elsif ( $args{'Target'} ) {
1382 $args{'Base'} = $self->URI();
1383 $remote_link = $args{'Target'};
1384 $direction='Base';
1385 }
1386 else {
1387 $RT::Logger->error("Base or Target must be specified");
1388 return ( 0, $self->loc('Either base or target must be specified') );
1389 }
1390
1391 my $link = RT::Link->new( $self->CurrentUser );
1392 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1393
1394
1395 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1396 #it's a real link.
1397
1398 if ( $link->id ) {
1399 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1400 FallBack => $args{Base});
1401 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1402 FallBack => $args{Target});
1403 my $typetext = $self->FormatType(Type => $args{Type});
1404 my $linkid = $link->id;
1405 $link->Delete();
1406 my $TransString = "$basetext no longer $typetext $targettext.";
1407 return ( 1, $TransString);
1408 }
1409
1410 #if it's not a link we can find
1411 else {
1412 $RT::Logger->debug("Couldn't find that link");
1413 return ( 0, $self->loc("Link not found") );
1414 }
1415}
1416
1417
dab09ea8
MKG
1418=head1 LockForUpdate
1419
1420In a database transaction, gains an exclusive lock on the row, to
1421prevent race conditions. On SQLite, this is a "RESERVED" lock on the
1422entire database.
84fb5b46 1423
dab09ea8 1424=cut
84fb5b46 1425
dab09ea8
MKG
1426sub LockForUpdate {
1427 my $self = shift;
1428
1429 my $pk = $self->_PrimaryKey;
1430 my $id = @_ ? $_[0] : $self->$pk;
1431 $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
1432 if (RT->Config->Get('DatabaseType') eq "SQLite") {
1433 # SQLite does DB-level locking, upgrading the transaction to
1434 # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
1435 # UPDATE to force the upgade.
1436 return RT->DatabaseHandle->dbh->do(
1437 "UPDATE " .$self->Table.
1438 " SET $pk = $pk WHERE 1 = 0");
1439 } else {
1440 return $self->_LoadFromSQL(
1441 "SELECT * FROM ".$self->Table
1442 ." WHERE $pk = ? FOR UPDATE",
1443 $id,
1444 );
1445 }
1446}
84fb5b46
MKG
1447
1448=head2 _NewTransaction PARAMHASH
1449
1450Private function to create a new RT::Transaction object for this ticket update
1451
1452=cut
1453
1454sub _NewTransaction {
1455 my $self = shift;
1456 my %args = (
1457 TimeTaken => undef,
1458 Type => undef,
1459 OldValue => undef,
1460 NewValue => undef,
1461 OldReference => undef,
1462 NewReference => undef,
1463 ReferenceType => undef,
1464 Data => undef,
1465 Field => undef,
1466 MIMEObj => undef,
1467 ActivateScrips => 1,
1468 CommitScrips => 1,
1469 SquelchMailTo => undef,
1470 @_
1471 );
1472
dab09ea8
MKG
1473 my $in_txn = RT->DatabaseHandle->TransactionDepth;
1474 RT->DatabaseHandle->BeginTransaction unless $in_txn;
1475
1476 $self->LockForUpdate;
1477
84fb5b46
MKG
1478 my $old_ref = $args{'OldReference'};
1479 my $new_ref = $args{'NewReference'};
1480 my $ref_type = $args{'ReferenceType'};
1481 if ($old_ref or $new_ref) {
1482 $ref_type ||= ref($old_ref) || ref($new_ref);
1483 if (!$ref_type) {
1484 $RT::Logger->error("Reference type not specified for transaction");
1485 return;
1486 }
1487 $old_ref = $old_ref->Id if ref($old_ref);
1488 $new_ref = $new_ref->Id if ref($new_ref);
1489 }
1490
1491 require RT::Transaction;
1492 my $trans = RT::Transaction->new( $self->CurrentUser );
1493 my ( $transaction, $msg ) = $trans->Create(
1494 ObjectId => $self->Id,
1495 ObjectType => ref($self),
1496 TimeTaken => $args{'TimeTaken'},
1497 Type => $args{'Type'},
1498 Data => $args{'Data'},
1499 Field => $args{'Field'},
1500 NewValue => $args{'NewValue'},
1501 OldValue => $args{'OldValue'},
1502 NewReference => $new_ref,
1503 OldReference => $old_ref,
1504 ReferenceType => $ref_type,
1505 MIMEObj => $args{'MIMEObj'},
1506 ActivateScrips => $args{'ActivateScrips'},
1507 CommitScrips => $args{'CommitScrips'},
1508 SquelchMailTo => $args{'SquelchMailTo'},
1509 );
1510
1511 # Rationalize the object since we may have done things to it during the caching.
1512 $self->Load($self->Id);
1513
1514 $RT::Logger->warning($msg) unless $transaction;
1515
1516 $self->_SetLastUpdated;
1517
1518 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1519 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1520 }
1521 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1522 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1523 }
dab09ea8
MKG
1524
1525 RT->DatabaseHandle->Commit unless $in_txn;
1526
84fb5b46
MKG
1527 return ( $transaction, $msg, $trans );
1528}
1529
1530
1531
1532=head2 Transactions
1533
1534 Returns an RT::Transactions object of all transactions on this record object
1535
1536=cut
1537
1538sub Transactions {
1539 my $self = shift;
1540
1541 use RT::Transactions;
1542 my $transactions = RT::Transactions->new( $self->CurrentUser );
1543
1544 #If the user has no rights, return an empty object
1545 $transactions->Limit(
1546 FIELD => 'ObjectId',
1547 VALUE => $self->id,
1548 );
1549 $transactions->Limit(
1550 FIELD => 'ObjectType',
1551 VALUE => ref($self),
1552 );
1553
1554 return ($transactions);
1555}
1556
1557#
1558
1559sub CustomFields {
1560 my $self = shift;
1561 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1562
1563 $cfs->SetContextObject( $self );
1564 # XXX handle multiple types properly
1565 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1566 $cfs->LimitToGlobalOrObjectId(
1567 $self->_LookupId( $self->CustomFieldLookupType )
1568 );
1569 $cfs->ApplySortOrder;
1570
1571 return $cfs;
1572}
1573
1574# TODO: This _only_ works for RT::Class classes. it doesn't work, for example,
1575# for RT::IR classes.
1576
1577sub _LookupId {
1578 my $self = shift;
1579 my $lookup = shift;
1580 my @classes = ($lookup =~ /RT::(\w+)-/g);
1581
1582 my $object = $self;
1583 foreach my $class (reverse @classes) {
1584 my $method = "${class}Obj";
1585 $object = $object->$method;
1586 }
1587
1588 return $object->Id;
1589}
1590
1591
1592=head2 CustomFieldLookupType
1593
1594Returns the path RT uses to figure out which custom fields apply to this object.
1595
1596=cut
1597
1598sub CustomFieldLookupType {
1599 my $self = shift;
1600 return ref($self);
1601}
1602
1603
1604=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1605
1606VALUE should be a string. FIELD can be any identifier of a CustomField
1607supported by L</LoadCustomFieldByIdentifier> method.
1608
1609Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1610deletes the old value.
1611If VALUE is not a valid value for the custom field, returns
1612(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1613$id is ID of created L<ObjectCustomFieldValue> object.
1614
1615=cut
1616
1617sub AddCustomFieldValue {
1618 my $self = shift;
1619 $self->_AddCustomFieldValue(@_);
1620}
1621
1622sub _AddCustomFieldValue {
1623 my $self = shift;
1624 my %args = (
1625 Field => undef,
1626 Value => undef,
1627 LargeContent => undef,
1628 ContentType => undef,
1629 RecordTransaction => 1,
1630 @_
1631 );
1632
1633 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1634 unless ( $cf->Id ) {
1635 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1636 }
1637
1638 my $OCFs = $self->CustomFields;
1639 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1640 unless ( $OCFs->Count ) {
1641 return (
1642 0,
1643 $self->loc(
1644 "Custom field [_1] does not apply to this object",
dab09ea8 1645 ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
84fb5b46
MKG
1646 )
1647 );
1648 }
1649
1650 # empty string is not correct value of any CF, so undef it
1651 foreach ( qw(Value LargeContent) ) {
1652 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1653 }
1654
1655 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1656 return ( 0, $self->loc("Invalid value for custom field") );
1657 }
1658
1659 # If the custom field only accepts a certain # of values, delete the existing
1660 # value and record a "changed from foo to bar" transaction
1661 unless ( $cf->UnlimitedValues ) {
1662
1663 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1664 my $values = $cf->ValuesForObject($self);
1665
1666 # We need to whack any old values here. In most cases, the custom field should
1667 # only have one value to delete. In the pathalogical case, this custom field
1668 # used to be a multiple and we have many values to whack....
1669 my $cf_values = $values->Count;
1670
1671 if ( $cf_values > $cf->MaxValues ) {
1672 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1673 # execute the same code to "change" the value from old to new
1674 while ( my $value = $values->Next ) {
1675 $i++;
1676 if ( $i < $cf_values ) {
1677 my ( $val, $msg ) = $cf->DeleteValueForObject(
1678 Object => $self,
1679 Content => $value->Content
1680 );
1681 unless ($val) {
1682 return ( 0, $msg );
1683 }
1684 my ( $TransactionId, $Msg, $TransactionObj ) =
1685 $self->_NewTransaction(
1686 Type => 'CustomField',
1687 Field => $cf->Id,
1688 OldReference => $value,
1689 );
1690 }
1691 }
1692 $values->RedoSearch if $i; # redo search if have deleted at least one value
1693 }
1694
1695 my ( $old_value, $old_content );
1696 if ( $old_value = $values->First ) {
1697 $old_content = $old_value->Content;
1698 $old_content = undef if defined $old_content && !length $old_content;
1699
1700 my $is_the_same = 1;
1701 if ( defined $args{'Value'} ) {
1702 $is_the_same = 0 unless defined $old_content
1703 && lc $old_content eq lc $args{'Value'};
1704 } else {
1705 $is_the_same = 0 if defined $old_content;
1706 }
1707 if ( $is_the_same ) {
1708 my $old_content = $old_value->LargeContent;
1709 if ( defined $args{'LargeContent'} ) {
1710 $is_the_same = 0 unless defined $old_content
1711 && $old_content eq $args{'LargeContent'};
1712 } else {
1713 $is_the_same = 0 if defined $old_content;
1714 }
1715 }
1716
1717 return $old_value->id if $is_the_same;
1718 }
1719
1720 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1721 Object => $self,
1722 Content => $args{'Value'},
1723 LargeContent => $args{'LargeContent'},
1724 ContentType => $args{'ContentType'},
1725 );
1726
1727 unless ( $new_value_id ) {
1728 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1729 }
1730
1731 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1732 $new_value->Load( $new_value_id );
1733
1734 # now that adding the new value was successful, delete the old one
1735 if ( $old_value ) {
1736 my ( $val, $msg ) = $old_value->Delete();
1737 return ( 0, $msg ) unless $val;
1738 }
1739
1740 if ( $args{'RecordTransaction'} ) {
1741 my ( $TransactionId, $Msg, $TransactionObj ) =
1742 $self->_NewTransaction(
1743 Type => 'CustomField',
1744 Field => $cf->Id,
1745 OldReference => $old_value,
1746 NewReference => $new_value,
1747 );
1748 }
1749
1750 my $new_content = $new_value->Content;
1751
1752 # For datetime, we need to display them in "human" format in result message
1753 #XXX TODO how about date without time?
1754 if ($cf->Type eq 'DateTime') {
1755 my $DateObj = RT::Date->new( $self->CurrentUser );
1756 $DateObj->Set(
1757 Format => 'ISO',
1758 Value => $new_content,
1759 );
1760 $new_content = $DateObj->AsString;
1761
1762 if ( defined $old_content && length $old_content ) {
1763 $DateObj->Set(
1764 Format => 'ISO',
1765 Value => $old_content,
1766 );
1767 $old_content = $DateObj->AsString;
1768 }
1769 }
1770
1771 unless ( defined $old_content && length $old_content ) {
1772 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1773 }
1774 elsif ( !defined $new_content || !length $new_content ) {
1775 return ( $new_value_id,
1776 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1777 }
1778 else {
1779 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1780 }
1781
1782 }
1783
1784 # otherwise, just add a new value and record "new value added"
1785 else {
1786 my ($new_value_id, $msg) = $cf->AddValueForObject(
1787 Object => $self,
1788 Content => $args{'Value'},
1789 LargeContent => $args{'LargeContent'},
1790 ContentType => $args{'ContentType'},
1791 );
1792
1793 unless ( $new_value_id ) {
1794 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1795 }
1796 if ( $args{'RecordTransaction'} ) {
1797 my ( $tid, $msg ) = $self->_NewTransaction(
1798 Type => 'CustomField',
1799 Field => $cf->Id,
1800 NewReference => $new_value_id,
1801 ReferenceType => 'RT::ObjectCustomFieldValue',
1802 );
1803 unless ( $tid ) {
1804 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1805 }
1806 }
1807 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1808 }
1809}
1810
1811
1812
1813=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1814
1815Deletes VALUE as a value of CustomField FIELD.
1816
1817VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1818
1819If VALUE is not a valid value for the custom field, returns
1820(0, 'Error message' ) otherwise, returns (1, 'Success Message')
1821
1822=cut
1823
1824sub DeleteCustomFieldValue {
1825 my $self = shift;
1826 my %args = (
1827 Field => undef,
1828 Value => undef,
1829 ValueId => undef,
1830 @_
1831 );
1832
1833 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1834 unless ( $cf->Id ) {
1835 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1836 }
1837
1838 my ( $val, $msg ) = $cf->DeleteValueForObject(
1839 Object => $self,
1840 Id => $args{'ValueId'},
1841 Content => $args{'Value'},
1842 );
1843 unless ($val) {
1844 return ( 0, $msg );
1845 }
1846
1847 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1848 Type => 'CustomField',
1849 Field => $cf->Id,
1850 OldReference => $val,
1851 ReferenceType => 'RT::ObjectCustomFieldValue',
1852 );
1853 unless ($TransactionId) {
1854 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1855 }
1856
1857 my $old_value = $TransactionObj->OldValue;
1858 # For datetime, we need to display them in "human" format in result message
1859 if ( $cf->Type eq 'DateTime' ) {
1860 my $DateObj = RT::Date->new( $self->CurrentUser );
1861 $DateObj->Set(
1862 Format => 'ISO',
1863 Value => $old_value,
1864 );
1865 $old_value = $DateObj->AsString;
1866 }
1867 return (
1868 $TransactionId,
1869 $self->loc(
1870 "[_1] is no longer a value for custom field [_2]",
1871 $old_value, $cf->Name
1872 )
1873 );
1874}
1875
1876
1877
1878=head2 FirstCustomFieldValue FIELD
1879
1880Return the content of the first value of CustomField FIELD for this ticket
1881Takes a field id or name
1882
1883=cut
1884
1885sub FirstCustomFieldValue {
1886 my $self = shift;
1887 my $field = shift;
1888
1889 my $values = $self->CustomFieldValues( $field );
1890 return undef unless my $first = $values->First;
1891 return $first->Content;
1892}
1893
1894=head2 CustomFieldValuesAsString FIELD
1895
1896Return the content of the CustomField FIELD for this ticket.
1897If this is a multi-value custom field, values will be joined with newlines.
1898
1899Takes a field id or name as the first argument
1900
1901Takes an optional Separator => "," second and third argument
1902if you want to join the values using something other than a newline
1903
1904=cut
1905
1906sub CustomFieldValuesAsString {
1907 my $self = shift;
1908 my $field = shift;
1909 my %args = @_;
1910 my $separator = $args{Separator} || "\n";
1911
1912 my $values = $self->CustomFieldValues( $field );
1913 return join ($separator, grep { defined $_ }
1914 map { $_->Content } @{$values->ItemsArrayRef});
1915}
1916
1917
1918
1919=head2 CustomFieldValues FIELD
1920
1921Return a ObjectCustomFieldValues object of all values of the CustomField whose
1922id or Name is FIELD for this record.
1923
1924Returns an RT::ObjectCustomFieldValues object
1925
1926=cut
1927
1928sub CustomFieldValues {
1929 my $self = shift;
1930 my $field = shift;
1931
1932 if ( $field ) {
1933 my $cf = $self->LoadCustomFieldByIdentifier( $field );
1934
1935 # we were asked to search on a custom field we couldn't find
1936 unless ( $cf->id ) {
1937 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
1938 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1939 }
1940 return ( $cf->ValuesForObject($self) );
1941 }
1942
1943 # we're not limiting to a specific custom field;
1944 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1945 $ocfs->LimitToObject( $self );
1946 return $ocfs;
1947}
1948
1949=head2 LoadCustomFieldByIdentifier IDENTIFER
1950
1951Find the custom field has id or name IDENTIFIER for this object.
1952
1953If no valid field is found, returns an empty RT::CustomField object.
1954
1955=cut
1956
1957sub LoadCustomFieldByIdentifier {
1958 my $self = shift;
1959 my $field = shift;
1960
1961 my $cf;
1962 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1963 $cf = RT::CustomField->new($self->CurrentUser);
1964 $cf->SetContextObject( $self );
1965 $cf->LoadById( $field->id );
1966 }
1967 elsif ($field =~ /^\d+$/) {
1968 $cf = RT::CustomField->new($self->CurrentUser);
1969 $cf->SetContextObject( $self );
1970 $cf->LoadById($field);
1971 } else {
1972
1973 my $cfs = $self->CustomFields($self->CurrentUser);
1974 $cfs->SetContextObject( $self );
1975 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
1976 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1977 }
1978 return $cf;
1979}
1980
1981sub ACLEquivalenceObjects { }
1982
1983sub BasicColumns { }
1984
1985sub WikiBase {
1986 return RT->Config->Get('WebPath'). "/index.html?q=";
1987}
1988
1989RT::Base->_ImportOverlays();
1990
19911;