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