]> git.uio.no Git - usit-rt.git/blame - lib/RT/Record.pm
git://git.uio.no / usit-rt.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Removed LDAP-lookup loop for new external users.
[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
641 if ( $args{'decode_utf8'} ) {
642 if ( !utf8::is_utf8($value) ) {
643 utf8::decode($value);
644 }
645 }
646 else {
647 if ( utf8::is_utf8($value) ) {
648 utf8::encode($value);
649 }
650 }
651
652 return $value;
653
654}
655
656# Set up defaults for DBIx::SearchBuilder::Record::Cachable
657
658sub _CacheConfig {
659 {
660 'cache_p' => 1,
661 'cache_for_sec' => 30,
662 }
663}
664
665
666
667sub _BuildTableAttributes {
668 my $self = shift;
669 my $class = ref($self) || $self;
670
671 my $attributes;
672 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
673 $attributes = $self->_CoreAccessible();
674 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
675 $attributes = $self->_ClassAccessible();
676
677 }
678
679 foreach my $column (keys %$attributes) {
680 foreach my $attr ( keys %{ $attributes->{$column} } ) {
681 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
682 }
683 }
684 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
685 next unless UNIVERSAL::can( $self, $method );
686 $attributes = $self->$method();
687
688 foreach my $column ( keys %$attributes ) {
689 foreach my $attr ( keys %{ $attributes->{$column} } ) {
690 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
691 }
692 }
693 }
694}
695
696
697=head2 _ClassAccessible
698
699Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
700DBIx::SearchBuilder::Record
701
702=cut
703
704sub _ClassAccessible {
705 my $self = shift;
706 return $_TABLE_ATTR->{ref($self) || $self};
707}
708
709=head2 _Accessible COLUMN ATTRIBUTE
710
711returns the value of ATTRIBUTE for COLUMN
712
713
714=cut
715
716sub _Accessible {
717 my $self = shift;
718 my $column = shift;
719 my $attribute = lc(shift);
720 return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
721 return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
722
723}
724
725=head2 _EncodeLOB BODY MIME_TYPE
726
727Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
728
729=cut
730
731sub _EncodeLOB {
732 my $self = shift;
733 my $Body = shift;
734 my $MIMEType = shift || '';
735 my $Filename = shift;
736
737 my $ContentEncoding = 'none';
738
739 #get the max attachment length from RT
740 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
741
742 #if the current attachment contains nulls and the
743 #database doesn't support embedded nulls
744
745 if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
746
747 # set a flag telling us to mimencode the attachment
748 $ContentEncoding = 'base64';
749
750 #cut the max attchment size by 25% (for mime-encoding overhead.
751 $RT::Logger->debug("Max size is $MaxSize");
752 $MaxSize = $MaxSize * 3 / 4;
753 # Some databases (postgres) can't handle non-utf8 data
754 } elsif ( !$RT::Handle->BinarySafeBLOBs
755 && $MIMEType !~ /text\/plain/gi
756 && !Encode::is_utf8( $Body, 1 ) ) {
757 $ContentEncoding = 'quoted-printable';
758 }
759
760 #if the attachment is larger than the maximum size
761 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
762
763 # if we're supposed to truncate large attachments
764 if (RT->Config->Get('TruncateLongAttachments')) {
765
766 # truncate the attachment to that length.
767 $Body = substr( $Body, 0, $MaxSize );
768
769 }
770
771 # elsif we're supposed to drop large attachments on the floor,
772 elsif (RT->Config->Get('DropLongAttachments')) {
773
774 # drop the attachment on the floor
775 $RT::Logger->info( "$self: Dropped an attachment of size "
776 . length($Body));
777 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
778 $Filename .= ".txt" if $Filename;
779 return ("none", "Large attachment dropped", "plain/text", $Filename );
780 }
781 }
782
783 # if we need to mimencode the attachment
784 if ( $ContentEncoding eq 'base64' ) {
785
786 # base64 encode the attachment
787 Encode::_utf8_off($Body);
788 $Body = MIME::Base64::encode_base64($Body);
789
790 } elsif ($ContentEncoding eq 'quoted-printable') {
791 Encode::_utf8_off($Body);
792 $Body = MIME::QuotedPrint::encode($Body);
793 }
794
795
796 return ($ContentEncoding, $Body, $MIMEType, $Filename );
797
798}
799
800sub _DecodeLOB {
801 my $self = shift;
802 my $ContentType = shift || '';
803 my $ContentEncoding = shift || 'none';
804 my $Content = shift;
805
806 if ( $ContentEncoding eq 'base64' ) {
807 $Content = MIME::Base64::decode_base64($Content);
808 }
809 elsif ( $ContentEncoding eq 'quoted-printable' ) {
810 $Content = MIME::QuotedPrint::decode($Content);
811 }
812 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
813 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
814 }
815 if ( RT::I18N::IsTextualContentType($ContentType) ) {
816 $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
817 }
818 return ($Content);
819}
820
821# A helper table for links mapping to make it easier
822# to build and parse links between tickets
823
824use vars '%LINKDIRMAP';
825
826%LINKDIRMAP = (
827 MemberOf => { Base => 'MemberOf',
828 Target => 'HasMember', },
829 RefersTo => { Base => 'RefersTo',
830 Target => 'ReferredToBy', },
831 DependsOn => { Base => 'DependsOn',
832 Target => 'DependedOnBy', },
833 MergedInto => { Base => 'MergedInto',
834 Target => 'MergedInto', },
835
836);
837
838=head2 Update ARGSHASH
839
840Updates fields on an object for you using the proper Set methods,
841skipping unchanged values.
842
843 ARGSRef => a hashref of attributes => value for the update
844 AttributesRef => an arrayref of keys in ARGSRef that should be updated
845 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
846 when looking up values in ARGSRef
847 Bare attributes are tried before prefixed attributes
848
849Returns a list of localized results of the update
850
851=cut
852
853sub Update {
854 my $self = shift;
855
856 my %args = (
857 ARGSRef => undef,
858 AttributesRef => undef,
859 AttributePrefix => undef,
860 @_
861 );
862
863 my $attributes = $args{'AttributesRef'};
864 my $ARGSRef = $args{'ARGSRef'};
865 my %new_values;
866
867 # gather all new values
868 foreach my $attribute (@$attributes) {
869 my $value;
870 if ( defined $ARGSRef->{$attribute} ) {
871 $value = $ARGSRef->{$attribute};
872 }
873 elsif (
874 defined( $args{'AttributePrefix'} )
875 && defined(
876 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
877 )
878 ) {
879 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
880
881 }
882 else {
883 next;
884 }
885
886 $value =~ s/\r\n/\n/gs;
887
888 # If Queue is 'General', we want to resolve the queue name for
889 # the object.
890
891 # This is in an eval block because $object might not exist.
892 # and might not have a Name method. But "can" won't find autoloaded
893 # items. If it fails, we don't care
894 do {
895 no warnings "uninitialized";
896 local $@;
897 eval {
898 my $object = $attribute . "Obj";
899 my $name = $self->$object->Name;
900 next if $name eq $value || $name eq ($value || 0);
901 };
902 next if $value eq $self->$attribute();
903 next if ($value || 0) eq $self->$attribute();
904 };
905
906 $new_values{$attribute} = $value;
907 }
908
909 return $self->_UpdateAttributes(
910 Attributes => $attributes,
911 NewValues => \%new_values,
912 );
913}
914
915sub _UpdateAttributes {
916 my $self = shift;
917 my %args = (
918 Attributes => [],
919 NewValues => {},
920 @_,
921 );
922
923 my @results;
924
925 foreach my $attribute (@{ $args{Attributes} }) {
926 next if !exists($args{NewValues}{$attribute});
927
928 my $value = $args{NewValues}{$attribute};
929 my $method = "Set$attribute";
930 my ( $code, $msg ) = $self->$method($value);
931 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
932
933 # Default to $id, but use name if we can get it.
934 my $label = $self->id;
935 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
936 # this requires model names to be loc'ed.
937
938=for loc
939
940 "Ticket" # loc
941 "User" # loc
942 "Group" # loc
943 "Queue" # loc
944
945=cut
946
947 push @results, $self->loc( $prefix ) . " $label: ". $msg;
948
949=for loc
950
951 "[_1] could not be set to [_2].", # loc
952 "That is already the current value", # loc
953 "No value sent to _Set!", # loc
954 "Illegal value for [_1]", # loc
955 "The new value has been set.", # loc
956 "No column specified", # loc
957 "Immutable field", # loc
958 "Nonexistant field?", # loc
959 "Invalid data", # loc
960 "Couldn't find row", # loc
961 "Missing a primary key?: [_1]", # loc
962 "Found Object", # loc
963
964=cut
965
966 }
967
968 return @results;
969}
970
971
972
973
974=head2 Members
975
976 This returns an RT::Links object which references all the tickets
977which are 'MembersOf' this ticket
978
979=cut
980
981sub Members {
982 my $self = shift;
983 return ( $self->_Links( 'Target', 'MemberOf' ) );
984}
985
986
987
988=head2 MemberOf
989
990 This returns an RT::Links object which references all the tickets that this
991ticket is a 'MemberOf'
992
993=cut
994
995sub MemberOf {
996 my $self = shift;
997 return ( $self->_Links( 'Base', 'MemberOf' ) );
998}
999
1000
1001
1002=head2 RefersTo
1003
1004 This returns an RT::Links object which shows all references for which this ticket is a base
1005
1006=cut
1007
1008sub RefersTo {
1009 my $self = shift;
1010 return ( $self->_Links( 'Base', 'RefersTo' ) );
1011}
1012
1013
1014
1015=head2 ReferredToBy
1016
1017This returns an L<RT::Links> object which shows all references for which this ticket is a target
1018
1019=cut
1020
1021sub ReferredToBy {
1022 my $self = shift;
1023 return ( $self->_Links( 'Target', 'RefersTo' ) );
1024}
1025
1026
1027
1028=head2 DependedOnBy
1029
1030 This returns an RT::Links object which references all the tickets that depend on this one
1031
1032=cut
1033
1034sub DependedOnBy {
1035 my $self = shift;
1036 return ( $self->_Links( 'Target', 'DependsOn' ) );
1037}
1038
1039
1040
1041
1042=head2 HasUnresolvedDependencies
1043
1044Takes a paramhash of Type (default to '__any'). Returns the number of
1045unresolved dependencies, if $self->UnresolvedDependencies returns an
1046object with one or more members of that type. Returns false
1047otherwise.
1048
1049=cut
1050
1051sub HasUnresolvedDependencies {
1052 my $self = shift;
1053 my %args = (
1054 Type => undef,
1055 @_
1056 );
1057
1058 my $deps = $self->UnresolvedDependencies;
1059
1060 if ($args{Type}) {
1061 $deps->Limit( FIELD => 'Type',
1062 OPERATOR => '=',
1063 VALUE => $args{Type});
1064 }
1065 else {
1066 $deps->IgnoreType;
1067 }
1068
1069 if ($deps->Count > 0) {
1070 return $deps->Count;
1071 }
1072 else {
1073 return (undef);
1074 }
1075}
1076
1077
1078
1079=head2 UnresolvedDependencies
1080
1081Returns an RT::Tickets object of tickets which this ticket depends on
1082and which have a status of new, open or stalled. (That list comes from
1083RT::Queue->ActiveStatusArray
1084
1085=cut
1086
1087
1088sub UnresolvedDependencies {
1089 my $self = shift;
1090 my $deps = RT::Tickets->new($self->CurrentUser);
1091
1092 my @live_statuses = RT::Queue->ActiveStatusArray();
1093 foreach my $status (@live_statuses) {
1094 $deps->LimitStatus(VALUE => $status);
1095 }
1096 $deps->LimitDependedOnBy($self->Id);
1097
1098 return($deps);
1099
1100}
1101
1102
1103
1104=head2 AllDependedOnBy
1105
1106Returns an array of RT::Ticket objects which (directly or indirectly)
1107depends on this ticket; takes an optional 'Type' argument in the param
1108hash, which will limit returned tickets to that type, as well as cause
1109tickets with that type to serve as 'leaf' nodes that stops the recursive
1110dependency search.
1111
1112=cut
1113
1114sub AllDependedOnBy {
1115 my $self = shift;
1116 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1117 Direction => 'Target', @_ );
1118}
1119
1120=head2 AllDependsOn
1121
1122Returns an array of RT::Ticket objects which this ticket (directly or
1123indirectly) depends on; takes an optional 'Type' argument in the param
1124hash, which will limit returned tickets to that type, as well as cause
1125tickets with that type to serve as 'leaf' nodes that stops the
1126recursive dependency search.
1127
1128=cut
1129
1130sub AllDependsOn {
1131 my $self = shift;
1132 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1133 Direction => 'Base', @_ );
1134}
1135
1136sub _AllLinkedTickets {
1137 my $self = shift;
1138
1139 my %args = (
1140 LinkType => undef,
1141 Direction => undef,
1142 Type => undef,
1143 _found => {},
1144 _top => 1,
1145 @_
1146 );
1147
1148 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1149 while (my $link = $dep->Next()) {
1150 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1151 next unless ($uri->IsLocal());
1152 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1153 next if $args{_found}{$obj->Id};
1154
1155 if (!$args{Type}) {
1156 $args{_found}{$obj->Id} = $obj;
1157 $obj->_AllLinkedTickets( %args, _top => 0 );
1158 }
1159 elsif ($obj->Type and $obj->Type eq $args{Type}) {
1160 $args{_found}{$obj->Id} = $obj;
1161 }
1162 else {
1163 $obj->_AllLinkedTickets( %args, _top => 0 );
1164 }
1165 }
1166
1167 if ($args{_top}) {
1168 return map { $args{_found}{$_} } sort keys %{$args{_found}};
1169 }
1170 else {
1171 return 1;
1172 }
1173}
1174
1175
1176
1177=head2 DependsOn
1178
1179 This returns an RT::Links object which references all the tickets that this ticket depends on
1180
1181=cut
1182
1183sub DependsOn {
1184 my $self = shift;
1185 return ( $self->_Links( 'Base', 'DependsOn' ) );
1186}
1187
1188
1189
1190
1191
1192
1193=head2 Links DIRECTION [TYPE]
1194
1195Return links (L<RT::Links>) to/from this object.
1196
1197DIRECTION is either 'Base' or 'Target'.
1198
1199TYPE is a type of links to return, it can be omitted to get
1200links of any type.
1201
1202=cut
1203
1204sub Links { shift->_Links(@_) }
1205
1206sub _Links {
1207 my $self = shift;
1208
1209 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1210 #tobias meant by $f
1211 my $field = shift;
1212 my $type = shift || "";
1213
1214 unless ( $self->{"$field$type"} ) {
1215 $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1216 # at least to myself
1217 $self->{"$field$type"}->Limit( FIELD => $field,
1218 VALUE => $self->URI,
1219 ENTRYAGGREGATOR => 'OR' );
1220 $self->{"$field$type"}->Limit( FIELD => 'Type',
1221 VALUE => $type )
1222 if ($type);
1223 }
1224 return ( $self->{"$field$type"} );
1225}
1226
1227
1228
1229
1230=head2 FormatType
1231
1232Takes a Type and returns a string that is more human readable.
1233
1234=cut
1235
1236sub FormatType{
1237 my $self = shift;
1238 my %args = ( Type => '',
1239 @_
1240 );
1241 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1242 $args{Type} =~ s/^\s+//;
1243 return $args{Type};
1244}
1245
1246
1247
1248
1249=head2 FormatLink
1250
1251Takes either a Target or a Base and returns a string of human friendly text.
1252
1253=cut
1254
1255sub FormatLink {
1256 my $self = shift;
1257 my %args = ( Object => undef,
1258 FallBack => '',
1259 @_
1260 );
1261 my $text = "URI " . $args{FallBack};
1262 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1263 $text = "Ticket " . $args{Object}->id;
1264 }
1265 return $text;
1266}
1267
1268
1269
1270=head2 _AddLink
1271
1272Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1273
1274Returns C<link id>, C<message> and C<exist> flag.
1275
1276
1277=cut
1278
1279sub _AddLink {
1280 my $self = shift;
1281 my %args = ( Target => '',
1282 Base => '',
1283 Type => '',
1284 Silent => undef,
1285 @_ );
1286
1287
1288 # Remote_link is the URI of the object that is not this ticket
1289 my $remote_link;
1290 my $direction;
1291
1292 if ( $args{'Base'} and $args{'Target'} ) {
1293 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1294 return ( 0, $self->loc("Can't specifiy both base and target") );
1295 }
1296 elsif ( $args{'Base'} ) {
1297 $args{'Target'} = $self->URI();
1298 $remote_link = $args{'Base'};
1299 $direction = 'Target';
1300 }
1301 elsif ( $args{'Target'} ) {
1302 $args{'Base'} = $self->URI();
1303 $remote_link = $args{'Target'};
1304 $direction = 'Base';
1305 }
1306 else {
1307 return ( 0, $self->loc('Either base or target must be specified') );
1308 }
1309
1310 # Check if the link already exists - we don't want duplicates
1311 use RT::Link;
1312 my $old_link = RT::Link->new( $self->CurrentUser );
1313 $old_link->LoadByParams( Base => $args{'Base'},
1314 Type => $args{'Type'},
1315 Target => $args{'Target'} );
1316 if ( $old_link->Id ) {
1317 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1318 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1319 }
1320
1321 # }}}
1322
1323
1324 # Storing the link in the DB.
1325 my $link = RT::Link->new( $self->CurrentUser );
1326 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1327 Base => $args{Base},
1328 Type => $args{Type} );
1329
1330 unless ($linkid) {
1331 $RT::Logger->error("Link could not be created: ".$linkmsg);
1332 return ( 0, $self->loc("Link could not be created") );
1333 }
1334
1335 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1336 FallBack => $args{Base});
1337 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1338 FallBack => $args{Target});
1339 my $typetext = $self->FormatType(Type => $args{Type});
1340 my $TransString =
1341 "$basetext $typetext $targettext.";
1342 return ( $linkid, $TransString ) ;
1343}
1344
1345
1346
1347=head2 _DeleteLink
1348
1349Delete a link. takes a paramhash of Base, Target and Type.
1350Either Base or Target must be null. The null value will
1351be replaced with this ticket\'s id
1352
1353=cut
1354
1355sub _DeleteLink {
1356 my $self = shift;
1357 my %args = (
1358 Base => undef,
1359 Target => undef,
1360 Type => undef,
1361 @_
1362 );
1363
1364 #we want one of base and target. we don't care which
1365 #but we only want _one_
1366
1367 my $direction;
1368 my $remote_link;
1369
1370 if ( $args{'Base'} and $args{'Target'} ) {
1371 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1372 return ( 0, $self->loc("Can't specifiy both base and target") );
1373 }
1374 elsif ( $args{'Base'} ) {
1375 $args{'Target'} = $self->URI();
1376 $remote_link = $args{'Base'};
1377 $direction = 'Target';
1378 }
1379 elsif ( $args{'Target'} ) {
1380 $args{'Base'} = $self->URI();
1381 $remote_link = $args{'Target'};
1382 $direction='Base';
1383 }
1384 else {
1385 $RT::Logger->error("Base or Target must be specified");
1386 return ( 0, $self->loc('Either base or target must be specified') );
1387 }
1388
1389 my $link = RT::Link->new( $self->CurrentUser );
1390 $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1391
1392
1393 $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
1394 #it's a real link.
1395
1396 if ( $link->id ) {
1397 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1398 FallBack => $args{Base});
1399 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1400 FallBack => $args{Target});
1401 my $typetext = $self->FormatType(Type => $args{Type});
1402 my $linkid = $link->id;
1403 $link->Delete();
1404 my $TransString = "$basetext no longer $typetext $targettext.";
1405 return ( 1, $TransString);
1406 }
1407
1408 #if it's not a link we can find
1409 else {
1410 $RT::Logger->debug("Couldn't find that link");
1411 return ( 0, $self->loc("Link not found") );
1412 }
1413}
1414
1415
1416
1417
1418
1419=head2 _NewTransaction PARAMHASH
1420
1421Private function to create a new RT::Transaction object for this ticket update
1422
1423=cut
1424
1425sub _NewTransaction {
1426 my $self = shift;
1427 my %args = (
1428 TimeTaken => undef,
1429 Type => undef,
1430 OldValue => undef,
1431 NewValue => undef,
1432 OldReference => undef,
1433 NewReference => undef,
1434 ReferenceType => undef,
1435 Data => undef,
1436 Field => undef,
1437 MIMEObj => undef,
1438 ActivateScrips => 1,
1439 CommitScrips => 1,
1440 SquelchMailTo => undef,
1441 @_
1442 );
1443
1444 my $old_ref = $args{'OldReference'};
1445 my $new_ref = $args{'NewReference'};
1446 my $ref_type = $args{'ReferenceType'};
1447 if ($old_ref or $new_ref) {
1448 $ref_type ||= ref($old_ref) || ref($new_ref);
1449 if (!$ref_type) {
1450 $RT::Logger->error("Reference type not specified for transaction");
1451 return;
1452 }
1453 $old_ref = $old_ref->Id if ref($old_ref);
1454 $new_ref = $new_ref->Id if ref($new_ref);
1455 }
1456
1457 require RT::Transaction;
1458 my $trans = RT::Transaction->new( $self->CurrentUser );
1459 my ( $transaction, $msg ) = $trans->Create(
1460 ObjectId => $self->Id,
1461 ObjectType => ref($self),
1462 TimeTaken => $args{'TimeTaken'},
1463 Type => $args{'Type'},
1464 Data => $args{'Data'},
1465 Field => $args{'Field'},
1466 NewValue => $args{'NewValue'},
1467 OldValue => $args{'OldValue'},
1468 NewReference => $new_ref,
1469 OldReference => $old_ref,
1470 ReferenceType => $ref_type,
1471 MIMEObj => $args{'MIMEObj'},
1472 ActivateScrips => $args{'ActivateScrips'},
1473 CommitScrips => $args{'CommitScrips'},
1474 SquelchMailTo => $args{'SquelchMailTo'},
1475 );
1476
1477 # Rationalize the object since we may have done things to it during the caching.
1478 $self->Load($self->Id);
1479
1480 $RT::Logger->warning($msg) unless $transaction;
1481
1482 $self->_SetLastUpdated;
1483
1484 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1485 $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1486 }
1487 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1488 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1489 }
1490 return ( $transaction, $msg, $trans );
1491}
1492
1493
1494
1495=head2 Transactions
1496
1497 Returns an RT::Transactions object of all transactions on this record object
1498
1499=cut
1500
1501sub Transactions {
1502 my $self = shift;
1503
1504 use RT::Transactions;
1505 my $transactions = RT::Transactions->new( $self->CurrentUser );
1506
1507 #If the user has no rights, return an empty object
1508 $transactions->Limit(
1509 FIELD => 'ObjectId',
1510 VALUE => $self->id,
1511 );
1512 $transactions->Limit(
1513 FIELD => 'ObjectType',
1514 VALUE => ref($self),
1515 );
1516
1517 return ($transactions);
1518}
1519
1520#
1521
1522sub CustomFields {
1523 my $self = shift;
1524 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1525
1526 $cfs->SetContextObject( $self );
1527 # XXX handle multiple types properly
1528 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1529 $cfs->LimitToGlobalOrObjectId(
1530 $self->_LookupId( $self->CustomFieldLookupType )
1531 );
1532 $cfs->ApplySortOrder;
1533
1534 return $cfs;
1535}
1536
1537# TODO: This _only_ works for RT::Class classes. it doesn't work, for example,
1538# for RT::IR classes.
1539
1540sub _LookupId {
1541 my $self = shift;
1542 my $lookup = shift;
1543 my @classes = ($lookup =~ /RT::(\w+)-/g);
1544
1545 my $object = $self;
1546 foreach my $class (reverse @classes) {
1547 my $method = "${class}Obj";
1548 $object = $object->$method;
1549 }
1550
1551 return $object->Id;
1552}
1553
1554
1555=head2 CustomFieldLookupType
1556
1557Returns the path RT uses to figure out which custom fields apply to this object.
1558
1559=cut
1560
1561sub CustomFieldLookupType {
1562 my $self = shift;
1563 return ref($self);
1564}
1565
1566
1567=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1568
1569VALUE should be a string. FIELD can be any identifier of a CustomField
1570supported by L</LoadCustomFieldByIdentifier> method.
1571
1572Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1573deletes the old value.
1574If VALUE is not a valid value for the custom field, returns
1575(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1576$id is ID of created L<ObjectCustomFieldValue> object.
1577
1578=cut
1579
1580sub AddCustomFieldValue {
1581 my $self = shift;
1582 $self->_AddCustomFieldValue(@_);
1583}
1584
1585sub _AddCustomFieldValue {
1586 my $self = shift;
1587 my %args = (
1588 Field => undef,
1589 Value => undef,
1590 LargeContent => undef,
1591 ContentType => undef,
1592 RecordTransaction => 1,
1593 @_
1594 );
1595
1596 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1597 unless ( $cf->Id ) {
1598 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1599 }
1600
1601 my $OCFs = $self->CustomFields;
1602 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1603 unless ( $OCFs->Count ) {
1604 return (
1605 0,
1606 $self->loc(
1607 "Custom field [_1] does not apply to this object",
1608 $args{'Field'}
1609 )
1610 );
1611 }
1612
1613 # empty string is not correct value of any CF, so undef it
1614 foreach ( qw(Value LargeContent) ) {
1615 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1616 }
1617
1618 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1619 return ( 0, $self->loc("Invalid value for custom field") );
1620 }
1621
1622 # If the custom field only accepts a certain # of values, delete the existing
1623 # value and record a "changed from foo to bar" transaction
1624 unless ( $cf->UnlimitedValues ) {
1625
1626 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1627 my $values = $cf->ValuesForObject($self);
1628
1629 # We need to whack any old values here. In most cases, the custom field should
1630 # only have one value to delete. In the pathalogical case, this custom field
1631 # used to be a multiple and we have many values to whack....
1632 my $cf_values = $values->Count;
1633
1634 if ( $cf_values > $cf->MaxValues ) {
1635 my $i = 0; #We want to delete all but the max we can currently have , so we can then
1636 # execute the same code to "change" the value from old to new
1637 while ( my $value = $values->Next ) {
1638 $i++;
1639 if ( $i < $cf_values ) {
1640 my ( $val, $msg ) = $cf->DeleteValueForObject(
1641 Object => $self,
1642 Content => $value->Content
1643 );
1644 unless ($val) {
1645 return ( 0, $msg );
1646 }
1647 my ( $TransactionId, $Msg, $TransactionObj ) =
1648 $self->_NewTransaction(
1649 Type => 'CustomField',
1650 Field => $cf->Id,
1651 OldReference => $value,
1652 );
1653 }
1654 }
1655 $values->RedoSearch if $i; # redo search if have deleted at least one value
1656 }
1657
1658 my ( $old_value, $old_content );
1659 if ( $old_value = $values->First ) {
1660 $old_content = $old_value->Content;
1661 $old_content = undef if defined $old_content && !length $old_content;
1662
1663 my $is_the_same = 1;
1664 if ( defined $args{'Value'} ) {
1665 $is_the_same = 0 unless defined $old_content
1666 && lc $old_content eq lc $args{'Value'};
1667 } else {
1668 $is_the_same = 0 if defined $old_content;
1669 }
1670 if ( $is_the_same ) {
1671 my $old_content = $old_value->LargeContent;
1672 if ( defined $args{'LargeContent'} ) {
1673 $is_the_same = 0 unless defined $old_content
1674 && $old_content eq $args{'LargeContent'};
1675 } else {
1676 $is_the_same = 0 if defined $old_content;
1677 }
1678 }
1679
1680 return $old_value->id if $is_the_same;
1681 }
1682
1683 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1684 Object => $self,
1685 Content => $args{'Value'},
1686 LargeContent => $args{'LargeContent'},
1687 ContentType => $args{'ContentType'},
1688 );
1689
1690 unless ( $new_value_id ) {
1691 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1692 }
1693
1694 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1695 $new_value->Load( $new_value_id );
1696
1697 # now that adding the new value was successful, delete the old one
1698 if ( $old_value ) {
1699 my ( $val, $msg ) = $old_value->Delete();
1700 return ( 0, $msg ) unless $val;
1701 }
1702
1703 if ( $args{'RecordTransaction'} ) {
1704 my ( $TransactionId, $Msg, $TransactionObj ) =
1705 $self->_NewTransaction(
1706 Type => 'CustomField',
1707 Field => $cf->Id,
1708 OldReference => $old_value,
1709 NewReference => $new_value,
1710 );
1711 }
1712
1713 my $new_content = $new_value->Content;
1714
1715 # For datetime, we need to display them in "human" format in result message
1716 #XXX TODO how about date without time?
1717 if ($cf->Type eq 'DateTime') {
1718 my $DateObj = RT::Date->new( $self->CurrentUser );
1719 $DateObj->Set(
1720 Format => 'ISO',
1721 Value => $new_content,
1722 );
1723 $new_content = $DateObj->AsString;
1724
1725 if ( defined $old_content && length $old_content ) {
1726 $DateObj->Set(
1727 Format => 'ISO',
1728 Value => $old_content,
1729 );
1730 $old_content = $DateObj->AsString;
1731 }
1732 }
1733
1734 unless ( defined $old_content && length $old_content ) {
1735 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1736 }
1737 elsif ( !defined $new_content || !length $new_content ) {
1738 return ( $new_value_id,
1739 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1740 }
1741 else {
1742 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1743 }
1744
1745 }
1746
1747 # otherwise, just add a new value and record "new value added"
1748 else {
1749 my ($new_value_id, $msg) = $cf->AddValueForObject(
1750 Object => $self,
1751 Content => $args{'Value'},
1752 LargeContent => $args{'LargeContent'},
1753 ContentType => $args{'ContentType'},
1754 );
1755
1756 unless ( $new_value_id ) {
1757 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1758 }
1759 if ( $args{'RecordTransaction'} ) {
1760 my ( $tid, $msg ) = $self->_NewTransaction(
1761 Type => 'CustomField',
1762 Field => $cf->Id,
1763 NewReference => $new_value_id,
1764 ReferenceType => 'RT::ObjectCustomFieldValue',
1765 );
1766 unless ( $tid ) {
1767 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1768 }
1769 }
1770 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1771 }
1772}
1773
1774
1775
1776=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1777
1778Deletes VALUE as a value of CustomField FIELD.
1779
1780VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1781
1782If VALUE is not a valid value for the custom field, returns
1783(0, 'Error message' ) otherwise, returns (1, 'Success Message')
1784
1785=cut
1786
1787sub DeleteCustomFieldValue {
1788 my $self = shift;
1789 my %args = (
1790 Field => undef,
1791 Value => undef,
1792 ValueId => undef,
1793 @_
1794 );
1795
1796 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1797 unless ( $cf->Id ) {
1798 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1799 }
1800
1801 my ( $val, $msg ) = $cf->DeleteValueForObject(
1802 Object => $self,
1803 Id => $args{'ValueId'},
1804 Content => $args{'Value'},
1805 );
1806 unless ($val) {
1807 return ( 0, $msg );
1808 }
1809
1810 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1811 Type => 'CustomField',
1812 Field => $cf->Id,
1813 OldReference => $val,
1814 ReferenceType => 'RT::ObjectCustomFieldValue',
1815 );
1816 unless ($TransactionId) {
1817 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1818 }
1819
1820 my $old_value = $TransactionObj->OldValue;
1821 # For datetime, we need to display them in "human" format in result message
1822 if ( $cf->Type eq 'DateTime' ) {
1823 my $DateObj = RT::Date->new( $self->CurrentUser );
1824 $DateObj->Set(
1825 Format => 'ISO',
1826 Value => $old_value,
1827 );
1828 $old_value = $DateObj->AsString;
1829 }
1830 return (
1831 $TransactionId,
1832 $self->loc(
1833 "[_1] is no longer a value for custom field [_2]",
1834 $old_value, $cf->Name
1835 )
1836 );
1837}
1838
1839
1840
1841=head2 FirstCustomFieldValue FIELD
1842
1843Return the content of the first value of CustomField FIELD for this ticket
1844Takes a field id or name
1845
1846=cut
1847
1848sub FirstCustomFieldValue {
1849 my $self = shift;
1850 my $field = shift;
1851
1852 my $values = $self->CustomFieldValues( $field );
1853 return undef unless my $first = $values->First;
1854 return $first->Content;
1855}
1856
1857=head2 CustomFieldValuesAsString FIELD
1858
1859Return the content of the CustomField FIELD for this ticket.
1860If this is a multi-value custom field, values will be joined with newlines.
1861
1862Takes a field id or name as the first argument
1863
1864Takes an optional Separator => "," second and third argument
1865if you want to join the values using something other than a newline
1866
1867=cut
1868
1869sub CustomFieldValuesAsString {
1870 my $self = shift;
1871 my $field = shift;
1872 my %args = @_;
1873 my $separator = $args{Separator} || "\n";
1874
1875 my $values = $self->CustomFieldValues( $field );
1876 return join ($separator, grep { defined $_ }
1877 map { $_->Content } @{$values->ItemsArrayRef});
1878}
1879
1880
1881
1882=head2 CustomFieldValues FIELD
1883
1884Return a ObjectCustomFieldValues object of all values of the CustomField whose
1885id or Name is FIELD for this record.
1886
1887Returns an RT::ObjectCustomFieldValues object
1888
1889=cut
1890
1891sub CustomFieldValues {
1892 my $self = shift;
1893 my $field = shift;
1894
1895 if ( $field ) {
1896 my $cf = $self->LoadCustomFieldByIdentifier( $field );
1897
1898 # we were asked to search on a custom field we couldn't find
1899 unless ( $cf->id ) {
1900 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
1901 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1902 }
1903 return ( $cf->ValuesForObject($self) );
1904 }
1905
1906 # we're not limiting to a specific custom field;
1907 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1908 $ocfs->LimitToObject( $self );
1909 return $ocfs;
1910}
1911
1912=head2 LoadCustomFieldByIdentifier IDENTIFER
1913
1914Find the custom field has id or name IDENTIFIER for this object.
1915
1916If no valid field is found, returns an empty RT::CustomField object.
1917
1918=cut
1919
1920sub LoadCustomFieldByIdentifier {
1921 my $self = shift;
1922 my $field = shift;
1923
1924 my $cf;
1925 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1926 $cf = RT::CustomField->new($self->CurrentUser);
1927 $cf->SetContextObject( $self );
1928 $cf->LoadById( $field->id );
1929 }
1930 elsif ($field =~ /^\d+$/) {
1931 $cf = RT::CustomField->new($self->CurrentUser);
1932 $cf->SetContextObject( $self );
1933 $cf->LoadById($field);
1934 } else {
1935
1936 my $cfs = $self->CustomFields($self->CurrentUser);
1937 $cfs->SetContextObject( $self );
1938 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
1939 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1940 }
1941 return $cf;
1942}
1943
1944sub ACLEquivalenceObjects { }
1945
1946sub BasicColumns { }
1947
1948sub WikiBase {
1949 return RT->Config->Get('WebPath'). "/index.html?q=";
1950}
1951
1952RT::Base->_ImportOverlays();
1953
19541;
USIT - Request tracker