Upgrade to 4.2.8
[usit-rt.git] / lib / RT / Record.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
3ffc5f4f 5# This software is Copyright (c) 1996-2014 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
3ffc5f4f
MKG
69use RT;
70use base RT->Config->Get('RecordBaseClass');
71use base 'RT::Base';
84fb5b46 72
3ffc5f4f
MKG
73require RT::Date;
74require RT::User;
75require RT::Attributes;
76require RT::Transactions;
77require RT::Link;
84fb5b46
MKG
78
79our $_TABLE_ATTR = { };
84fb5b46
MKG
80
81
82sub _Init {
83 my $self = shift;
84 $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
85 $self->CurrentUser(@_);
86}
87
88
89
90=head2 _PrimaryKeys
91
92The primary keys for RT classes is 'id'
93
94=cut
95
96sub _PrimaryKeys { return ['id'] }
97# short circuit many, many thousands of calls from searchbuilder
98sub _PrimaryKey { 'id' }
99
100=head2 Id
101
102Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
103on a very common codepath
104
105C<id> is an alias to C<Id> and is the preferred way to call this method.
106
107=cut
108
109sub Id {
110 return shift->{'values'}->{id};
111}
112
113*id = \&Id;
114
115=head2 Delete
116
117Delete this record object from the database.
118
119=cut
120
121sub Delete {
122 my $self = shift;
123 my ($rv) = $self->SUPER::Delete;
124 if ($rv) {
125 return ($rv, $self->loc("Object deleted"));
126 } else {
127
128 return(0, $self->loc("Object could not be deleted"))
129 }
130}
131
3ffc5f4f 132=head2 RecordType
84fb5b46 133
3ffc5f4f
MKG
134Returns a string which is this record's type. It's not localized and by
135default last part (everything after last ::) of class name is returned.
84fb5b46 136
3ffc5f4f
MKG
137=cut
138
139sub RecordType {
140 my $res = ref($_[0]) || $_[0];
141 $res =~ s/.*:://;
142 return $res;
143}
144
145=head2 ObjectTypeStr
146
147DEPRECATED. Stays here for backwards. Returns localized L</RecordType>.
84fb5b46
MKG
148
149=cut
150
3ffc5f4f
MKG
151# we deprecate because of:
152# * ObjectType is used in several classes with ObjectId to store
153# records of different types, for example transactions use those
154# and it's unclear what this method should return 'Transaction'
155# or type of referenced record
156# * returning localized thing is not good idea
157
84fb5b46
MKG
158sub ObjectTypeStr {
159 my $self = shift;
3ffc5f4f
MKG
160 RT->Deprecated(
161 Remove => "4.4",
162 Instead => "RecordType",
163 );
164 return $self->loc( $self->RecordType( @_ ) );
84fb5b46
MKG
165}
166
167=head2 Attributes
168
169Return this object's attributes as an RT::Attributes object
170
171=cut
172
173sub Attributes {
174 my $self = shift;
175 unless ($self->{'attributes'}) {
176 $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
177 $self->{'attributes'}->LimitToObject($self);
178 $self->{'attributes'}->OrderByCols({FIELD => 'id'});
179 }
180 return ($self->{'attributes'});
181}
182
183
184=head2 AddAttribute { Name, Description, Content }
185
186Adds a new attribute for this object.
187
188=cut
189
190sub AddAttribute {
191 my $self = shift;
192 my %args = ( Name => undef,
193 Description => undef,
194 Content => undef,
195 @_ );
196
197 my $attr = RT::Attribute->new( $self->CurrentUser );
198 my ( $id, $msg ) = $attr->Create(
199 Object => $self,
200 Name => $args{'Name'},
201 Description => $args{'Description'},
202 Content => $args{'Content'} );
203
204
205 # XXX TODO: Why won't RedoSearch work here?
206 $self->Attributes->_DoSearch;
207
208 return ($id, $msg);
209}
210
211
212=head2 SetAttribute { Name, Description, Content }
213
214Like AddAttribute, but replaces all existing attributes with the same Name.
215
216=cut
217
218sub SetAttribute {
219 my $self = shift;
220 my %args = ( Name => undef,
221 Description => undef,
222 Content => undef,
223 @_ );
224
225 my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
226 or return $self->AddAttribute( %args );
227
228 my $AttributeObj = pop( @AttributeObjs );
229 $_->Delete foreach @AttributeObjs;
230
231 $AttributeObj->SetDescription( $args{'Description'} );
232 $AttributeObj->SetContent( $args{'Content'} );
233
234 $self->Attributes->RedoSearch;
235 return 1;
236}
237
238=head2 DeleteAttribute NAME
239
240Deletes all attributes with the matching name for this object.
241
242=cut
243
244sub DeleteAttribute {
245 my $self = shift;
246 my $name = shift;
247 my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name );
248 $self->ClearAttributes;
249 return ($val,$msg);
250}
251
252=head2 FirstAttribute NAME
253
254Returns the first attribute with the matching name for this object (as an
255L<RT::Attribute> object), or C<undef> if no such attributes exist.
256If there is more than one attribute with the matching name on the
257object, the first value that was set is returned.
258
259=cut
260
261sub FirstAttribute {
262 my $self = shift;
263 my $name = shift;
264 return ($self->Attributes->Named( $name ))[0];
265}
266
267
268sub ClearAttributes {
269 my $self = shift;
270 delete $self->{'attributes'};
271
272}
273
274sub _Handle { return $RT::Handle }
275
276
277
278=head2 Create PARAMHASH
279
280Takes a PARAMHASH of Column -> Value pairs.
281If any Column has a Validate$PARAMNAME subroutine defined and the
282value provided doesn't pass validation, this routine returns
283an error.
284
285If this object's table has any of the following atetributes defined as
286'Auto', this routine will automatically fill in their values.
287
288=over
289
290=item Created
291
292=item Creator
293
294=item LastUpdated
295
296=item LastUpdatedBy
297
298=back
299
300=cut
301
302sub Create {
303 my $self = shift;
304 my %attribs = (@_);
305 foreach my $key ( keys %attribs ) {
306 if (my $method = $self->can("Validate$key")) {
307 if (! $method->( $self, $attribs{$key} ) ) {
308 if (wantarray) {
309 return ( 0, $self->loc('Invalid value for [_1]', $key) );
310 }
311 else {
312 return (0);
313 }
314 }
315 }
316 }
317
318
319
320 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
321
322 my $now_iso =
323 sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
324
325 $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
326
327 if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
328 $attribs{'Creator'} = $self->CurrentUser->id || '0';
329 }
330 $attribs{'LastUpdated'} = $now_iso
331 if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
332
333 $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
334 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
335
336 my $id = $self->SUPER::Create(%attribs);
337 if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
338 if ( $id->errno ) {
339 if (wantarray) {
340 return ( 0,
341 $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
342 }
343 else {
344 return (0);
345 }
346 }
347 }
348 # If the object was created in the database,
349 # load it up now, so we're sure we get what the database
350 # has. Arguably, this should not be necessary, but there
351 # isn't much we can do about it.
352
353 unless ($id) {
354 if (wantarray) {
355 return ( $id, $self->loc('Object could not be created') );
356 }
357 else {
358 return ($id);
359 }
360
361 }
362
363 if (UNIVERSAL::isa('errno',$id)) {
364 return(undef);
365 }
366
367 $self->Load($id) if ($id);
368
369
370
371 if (wantarray) {
372 return ( $id, $self->loc('Object created') );
373 }
374 else {
375 return ($id);
376 }
377
378}
379
380
381
382=head2 LoadByCols
383
384Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
385DB is case sensitive
386
387=cut
388
389sub LoadByCols {
390 my $self = shift;
391
392 # We don't want to hang onto this
393 $self->ClearAttributes;
394
3ffc5f4f
MKG
395 unless ( $self->_Handle->CaseSensitive ) {
396 my ( $ret, $msg ) = $self->SUPER::LoadByCols( @_ );
397 return wantarray ? ( $ret, $msg ) : $ret;
398 }
84fb5b46
MKG
399
400 # If this database is case sensitive we need to uncase objects for
401 # explicit loading
402 my %hash = (@_);
403 foreach my $key ( keys %hash ) {
404
405 # If we've been passed an empty value, we can't do the lookup.
406 # We don't need to explicitly downcase integers or an id.
407 if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
408 my ($op, $val, $func);
409 ($key, $op, $val, $func) =
410 $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
411 $hash{$key}->{operator} = $op;
412 $hash{$key}->{value} = $val;
413 $hash{$key}->{function} = $func;
414 }
415 }
3ffc5f4f
MKG
416 my ( $ret, $msg ) = $self->SUPER::LoadByCols( %hash );
417 return wantarray ? ( $ret, $msg ) : $ret;
84fb5b46
MKG
418}
419
420
421
422# There is room for optimizations in most of those subs:
423
424
425sub LastUpdatedObj {
426 my $self = shift;
427 my $obj = RT::Date->new( $self->CurrentUser );
428
429 $obj->Set( Format => 'sql', Value => $self->LastUpdated );
430 return $obj;
431}
432
433
434
435sub CreatedObj {
436 my $self = shift;
437 my $obj = RT::Date->new( $self->CurrentUser );
438
439 $obj->Set( Format => 'sql', Value => $self->Created );
440
441 return $obj;
442}
443
444
3ffc5f4f 445# B<DEPRECATED> and will be removed in 4.4
84fb5b46
MKG
446sub AgeAsString {
447 my $self = shift;
3ffc5f4f
MKG
448 RT->Deprecated(
449 Remove => "4.4",
450 Instead => "->CreatedObj->AgeAsString",
451 );
84fb5b46
MKG
452 return ( $self->CreatedObj->AgeAsString() );
453}
454
3ffc5f4f
MKG
455# B<DEPRECATED> and will be removed in 4.4
456sub LongSinceUpdateAsString {
457 my $self = shift;
458 RT->Deprecated(
459 Remove => "4.4",
460 Instead => "->LastUpdatedObj->AgeAsString",
461 );
462 if ( $self->LastUpdated ) {
463 return ( $self->LastUpdatedObj->AgeAsString() );
464 } else {
465 return "never";
466 }
467}
84fb5b46
MKG
468
469sub LastUpdatedAsString {
470 my $self = shift;
471 if ( $self->LastUpdated ) {
472 return ( $self->LastUpdatedObj->AsString() );
3ffc5f4f 473 } else {
84fb5b46
MKG
474 return "never";
475 }
476}
477
84fb5b46
MKG
478sub CreatedAsString {
479 my $self = shift;
480 return ( $self->CreatedObj->AsString() );
481}
482
84fb5b46
MKG
483sub _Set {
484 my $self = shift;
485
486 my %args = (
487 Field => undef,
488 Value => undef,
489 IsSQL => undef,
490 @_
491 );
492
493 #if the user is trying to modify the record
494 # TODO: document _why_ this code is here
495
496 if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
497 $args{'Value'} = 0;
498 }
499
500 my $old_val = $self->__Value($args{'Field'});
501 $self->_SetLastUpdated();
502 my $ret = $self->SUPER::_Set(
503 Field => $args{'Field'},
504 Value => $args{'Value'},
505 IsSQL => $args{'IsSQL'}
506 );
507 my ($status, $msg) = $ret->as_array();
508
509 # @values has two values, a status code and a message.
510
511 # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
512 # we want to change the standard "success" message
513 if ($status) {
403d7b0b
MKG
514 if ($self->SQLType( $args{'Field'}) =~ /text/) {
515 $msg = $self->loc(
516 "[_1] updated",
517 $self->loc( $args{'Field'} ),
518 );
519 } else {
520 $msg = $self->loc(
521 "[_1] changed from [_2] to [_3]",
522 $self->loc( $args{'Field'} ),
523 ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
524 '"' . $self->__Value( $args{'Field'}) . '"',
525 );
526 }
527 } else {
528 $msg = $self->CurrentUser->loc_fuzzy($msg);
84fb5b46 529 }
84fb5b46 530
403d7b0b 531 return wantarray ? ($status, $msg) : $ret;
84fb5b46
MKG
532}
533
534
535
536=head2 _SetLastUpdated
537
538This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
539It takes no options. Arguably, this is a bug
540
541=cut
542
543sub _SetLastUpdated {
544 my $self = shift;
84fb5b46
MKG
545 my $now = RT::Date->new( $self->CurrentUser );
546 $now->SetToNow();
547
548 if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
549 my ( $msg, $val ) = $self->__Set(
550 Field => 'LastUpdated',
551 Value => $now->ISO
552 );
553 }
554 if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
555 my ( $msg, $val ) = $self->__Set(
556 Field => 'LastUpdatedBy',
557 Value => $self->CurrentUser->id
558 );
559 }
560}
561
562
563
564=head2 CreatorObj
565
566Returns an RT::User object with the RT account of the creator of this row
567
568=cut
569
570sub CreatorObj {
571 my $self = shift;
572 unless ( exists $self->{'CreatorObj'} ) {
573
574 $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
575 $self->{'CreatorObj'}->Load( $self->Creator );
576 }
577 return ( $self->{'CreatorObj'} );
578}
579
580
581
582=head2 LastUpdatedByObj
583
584 Returns an RT::User object of the last user to touch this object
585
586=cut
587
588sub LastUpdatedByObj {
589 my $self = shift;
590 unless ( exists $self->{LastUpdatedByObj} ) {
591 $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
592 $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
593 }
594 return $self->{'LastUpdatedByObj'};
595}
596
597
598
599=head2 URI
600
601Returns this record's URI
602
603=cut
604
605sub URI {
606 my $self = shift;
607 my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
608 return($uri->URIForObject($self));
609}
610
611
612=head2 ValidateName NAME
613
614Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
615
616=cut
617
618sub ValidateName {
619 my $self = shift;
620 my $value = shift;
621 if (defined $value && $value=~ /^\d+$/) {
622 return(0);
623 } else {
624 return(1);
625 }
626}
627
628
629
630=head2 SQLType attribute
631
632return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
633
634=cut
635
636sub SQLType {
637 my $self = shift;
638 my $field = shift;
639
640 return ($self->_Accessible($field, 'type'));
641
642
643}
644
645sub __Value {
646 my $self = shift;
647 my $field = shift;
648 my %args = ( decode_utf8 => 1, @_ );
649
650 unless ($field) {
651 $RT::Logger->error("__Value called with undef field");
652 }
653
654 my $value = $self->SUPER::__Value($field);
3ffc5f4f 655 return $value if ref $value;
84fb5b46 656
dab09ea8
MKG
657 return undef if (!defined $value);
658
3ffc5f4f
MKG
659 # Pg returns character columns as character strings; mysql and
660 # sqlite return them as bytes. While mysql can be made to return
661 # characters, using the mysql_enable_utf8 flag, the "Content" column
662 # is bytes on mysql and characters on Postgres, making true
663 # consistency impossible.
84fb5b46 664 if ( $args{'decode_utf8'} ) {
3ffc5f4f 665 if ( !utf8::is_utf8($value) ) { # mysql/sqlite
84fb5b46
MKG
666 utf8::decode($value);
667 }
3ffc5f4f 668 } else {
84fb5b46
MKG
669 if ( utf8::is_utf8($value) ) {
670 utf8::encode($value);
671 }
672 }
673
674 return $value;
675
676}
677
678# Set up defaults for DBIx::SearchBuilder::Record::Cachable
679
680sub _CacheConfig {
681 {
682 'cache_p' => 1,
683 'cache_for_sec' => 30,
684 }
685}
686
687
688
689sub _BuildTableAttributes {
690 my $self = shift;
691 my $class = ref($self) || $self;
692
693 my $attributes;
694 if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
695 $attributes = $self->_CoreAccessible();
696 } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
697 $attributes = $self->_ClassAccessible();
698
699 }
700
701 foreach my $column (keys %$attributes) {
702 foreach my $attr ( keys %{ $attributes->{$column} } ) {
703 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
704 }
705 }
706 foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
707 next unless UNIVERSAL::can( $self, $method );
708 $attributes = $self->$method();
709
710 foreach my $column ( keys %$attributes ) {
711 foreach my $attr ( keys %{ $attributes->{$column} } ) {
712 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
713 }
714 }
715 }
716}
717
718
719=head2 _ClassAccessible
720
721Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
722DBIx::SearchBuilder::Record
723
724=cut
725
726sub _ClassAccessible {
727 my $self = shift;
728 return $_TABLE_ATTR->{ref($self) || $self};
729}
730
731=head2 _Accessible COLUMN ATTRIBUTE
732
733returns the value of ATTRIBUTE for COLUMN
734
735
736=cut
737
738sub _Accessible {
739 my $self = shift;
740 my $column = shift;
741 my $attribute = lc(shift);
3ffc5f4f
MKG
742
743 my $class = ref($self) || $self;
744 $class->_BuildTableAttributes unless ($_TABLE_ATTR->{$class});
745
746 return 0 unless defined ($_TABLE_ATTR->{$class}->{$column});
747 return $_TABLE_ATTR->{$class}->{$column}->{$attribute} || 0;
84fb5b46
MKG
748
749}
750
3ffc5f4f 751=head2 _EncodeLOB BODY MIME_TYPE FILENAME
84fb5b46 752
3ffc5f4f
MKG
753Takes a potentially large attachment. Returns (ContentEncoding,
754EncodedBody, MimeType, Filename, NoteArgs) based on system configuration and
755selected database. Returns a custom (short) text/plain message if
756DropLongAttachments causes an attachment to not be stored.
757
758Encodes your data as base64 or Quoted-Printable as needed based on your
759Databases's restrictions and the UTF-8ness of the data being passed in. Since
760we are storing in columns marked UTF8, we must ensure that binary data is
761encoded on databases which are strict.
762
763This function expects to receive an octet string in order to properly
764evaluate and encode it. It will return an octet string.
765
766NoteArgs is currently used to indicate caller that the message is too long and
767is truncated or dropped. It's a hashref which is expected to be passed to
768L<RT::Record/_NewTransaction>.
84fb5b46
MKG
769
770=cut
771
772sub _EncodeLOB {
3ffc5f4f
MKG
773 my $self = shift;
774 my $Body = shift;
775 my $MIMEType = shift || '';
776 my $Filename = shift;
84fb5b46 777
3ffc5f4f
MKG
778 my $ContentEncoding = 'none';
779 my $note_args;
84fb5b46 780
3ffc5f4f 781 RT::Util::assert_bytes( $Body );
84fb5b46 782
3ffc5f4f
MKG
783 #get the max attachment length from RT
784 my $MaxSize = RT->Config->Get('MaxAttachmentSize');
84fb5b46 785
3ffc5f4f
MKG
786 #if the current attachment contains nulls and the
787 #database doesn't support embedded nulls
84fb5b46 788
3ffc5f4f 789 if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
84fb5b46 790
3ffc5f4f
MKG
791 # set a flag telling us to mimencode the attachment
792 $ContentEncoding = 'base64';
84fb5b46 793
3ffc5f4f
MKG
794 #cut the max attchment size by 25% (for mime-encoding overhead.
795 $RT::Logger->debug("Max size is $MaxSize");
796 $MaxSize = $MaxSize * 3 / 4;
797 # Some databases (postgres) can't handle non-utf8 data
798 } elsif ( !$RT::Handle->BinarySafeBLOBs
799 && $Body =~ /\P{ASCII}/
800 && !Encode::is_utf8( $Body, 1 ) ) {
801 $ContentEncoding = 'quoted-printable';
802 }
84fb5b46 803
3ffc5f4f
MKG
804 #if the attachment is larger than the maximum size
805 if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
84fb5b46 806
3ffc5f4f
MKG
807 my $size = length $Body;
808 # if we're supposed to truncate large attachments
809 if (RT->Config->Get('TruncateLongAttachments')) {
84fb5b46 810
3ffc5f4f 811 $RT::Logger->info("$self: Truncated an attachment of size $size");
84fb5b46 812
3ffc5f4f
MKG
813 # truncate the attachment to that length.
814 $Body = substr( $Body, 0, $MaxSize );
815 $note_args = {
816 Type => 'AttachmentTruncate',
817 Data => $Filename,
818 OldValue => $size,
819 NewValue => $MaxSize,
820 ActivateScrips => 0,
821 };
84fb5b46 822
84fb5b46
MKG
823 }
824
3ffc5f4f
MKG
825 # elsif we're supposed to drop large attachments on the floor,
826 elsif (RT->Config->Get('DropLongAttachments')) {
827
828 # drop the attachment on the floor
829 $RT::Logger->info( "$self: Dropped an attachment of size $size" );
830 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
831 $note_args = {
832 Type => 'AttachmentDrop',
833 Data => $Filename,
834 OldValue => $size,
835 NewValue => $MaxSize,
836 ActivateScrips => 0,
837 };
838 $Filename .= ".txt" if $Filename && $Filename !~ /\.txt$/;
839 return ("none", "Large attachment dropped", "text/plain", $Filename, $note_args );
84fb5b46 840 }
3ffc5f4f 841 }
84fb5b46 842
3ffc5f4f
MKG
843 # if we need to mimencode the attachment
844 if ( $ContentEncoding eq 'base64' ) {
845 # base64 encode the attachment
846 $Body = MIME::Base64::encode_base64($Body);
847
848 } elsif ($ContentEncoding eq 'quoted-printable') {
849 $Body = MIME::QuotedPrint::encode($Body);
850 }
84fb5b46 851
84fb5b46 852
3ffc5f4f 853 return ($ContentEncoding, $Body, $MIMEType, $Filename, $note_args );
84fb5b46
MKG
854}
855
3ffc5f4f
MKG
856=head2 _DecodeLOB C<ContentType>, C<ContentEncoding>, C<Content>
857
858Unpacks data stored in the database, which may be base64 or QP encoded
859because of our need to store binary and badly encoded data in columns
860marked as UTF-8. Databases such as PostgreSQL and Oracle care that you
861are feeding them invalid UTF-8 and will refuse the content. This
862function handles unpacking the encoded data.
863
864It returns textual data as a UTF-8 string which has been processed by Encode's
865PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see
866the invalid byte but won't run into problems treating the data as UTF-8 later.
867
868This is similar to how we filter all data coming in via the web UI in
869RT::Interface::Web::DecodeARGS. This filter should only end up being
870applied to old data from less UTF-8-safe versions of RT.
871
872If the passed C<ContentType> includes a character set, that will be used
873to decode textual data; the default character set is UTF-8. This is
874necessary because while we attempt to store textual data as UTF-8, the
875definition of "textual" has migrated over time, and thus we may now need
876to attempt to decode data that was previously not trancoded on insertion.
877
878Important Note - This function expects an octet string and returns a
879character string for non-binary data.
880
881=cut
882
84fb5b46
MKG
883sub _DecodeLOB {
884 my $self = shift;
885 my $ContentType = shift || '';
886 my $ContentEncoding = shift || 'none';
887 my $Content = shift;
888
3ffc5f4f
MKG
889 RT::Util::assert_bytes( $Content );
890
84fb5b46
MKG
891 if ( $ContentEncoding eq 'base64' ) {
892 $Content = MIME::Base64::decode_base64($Content);
893 }
894 elsif ( $ContentEncoding eq 'quoted-printable' ) {
895 $Content = MIME::QuotedPrint::decode($Content);
896 }
897 elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
898 return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
899 }
900 if ( RT::I18N::IsTextualContentType($ContentType) ) {
3ffc5f4f
MKG
901 my $entity = MIME::Entity->new();
902 $entity->head->add("Content-Type", $ContentType);
903 $entity->bodyhandle( MIME::Body::Scalar->new( $Content ) );
904 my $charset = RT::I18N::_FindOrGuessCharset($entity);
905 $charset = 'utf-8' if not $charset or not Encode::find_encoding($charset);
906
907 $Content = Encode::decode($charset,$Content,Encode::FB_PERLQQ);
84fb5b46 908 }
3ffc5f4f 909 return ($Content);
84fb5b46
MKG
910}
911
84fb5b46
MKG
912=head2 Update ARGSHASH
913
914Updates fields on an object for you using the proper Set methods,
915skipping unchanged values.
916
917 ARGSRef => a hashref of attributes => value for the update
918 AttributesRef => an arrayref of keys in ARGSRef that should be updated
919 AttributePrefix => a prefix that should be added to the attributes in AttributesRef
920 when looking up values in ARGSRef
921 Bare attributes are tried before prefixed attributes
922
923Returns a list of localized results of the update
924
925=cut
926
927sub Update {
928 my $self = shift;
929
930 my %args = (
931 ARGSRef => undef,
932 AttributesRef => undef,
933 AttributePrefix => undef,
934 @_
935 );
936
937 my $attributes = $args{'AttributesRef'};
938 my $ARGSRef = $args{'ARGSRef'};
939 my %new_values;
940
941 # gather all new values
942 foreach my $attribute (@$attributes) {
943 my $value;
944 if ( defined $ARGSRef->{$attribute} ) {
945 $value = $ARGSRef->{$attribute};
946 }
947 elsif (
948 defined( $args{'AttributePrefix'} )
949 && defined(
950 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
951 )
952 ) {
953 $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
954
955 }
956 else {
957 next;
958 }
959
960 $value =~ s/\r\n/\n/gs;
961
c36a7e1d
MKG
962 my $truncated_value = $self->TruncateValue($attribute, $value);
963
84fb5b46
MKG
964 # If Queue is 'General', we want to resolve the queue name for
965 # the object.
966
967 # This is in an eval block because $object might not exist.
968 # and might not have a Name method. But "can" won't find autoloaded
969 # items. If it fails, we don't care
970 do {
971 no warnings "uninitialized";
972 local $@;
3ffc5f4f 973 my $name = eval {
84fb5b46 974 my $object = $attribute . "Obj";
3ffc5f4f 975 $self->$object->Name;
84fb5b46 976 };
3ffc5f4f
MKG
977 unless ($@) {
978 next if $name eq $value || $name eq ($value || 0);
979 }
403d7b0b 980
3ffc5f4f
MKG
981 next if $truncated_value eq $self->$attribute();
982 next if ( $truncated_value || 0 ) eq $self->$attribute();
84fb5b46
MKG
983 };
984
985 $new_values{$attribute} = $value;
986 }
987
988 return $self->_UpdateAttributes(
989 Attributes => $attributes,
990 NewValues => \%new_values,
991 );
992}
993
994sub _UpdateAttributes {
995 my $self = shift;
996 my %args = (
997 Attributes => [],
998 NewValues => {},
999 @_,
1000 );
1001
1002 my @results;
1003
1004 foreach my $attribute (@{ $args{Attributes} }) {
1005 next if !exists($args{NewValues}{$attribute});
1006
1007 my $value = $args{NewValues}{$attribute};
1008 my $method = "Set$attribute";
1009 my ( $code, $msg ) = $self->$method($value);
1010 my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
1011
1012 # Default to $id, but use name if we can get it.
1013 my $label = $self->id;
1014 $label = $self->Name if (UNIVERSAL::can($self,'Name'));
1015 # this requires model names to be loc'ed.
1016
1017=for loc
1018
1019 "Ticket" # loc
1020 "User" # loc
1021 "Group" # loc
1022 "Queue" # loc
1023
1024=cut
1025
1026 push @results, $self->loc( $prefix ) . " $label: ". $msg;
1027
1028=for loc
1029
1030 "[_1] could not be set to [_2].", # loc
1031 "That is already the current value", # loc
1032 "No value sent to _Set!", # loc
1033 "Illegal value for [_1]", # loc
1034 "The new value has been set.", # loc
1035 "No column specified", # loc
1036 "Immutable field", # loc
1037 "Nonexistant field?", # loc
1038 "Invalid data", # loc
1039 "Couldn't find row", # loc
1040 "Missing a primary key?: [_1]", # loc
1041 "Found Object", # loc
1042
1043=cut
1044
1045 }
1046
1047 return @results;
1048}
1049
1050
1051
1052
1053=head2 Members
1054
1055 This returns an RT::Links object which references all the tickets
1056which are 'MembersOf' this ticket
1057
1058=cut
1059
1060sub Members {
1061 my $self = shift;
1062 return ( $self->_Links( 'Target', 'MemberOf' ) );
1063}
1064
1065
1066
1067=head2 MemberOf
1068
1069 This returns an RT::Links object which references all the tickets that this
1070ticket is a 'MemberOf'
1071
1072=cut
1073
1074sub MemberOf {
1075 my $self = shift;
1076 return ( $self->_Links( 'Base', 'MemberOf' ) );
1077}
1078
1079
1080
1081=head2 RefersTo
1082
1083 This returns an RT::Links object which shows all references for which this ticket is a base
1084
1085=cut
1086
1087sub RefersTo {
1088 my $self = shift;
1089 return ( $self->_Links( 'Base', 'RefersTo' ) );
1090}
1091
1092
1093
1094=head2 ReferredToBy
1095
1096This returns an L<RT::Links> object which shows all references for which this ticket is a target
1097
1098=cut
1099
1100sub ReferredToBy {
1101 my $self = shift;
1102 return ( $self->_Links( 'Target', 'RefersTo' ) );
1103}
1104
1105
1106
1107=head2 DependedOnBy
1108
1109 This returns an RT::Links object which references all the tickets that depend on this one
1110
1111=cut
1112
1113sub DependedOnBy {
1114 my $self = shift;
1115 return ( $self->_Links( 'Target', 'DependsOn' ) );
1116}
1117
1118
1119
1120
1121=head2 HasUnresolvedDependencies
1122
1123Takes a paramhash of Type (default to '__any'). Returns the number of
1124unresolved dependencies, if $self->UnresolvedDependencies returns an
1125object with one or more members of that type. Returns false
1126otherwise.
1127
1128=cut
1129
1130sub HasUnresolvedDependencies {
1131 my $self = shift;
1132 my %args = (
1133 Type => undef,
1134 @_
1135 );
1136
1137 my $deps = $self->UnresolvedDependencies;
1138
1139 if ($args{Type}) {
3ffc5f4f
MKG
1140 $deps->LimitType( VALUE => $args{Type} );
1141 } else {
1142 $deps->IgnoreType;
84fb5b46
MKG
1143 }
1144
1145 if ($deps->Count > 0) {
1146 return $deps->Count;
1147 }
1148 else {
1149 return (undef);
1150 }
1151}
1152
1153
1154
1155=head2 UnresolvedDependencies
1156
1157Returns an RT::Tickets object of tickets which this ticket depends on
1158and which have a status of new, open or stalled. (That list comes from
1159RT::Queue->ActiveStatusArray
1160
1161=cut
1162
1163
1164sub UnresolvedDependencies {
1165 my $self = shift;
1166 my $deps = RT::Tickets->new($self->CurrentUser);
1167
3ffc5f4f 1168 $deps->LimitToActiveStatus;
84fb5b46
MKG
1169 $deps->LimitDependedOnBy($self->Id);
1170
1171 return($deps);
1172
1173}
1174
1175
1176
1177=head2 AllDependedOnBy
1178
1179Returns an array of RT::Ticket objects which (directly or indirectly)
1180depends on this ticket; takes an optional 'Type' argument in the param
1181hash, which will limit returned tickets to that type, as well as cause
1182tickets with that type to serve as 'leaf' nodes that stops the recursive
1183dependency search.
1184
1185=cut
1186
1187sub AllDependedOnBy {
1188 my $self = shift;
1189 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1190 Direction => 'Target', @_ );
1191}
1192
1193=head2 AllDependsOn
1194
1195Returns an array of RT::Ticket objects which this ticket (directly or
1196indirectly) depends on; takes an optional 'Type' argument in the param
1197hash, which will limit returned tickets to that type, as well as cause
1198tickets with that type to serve as 'leaf' nodes that stops the
1199recursive dependency search.
1200
1201=cut
1202
1203sub AllDependsOn {
1204 my $self = shift;
1205 return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1206 Direction => 'Base', @_ );
1207}
1208
1209sub _AllLinkedTickets {
1210 my $self = shift;
1211
1212 my %args = (
1213 LinkType => undef,
1214 Direction => undef,
1215 Type => undef,
3ffc5f4f
MKG
1216 _found => {},
1217 _top => 1,
84fb5b46
MKG
1218 @_
1219 );
1220
1221 my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1222 while (my $link = $dep->Next()) {
1223 my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
3ffc5f4f 1224 next unless ($uri->IsLocal());
84fb5b46 1225 my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
3ffc5f4f 1226 next if $args{_found}{$obj->Id};
84fb5b46 1227
3ffc5f4f
MKG
1228 if (!$args{Type}) {
1229 $args{_found}{$obj->Id} = $obj;
1230 $obj->_AllLinkedTickets( %args, _top => 0 );
1231 }
1232 elsif ($obj->Type and $obj->Type eq $args{Type}) {
1233 $args{_found}{$obj->Id} = $obj;
1234 }
1235 else {
1236 $obj->_AllLinkedTickets( %args, _top => 0 );
1237 }
84fb5b46
MKG
1238 }
1239
1240 if ($args{_top}) {
3ffc5f4f 1241 return map { $args{_found}{$_} } sort keys %{$args{_found}};
84fb5b46
MKG
1242 }
1243 else {
3ffc5f4f 1244 return 1;
84fb5b46
MKG
1245 }
1246}
1247
1248
1249
1250=head2 DependsOn
1251
1252 This returns an RT::Links object which references all the tickets that this ticket depends on
1253
1254=cut
1255
1256sub DependsOn {
1257 my $self = shift;
1258 return ( $self->_Links( 'Base', 'DependsOn' ) );
1259}
1260
1261
1262
1263
1264
1265
1266=head2 Links DIRECTION [TYPE]
1267
1268Return links (L<RT::Links>) to/from this object.
1269
1270DIRECTION is either 'Base' or 'Target'.
1271
1272TYPE is a type of links to return, it can be omitted to get
1273links of any type.
1274
1275=cut
1276
1277sub Links { shift->_Links(@_) }
1278
1279sub _Links {
1280 my $self = shift;
1281
1282 #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1283 #tobias meant by $f
1284 my $field = shift;
1285 my $type = shift || "";
1286
1287 unless ( $self->{"$field$type"} ) {
1288 $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1289 # at least to myself
1290 $self->{"$field$type"}->Limit( FIELD => $field,
1291 VALUE => $self->URI,
1292 ENTRYAGGREGATOR => 'OR' );
1293 $self->{"$field$type"}->Limit( FIELD => 'Type',
1294 VALUE => $type )
1295 if ($type);
1296 }
1297 return ( $self->{"$field$type"} );
1298}
1299
1300
1301
1302
1303=head2 FormatType
1304
1305Takes a Type and returns a string that is more human readable.
1306
1307=cut
1308
1309sub FormatType{
1310 my $self = shift;
1311 my %args = ( Type => '',
3ffc5f4f
MKG
1312 @_
1313 );
84fb5b46
MKG
1314 $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1315 $args{Type} =~ s/^\s+//;
1316 return $args{Type};
1317}
1318
1319
1320
1321
1322=head2 FormatLink
1323
1324Takes either a Target or a Base and returns a string of human friendly text.
1325
1326=cut
1327
1328sub FormatLink {
1329 my $self = shift;
1330 my %args = ( Object => undef,
3ffc5f4f
MKG
1331 FallBack => '',
1332 @_
1333 );
84fb5b46
MKG
1334 my $text = "URI " . $args{FallBack};
1335 if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
3ffc5f4f 1336 $text = "Ticket " . $args{Object}->id;
84fb5b46
MKG
1337 }
1338 return $text;
1339}
1340
84fb5b46
MKG
1341=head2 _AddLink
1342
1343Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1344
3ffc5f4f
MKG
1345If Silent is true then no transactions will be recorded. You can individually
1346control transactions on both base and target and with SilentBase and
1347SilentTarget respectively. By default both transactions are created.
1348
1349If the link destination is a local object and does the
1350L<RT::Record::Role::Status> role, this method ensures object Status is not
1351"deleted". Linking to deleted objects is forbidden.
84fb5b46 1352
3ffc5f4f
MKG
1353If the link destination (i.e. not C<$self>) is a local object and the
1354C<$StrictLinkACL> option is enabled, this method checks the appropriate right
1355on the destination object (if any, as returned by the L</ModifyLinkRight>
1356method). B<< The subclass is expected to check the appropriate right on the
1357source object (i.e. C<$self>) before calling this method. >> This allows a
1358different right to be used on the source object during creation, for example.
1359
1360Returns a tuple of (link ID, message, flag if link already existed).
84fb5b46
MKG
1361
1362=cut
1363
1364sub _AddLink {
1365 my $self = shift;
3ffc5f4f
MKG
1366 my %args = (
1367 Target => '',
1368 Base => '',
1369 Type => '',
1370 Silent => undef,
1371 Silent => undef,
1372 SilentBase => undef,
1373 SilentTarget => undef,
1374 @_
1375 );
84fb5b46
MKG
1376
1377 # Remote_link is the URI of the object that is not this ticket
1378 my $remote_link;
1379 my $direction;
1380
1381 if ( $args{'Base'} and $args{'Target'} ) {
1382 $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
01e3b242 1383 return ( 0, $self->loc("Can't specify both base and target") );
84fb5b46
MKG
1384 }
1385 elsif ( $args{'Base'} ) {
1386 $args{'Target'} = $self->URI();
1387 $remote_link = $args{'Base'};
1388 $direction = 'Target';
1389 }
1390 elsif ( $args{'Target'} ) {
1391 $args{'Base'} = $self->URI();
1392 $remote_link = $args{'Target'};
1393 $direction = 'Base';
1394 }
1395 else {
1396 return ( 0, $self->loc('Either base or target must be specified') );
1397 }
1398
3ffc5f4f
MKG
1399 my $remote_uri = RT::URI->new( $self->CurrentUser );
1400 if ($remote_uri->FromURI( $remote_link )) {
1401 my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef;
1402 if ($remote_obj and $remote_obj->id) {
1403 # Enforce the remote end of StrictLinkACL
1404 if (RT->Config->Get("StrictLinkACL")) {
1405 my $right = $remote_obj->ModifyLinkRight;
1406
1407 return (0, $self->loc("Permission denied"))
1408 if $right and
1409 not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj );
1410 }
1411
1412 # Prevent linking to deleted objects
1413 if ($remote_obj->DOES("RT::Record::Role::Status")
1414 and $remote_obj->Status eq "deleted") {
1415 return (0, $self->loc("Linking to a deleted [_1] is not allowed", $self->loc(lc($remote_obj->RecordType))));
1416 }
1417 }
1418 } else {
1419 return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link));
1420 }
1421
84fb5b46 1422 # Check if the link already exists - we don't want duplicates
84fb5b46
MKG
1423 my $old_link = RT::Link->new( $self->CurrentUser );
1424 $old_link->LoadByParams( Base => $args{'Base'},
1425 Type => $args{'Type'},
1426 Target => $args{'Target'} );
1427 if ( $old_link->Id ) {
1428 $RT::Logger->debug("$self Somebody tried to duplicate a link");
1429 return ( $old_link->id, $self->loc("Link already exists"), 1 );
1430 }
1431
3ffc5f4f 1432 if ( $args{'Type'} =~ /^(?:DependsOn|MemberOf)$/ ) {
84fb5b46 1433
3ffc5f4f
MKG
1434 my @tickets = $self->_AllLinkedTickets(
1435 LinkType => $args{'Type'},
1436 Direction => $direction eq 'Target' ? 'Base' : 'Target',
1437 );
1438 if ( grep { $_->id == ( $direction eq 'Target' ? $args{'Base'} : $args{'Target'} ) } @tickets ) {
1439 return ( 0, $self->loc("Refused to add link which would create a circular relationship") );
1440 }
1441 }
84fb5b46
MKG
1442
1443 # Storing the link in the DB.
1444 my $link = RT::Link->new( $self->CurrentUser );
1445 my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
3ffc5f4f
MKG
1446 Base => $args{Base},
1447 Type => $args{Type} );
84fb5b46
MKG
1448
1449 unless ($linkid) {
1450 $RT::Logger->error("Link could not be created: ".$linkmsg);
3ffc5f4f 1451 return ( 0, $self->loc("Link could not be created: [_1]", $linkmsg) );
84fb5b46
MKG
1452 }
1453
3ffc5f4f
MKG
1454 my $basetext = $self->FormatLink(Object => $link->BaseObj,
1455 FallBack => $args{Base});
1456 my $targettext = $self->FormatLink(Object => $link->TargetObj,
1457 FallBack => $args{Target});
84fb5b46 1458 my $typetext = $self->FormatType(Type => $args{Type});
3ffc5f4f
MKG
1459 my $TransString = "$basetext $typetext $targettext.";
1460
1461 # No transactions for you!
1462 return ($linkid, $TransString) if $args{'Silent'};
1463
1464 my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target';
84fb5b46 1465
3ffc5f4f
MKG
1466 # Some transactions?
1467 unless ( $args{ 'Silent'. $direction } ) {
1468 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1469 Type => 'AddLink',
1470 Field => $RT::Link::DIRMAP{$args{'Type'}}->{$direction},
1471 NewValue => $remote_uri->URI || $remote_link,
1472 TimeTaken => 0
1473 );
1474 $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
1475 }
84fb5b46 1476
3ffc5f4f
MKG
1477 if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) {
1478 my $OtherObj = $remote_uri->Object;
1479 my ( $val, $msg ) = $OtherObj->_NewTransaction(
1480 Type => 'AddLink',
1481 Field => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction},
1482 NewValue => $self->URI,
1483 TimeTaken => 0,
1484 );
1485 $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
1486 }
1487
1488 return ($linkid, $TransString);
1489}
84fb5b46
MKG
1490
1491=head2 _DeleteLink
1492
3ffc5f4f
MKG
1493Takes a paramhash of Type and one of Base or Target. Removes that link from this object.
1494
1495If Silent is true then no transactions will be recorded. You can individually
1496control transactions on both base and target and with SilentBase and
1497SilentTarget respectively. By default both transactions are created.
1498
1499If the link destination (i.e. not C<$self>) is a local object and the
1500C<$StrictLinkACL> option is enabled, this method checks the appropriate right
1501on the destination object (if any, as returned by the L</ModifyLinkRight>
1502method). B<< The subclass is expected to check the appropriate right on the
1503source object (i.e. C<$self>) before calling this method. >>
1504
1505Returns a tuple of (status flag, message).
84fb5b46
MKG
1506
1507=cut
1508
1509sub _DeleteLink {
1510 my $self = shift;
1511 my %args = (
3ffc5f4f
MKG
1512 Base => undef,
1513 Target => undef,
1514 Type => undef,
1515 Silent => undef,
1516 SilentBase => undef,
1517 SilentTarget => undef,
84fb5b46
MKG
1518 @_
1519 );
1520
3ffc5f4f 1521 # We want one of base and target. We don't care which but we only want _one_.
84fb5b46
MKG
1522 my $direction;
1523 my $remote_link;
1524
1525 if ( $args{'Base'} and $args{'Target'} ) {
1526 $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
01e3b242 1527 return ( 0, $self->loc("Can't specify both base and target") );
84fb5b46
MKG
1528 }
1529 elsif ( $args{'Base'} ) {
1530 $args{'Target'} = $self->URI();
3ffc5f4f
MKG
1531 $remote_link = $args{'Base'};
1532 $direction = 'Target';
84fb5b46
MKG
1533 }
1534 elsif ( $args{'Target'} ) {
1535 $args{'Base'} = $self->URI();
3ffc5f4f
MKG
1536 $remote_link = $args{'Target'};
1537 $direction = 'Base';
84fb5b46
MKG
1538 }
1539 else {
1540 $RT::Logger->error("Base or Target must be specified");
1541 return ( 0, $self->loc('Either base or target must be specified') );
1542 }
1543
3ffc5f4f
MKG
1544 my $remote_uri = RT::URI->new( $self->CurrentUser );
1545 if ($remote_uri->FromURI( $remote_link )) {
1546 # Enforce the remote end of StrictLinkACL
1547 my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef;
1548 if ($remote_obj and $remote_obj->id and RT->Config->Get("StrictLinkACL")) {
1549 my $right = $remote_obj->ModifyLinkRight;
1550
1551 return (0, $self->loc("Permission denied"))
1552 if $right and
1553 not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj );
1554 }
1555 } else {
1556 return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link));
1557 }
84fb5b46 1558
3ffc5f4f
MKG
1559 my $link = RT::Link->new( $self->CurrentUser );
1560 $RT::Logger->debug( "Trying to load link: "
1561 . $args{'Base'} . " "
1562 . $args{'Type'} . " "
1563 . $args{'Target'} );
1564
1565 $link->LoadByParams(
1566 Base => $args{'Base'},
1567 Type => $args{'Type'},
1568 Target => $args{'Target'}
1569 );
84fb5b46 1570
3ffc5f4f
MKG
1571 unless ($link->id) {
1572 $RT::Logger->debug("Couldn't find that link");
1573 return ( 0, $self->loc("Link not found") );
1574 }
84fb5b46 1575
3ffc5f4f 1576 my $basetext = $self->FormatLink(Object => $link->BaseObj,
84fb5b46 1577 FallBack => $args{Base});
3ffc5f4f 1578 my $targettext = $self->FormatLink(Object => $link->TargetObj,
84fb5b46 1579 FallBack => $args{Target});
3ffc5f4f
MKG
1580 my $typetext = $self->FormatType(Type => $args{Type});
1581 my $TransString = "$basetext no longer $typetext $targettext.";
1582
1583 my ($ok, $msg) = $link->Delete();
1584 unless ($ok) {
1585 RT->Logger->error("Link could not be deleted: $msg");
1586 return ( 0, $self->loc("Link could not be deleted: [_1]", $msg) );
84fb5b46
MKG
1587 }
1588
3ffc5f4f
MKG
1589 # No transactions for you!
1590 return (1, $TransString) if $args{'Silent'};
1591
1592 my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target';
1593
1594 # Some transactions?
1595 unless ( $args{ 'Silent'. $direction } ) {
1596 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1597 Type => 'DeleteLink',
1598 Field => $RT::Link::DIRMAP{$args{'Type'}}->{$direction},
1599 OldValue => $remote_uri->URI || $remote_link,
1600 TimeTaken => 0
1601 );
1602 $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
84fb5b46 1603 }
84fb5b46 1604
3ffc5f4f
MKG
1605 if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) {
1606 my $OtherObj = $remote_uri->Object;
1607 my ( $val, $msg ) = $OtherObj->_NewTransaction(
1608 Type => 'DeleteLink',
1609 Field => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction},
1610 OldValue => $self->URI,
1611 TimeTaken => 0,
1612 );
1613 $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
1614 }
1615
1616 return (1, $TransString);
1617}
84fb5b46 1618
dab09ea8
MKG
1619=head1 LockForUpdate
1620
1621In a database transaction, gains an exclusive lock on the row, to
1622prevent race conditions. On SQLite, this is a "RESERVED" lock on the
1623entire database.
84fb5b46 1624
dab09ea8 1625=cut
84fb5b46 1626
dab09ea8
MKG
1627sub LockForUpdate {
1628 my $self = shift;
1629
1630 my $pk = $self->_PrimaryKey;
1631 my $id = @_ ? $_[0] : $self->$pk;
1632 $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
1633 if (RT->Config->Get('DatabaseType') eq "SQLite") {
1634 # SQLite does DB-level locking, upgrading the transaction to
1635 # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
1636 # UPDATE to force the upgade.
1637 return RT->DatabaseHandle->dbh->do(
1638 "UPDATE " .$self->Table.
1639 " SET $pk = $pk WHERE 1 = 0");
1640 } else {
1641 return $self->_LoadFromSQL(
1642 "SELECT * FROM ".$self->Table
1643 ." WHERE $pk = ? FOR UPDATE",
1644 $id,
1645 );
1646 }
1647}
84fb5b46
MKG
1648
1649=head2 _NewTransaction PARAMHASH
1650
1651Private function to create a new RT::Transaction object for this ticket update
1652
1653=cut
1654
1655sub _NewTransaction {
1656 my $self = shift;
1657 my %args = (
1658 TimeTaken => undef,
1659 Type => undef,
1660 OldValue => undef,
1661 NewValue => undef,
1662 OldReference => undef,
1663 NewReference => undef,
1664 ReferenceType => undef,
1665 Data => undef,
1666 Field => undef,
1667 MIMEObj => undef,
1668 ActivateScrips => 1,
1669 CommitScrips => 1,
1670 SquelchMailTo => undef,
1671 @_
1672 );
1673
dab09ea8
MKG
1674 my $in_txn = RT->DatabaseHandle->TransactionDepth;
1675 RT->DatabaseHandle->BeginTransaction unless $in_txn;
1676
1677 $self->LockForUpdate;
1678
84fb5b46
MKG
1679 my $old_ref = $args{'OldReference'};
1680 my $new_ref = $args{'NewReference'};
1681 my $ref_type = $args{'ReferenceType'};
1682 if ($old_ref or $new_ref) {
3ffc5f4f
MKG
1683 $ref_type ||= ref($old_ref) || ref($new_ref);
1684 if (!$ref_type) {
1685 $RT::Logger->error("Reference type not specified for transaction");
1686 return;
1687 }
1688 $old_ref = $old_ref->Id if ref($old_ref);
1689 $new_ref = $new_ref->Id if ref($new_ref);
84fb5b46
MKG
1690 }
1691
1692 require RT::Transaction;
1693 my $trans = RT::Transaction->new( $self->CurrentUser );
1694 my ( $transaction, $msg ) = $trans->Create(
3ffc5f4f
MKG
1695 ObjectId => $self->Id,
1696 ObjectType => ref($self),
84fb5b46
MKG
1697 TimeTaken => $args{'TimeTaken'},
1698 Type => $args{'Type'},
1699 Data => $args{'Data'},
1700 Field => $args{'Field'},
1701 NewValue => $args{'NewValue'},
1702 OldValue => $args{'OldValue'},
1703 NewReference => $new_ref,
1704 OldReference => $old_ref,
1705 ReferenceType => $ref_type,
1706 MIMEObj => $args{'MIMEObj'},
1707 ActivateScrips => $args{'ActivateScrips'},
1708 CommitScrips => $args{'CommitScrips'},
1709 SquelchMailTo => $args{'SquelchMailTo'},
1710 );
1711
1712 # Rationalize the object since we may have done things to it during the caching.
1713 $self->Load($self->Id);
1714
1715 $RT::Logger->warning($msg) unless $transaction;
1716
1717 $self->_SetLastUpdated;
1718
1719 if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
3ffc5f4f 1720 $self->_UpdateTimeTaken( $args{'TimeTaken'}, Transaction => $trans );
84fb5b46
MKG
1721 }
1722 if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
3ffc5f4f 1723 push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
84fb5b46 1724 }
dab09ea8
MKG
1725
1726 RT->DatabaseHandle->Commit unless $in_txn;
1727
84fb5b46
MKG
1728 return ( $transaction, $msg, $trans );
1729}
1730
1731
1732
1733=head2 Transactions
1734
3ffc5f4f 1735Returns an L<RT::Transactions> object of all transactions on this record object
84fb5b46
MKG
1736
1737=cut
1738
1739sub Transactions {
1740 my $self = shift;
1741
84fb5b46 1742 my $transactions = RT::Transactions->new( $self->CurrentUser );
84fb5b46
MKG
1743 $transactions->Limit(
1744 FIELD => 'ObjectId',
1745 VALUE => $self->id,
1746 );
1747 $transactions->Limit(
1748 FIELD => 'ObjectType',
1749 VALUE => ref($self),
1750 );
1751
3ffc5f4f 1752 return $transactions;
84fb5b46
MKG
1753}
1754
3ffc5f4f
MKG
1755=head2 SortedTransactions
1756
1757Returns the result of L</Transactions> ordered per the
1758I<OldestTransactionsFirst> preference/option.
1759
1760=cut
1761
1762sub SortedTransactions {
1763 my $self = shift;
1764 my $txns = $self->Transactions;
1765 my $order = RT->Config->Get("OldestTransactionsFirst", $self->CurrentUser)
1766 ? 'ASC' : 'DESC';
1767 $txns->OrderByCols(
1768 { FIELD => 'Created', ORDER => $order },
1769 { FIELD => 'id', ORDER => $order },
1770 );
1771 return $txns;
1772}
1773
1774our %TRANSACTION_CLASSIFICATION = (
1775 Create => 'message',
1776 Correspond => 'message',
1777 Comment => 'message',
1778
1779 AddWatcher => 'people',
1780 DelWatcher => 'people',
1781
1782 Take => 'people',
1783 Untake => 'people',
1784 Force => 'people',
1785 Steal => 'people',
1786 Give => 'people',
1787
1788 AddLink => 'links',
1789 DeleteLink => 'links',
1790
1791 Status => 'basics',
1792 Set => {
1793 __default => 'basics',
1794 map( { $_ => 'dates' } qw(
1795 Told Starts Started Due LastUpdated Created LastUpdated
1796 ) ),
1797 map( { $_ => 'people' } qw(
1798 Owner Creator LastUpdatedBy
1799 ) ),
1800 },
1801 SystemError => 'error',
1802 AttachmentTruncate => 'attachment-truncate',
1803 AttachmentDrop => 'attachment-drop',
1804 __default => 'other',
1805);
1806
1807sub ClassifyTransaction {
1808 my $self = shift;
1809 my $txn = shift;
1810
1811 my $type = $txn->Type;
1812
1813 my $res = $TRANSACTION_CLASSIFICATION{ $type };
1814 return $res || $TRANSACTION_CLASSIFICATION{ '__default' }
1815 unless ref $res;
1816
1817 return $res->{ $txn->Field } || $res->{'__default'}
1818 || $TRANSACTION_CLASSIFICATION{ '__default' };
1819}
1820
1821=head2 Attachments
1822
1823Returns an L<RT::Attachments> object of all attachments on this record object
1824(for all its L</Transactions>).
1825
1826By default Content and Headers of attachments are not fetched right away from
1827database. Use C<WithContent> and C<WithHeaders> options to override this.
1828
1829=cut
1830
1831sub Attachments {
1832 my $self = shift;
1833 my %args = (
1834 WithHeaders => 0,
1835 WithContent => 0,
1836 @_
1837 );
1838 my @columns = grep { not /^(Headers|Content)$/ }
1839 RT::Attachment->ReadableAttributes;
1840 push @columns, 'Headers' if $args{'WithHeaders'};
1841 push @columns, 'Content' if $args{'WithContent'};
1842
1843 my $res = RT::Attachments->new( $self->CurrentUser );
1844 $res->Columns( @columns );
1845 my $txn_alias = $res->TransactionAlias;
1846 $res->Limit(
1847 ALIAS => $txn_alias,
1848 FIELD => 'ObjectType',
1849 VALUE => ref($self),
1850 );
1851 $res->Limit(
1852 ALIAS => $txn_alias,
1853 FIELD => 'ObjectId',
1854 VALUE => $self->id,
1855 );
1856 return $res;
1857}
1858
1859=head2 TextAttachments
1860
1861Returns an L<RT::Attachments> object of all attachments, like L<Attachments>,
1862but only those that are text.
1863
1864By default Content and Headers are fetched. Use C<WithContent> and
1865C<WithHeaders> options to override this.
1866
1867=cut
1868
1869sub TextAttachments {
1870 my $self = shift;
1871 my $res = $self->Attachments(
1872 WithHeaders => 1,
1873 WithContent => 1,
1874 @_
1875 );
1876 $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text/plain');
1877 $res->Limit( FIELD => 'ContentType', OPERATOR => 'STARTSWITH', VALUE => 'message/');
1878 $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text');
1879 $res->Limit( FIELD => 'Filename', OPERATOR => 'IS', VALUE => 'NULL')
1880 if RT->Config->Get( 'SuppressInlineTextFiles', $self->CurrentUser );
1881 return $res;
1882}
84fb5b46
MKG
1883
1884sub CustomFields {
1885 my $self = shift;
1886 my $cfs = RT::CustomFields->new( $self->CurrentUser );
1887
1888 $cfs->SetContextObject( $self );
1889 # XXX handle multiple types properly
1890 $cfs->LimitToLookupType( $self->CustomFieldLookupType );
403d7b0b 1891 $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId );
84fb5b46
MKG
1892 $cfs->ApplySortOrder;
1893
1894 return $cfs;
1895}
1896
403d7b0b
MKG
1897# TODO: This _only_ works for RT::Foo classes. it doesn't work, for
1898# example, for RT::IR::Foo classes.
84fb5b46 1899
403d7b0b 1900sub CustomFieldLookupId {
84fb5b46 1901 my $self = shift;
403d7b0b 1902 my $lookup = shift || $self->CustomFieldLookupType;
84fb5b46
MKG
1903 my @classes = ($lookup =~ /RT::(\w+)-/g);
1904
403d7b0b
MKG
1905 # Work on "RT::Queue", for instance
1906 return $self->Id unless @classes;
1907
84fb5b46 1908 my $object = $self;
403d7b0b
MKG
1909 # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
1910 my $final = shift @classes;
84fb5b46 1911 foreach my $class (reverse @classes) {
3ffc5f4f
MKG
1912 my $method = "${class}Obj";
1913 $object = $object->$method;
84fb5b46
MKG
1914 }
1915
403d7b0b
MKG
1916 my $id = $object->$final;
1917 unless (defined $id) {
1918 my $method = "${final}Obj";
1919 $id = $object->$method->Id;
1920 }
1921 return $id;
84fb5b46
MKG
1922}
1923
1924
1925=head2 CustomFieldLookupType
1926
1927Returns the path RT uses to figure out which custom fields apply to this object.
1928
1929=cut
1930
1931sub CustomFieldLookupType {
1932 my $self = shift;
01e3b242 1933 return ref($self) || $self;
84fb5b46
MKG
1934}
1935
1936
1937=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1938
1939VALUE should be a string. FIELD can be any identifier of a CustomField
1940supported by L</LoadCustomFieldByIdentifier> method.
1941
1942Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1943deletes the old value.
1944If VALUE is not a valid value for the custom field, returns
1945(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1946$id is ID of created L<ObjectCustomFieldValue> object.
1947
1948=cut
1949
1950sub AddCustomFieldValue {
1951 my $self = shift;
1952 $self->_AddCustomFieldValue(@_);
1953}
1954
1955sub _AddCustomFieldValue {
1956 my $self = shift;
1957 my %args = (
1958 Field => undef,
1959 Value => undef,
1960 LargeContent => undef,
1961 ContentType => undef,
1962 RecordTransaction => 1,
1963 @_
1964 );
1965
1966 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1967 unless ( $cf->Id ) {
1968 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1969 }
1970
1971 my $OCFs = $self->CustomFields;
1972 $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1973 unless ( $OCFs->Count ) {
1974 return (
1975 0,
1976 $self->loc(
1977 "Custom field [_1] does not apply to this object",
dab09ea8 1978 ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
84fb5b46
MKG
1979 )
1980 );
1981 }
1982
1983 # empty string is not correct value of any CF, so undef it
1984 foreach ( qw(Value LargeContent) ) {
1985 $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1986 }
1987
1988 unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1989 return ( 0, $self->loc("Invalid value for custom field") );
1990 }
1991
1992 # If the custom field only accepts a certain # of values, delete the existing
1993 # value and record a "changed from foo to bar" transaction
1994 unless ( $cf->UnlimitedValues ) {
1995
1996 # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1997 my $values = $cf->ValuesForObject($self);
1998
1999 # We need to whack any old values here. In most cases, the custom field should
2000 # only have one value to delete. In the pathalogical case, this custom field
2001 # used to be a multiple and we have many values to whack....
2002 my $cf_values = $values->Count;
2003
2004 if ( $cf_values > $cf->MaxValues ) {
2005 my $i = 0; #We want to delete all but the max we can currently have , so we can then
2006 # execute the same code to "change" the value from old to new
2007 while ( my $value = $values->Next ) {
2008 $i++;
2009 if ( $i < $cf_values ) {
2010 my ( $val, $msg ) = $cf->DeleteValueForObject(
3ffc5f4f
MKG
2011 Object => $self,
2012 Id => $value->id,
84fb5b46
MKG
2013 );
2014 unless ($val) {
2015 return ( 0, $msg );
2016 }
2017 my ( $TransactionId, $Msg, $TransactionObj ) =
2018 $self->_NewTransaction(
2019 Type => 'CustomField',
2020 Field => $cf->Id,
2021 OldReference => $value,
2022 );
2023 }
2024 }
2025 $values->RedoSearch if $i; # redo search if have deleted at least one value
2026 }
2027
3ffc5f4f
MKG
2028 if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
2029 return $entry->id;
84fb5b46
MKG
2030 }
2031
3ffc5f4f
MKG
2032 my $old_value = $values->First;
2033 my $old_content;
2034 $old_content = $old_value->Content if $old_value;
2035
84fb5b46
MKG
2036 my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
2037 Object => $self,
2038 Content => $args{'Value'},
2039 LargeContent => $args{'LargeContent'},
2040 ContentType => $args{'ContentType'},
2041 );
2042
2043 unless ( $new_value_id ) {
2044 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
2045 }
2046
2047 my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
2048 $new_value->Load( $new_value_id );
2049
2050 # now that adding the new value was successful, delete the old one
2051 if ( $old_value ) {
2052 my ( $val, $msg ) = $old_value->Delete();
2053 return ( 0, $msg ) unless $val;
2054 }
2055
2056 if ( $args{'RecordTransaction'} ) {
2057 my ( $TransactionId, $Msg, $TransactionObj ) =
2058 $self->_NewTransaction(
2059 Type => 'CustomField',
2060 Field => $cf->Id,
2061 OldReference => $old_value,
2062 NewReference => $new_value,
2063 );
2064 }
2065
2066 my $new_content = $new_value->Content;
2067
2068 # For datetime, we need to display them in "human" format in result message
2069 #XXX TODO how about date without time?
2070 if ($cf->Type eq 'DateTime') {
2071 my $DateObj = RT::Date->new( $self->CurrentUser );
2072 $DateObj->Set(
2073 Format => 'ISO',
2074 Value => $new_content,
2075 );
2076 $new_content = $DateObj->AsString;
2077
2078 if ( defined $old_content && length $old_content ) {
2079 $DateObj->Set(
2080 Format => 'ISO',
2081 Value => $old_content,
2082 );
2083 $old_content = $DateObj->AsString;
2084 }
2085 }
2086
2087 unless ( defined $old_content && length $old_content ) {
2088 return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
2089 }
2090 elsif ( !defined $new_content || !length $new_content ) {
2091 return ( $new_value_id,
2092 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
2093 }
2094 else {
2095 return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
2096 }
2097
2098 }
2099
2100 # otherwise, just add a new value and record "new value added"
2101 else {
3ffc5f4f
MKG
2102 my $values = $cf->ValuesForObject($self);
2103 if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
2104 return $entry->id;
2105 }
2106
84fb5b46
MKG
2107 my ($new_value_id, $msg) = $cf->AddValueForObject(
2108 Object => $self,
2109 Content => $args{'Value'},
2110 LargeContent => $args{'LargeContent'},
2111 ContentType => $args{'ContentType'},
2112 );
2113
2114 unless ( $new_value_id ) {
2115 return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
2116 }
2117 if ( $args{'RecordTransaction'} ) {
2118 my ( $tid, $msg ) = $self->_NewTransaction(
2119 Type => 'CustomField',
2120 Field => $cf->Id,
2121 NewReference => $new_value_id,
2122 ReferenceType => 'RT::ObjectCustomFieldValue',
2123 );
2124 unless ( $tid ) {
2125 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
2126 }
2127 }
2128 return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
2129 }
2130}
2131
2132
2133
2134=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
2135
2136Deletes VALUE as a value of CustomField FIELD.
2137
2138VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
2139
2140If VALUE is not a valid value for the custom field, returns
2141(0, 'Error message' ) otherwise, returns (1, 'Success Message')
2142
2143=cut
2144
2145sub DeleteCustomFieldValue {
2146 my $self = shift;
2147 my %args = (
2148 Field => undef,
2149 Value => undef,
2150 ValueId => undef,
2151 @_
2152 );
2153
2154 my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
2155 unless ( $cf->Id ) {
2156 return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
2157 }
2158
2159 my ( $val, $msg ) = $cf->DeleteValueForObject(
2160 Object => $self,
2161 Id => $args{'ValueId'},
2162 Content => $args{'Value'},
2163 );
2164 unless ($val) {
2165 return ( 0, $msg );
2166 }
2167
2168 my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
2169 Type => 'CustomField',
2170 Field => $cf->Id,
2171 OldReference => $val,
2172 ReferenceType => 'RT::ObjectCustomFieldValue',
2173 );
2174 unless ($TransactionId) {
2175 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
2176 }
2177
2178 my $old_value = $TransactionObj->OldValue;
2179 # For datetime, we need to display them in "human" format in result message
2180 if ( $cf->Type eq 'DateTime' ) {
2181 my $DateObj = RT::Date->new( $self->CurrentUser );
2182 $DateObj->Set(
2183 Format => 'ISO',
2184 Value => $old_value,
2185 );
2186 $old_value = $DateObj->AsString;
2187 }
2188 return (
2189 $TransactionId,
2190 $self->loc(
2191 "[_1] is no longer a value for custom field [_2]",
2192 $old_value, $cf->Name
2193 )
2194 );
2195}
2196
2197
2198
2199=head2 FirstCustomFieldValue FIELD
2200
2201Return the content of the first value of CustomField FIELD for this ticket
2202Takes a field id or name
2203
2204=cut
2205
2206sub FirstCustomFieldValue {
2207 my $self = shift;
2208 my $field = shift;
2209
2210 my $values = $self->CustomFieldValues( $field );
2211 return undef unless my $first = $values->First;
2212 return $first->Content;
2213}
2214
2215=head2 CustomFieldValuesAsString FIELD
2216
2217Return the content of the CustomField FIELD for this ticket.
2218If this is a multi-value custom field, values will be joined with newlines.
2219
2220Takes a field id or name as the first argument
2221
2222Takes an optional Separator => "," second and third argument
2223if you want to join the values using something other than a newline
2224
2225=cut
2226
2227sub CustomFieldValuesAsString {
2228 my $self = shift;
2229 my $field = shift;
2230 my %args = @_;
2231 my $separator = $args{Separator} || "\n";
2232
2233 my $values = $self->CustomFieldValues( $field );
2234 return join ($separator, grep { defined $_ }
2235 map { $_->Content } @{$values->ItemsArrayRef});
2236}
2237
2238
2239
2240=head2 CustomFieldValues FIELD
2241
2242Return a ObjectCustomFieldValues object of all values of the CustomField whose
2243id or Name is FIELD for this record.
2244
2245Returns an RT::ObjectCustomFieldValues object
2246
2247=cut
2248
2249sub CustomFieldValues {
2250 my $self = shift;
2251 my $field = shift;
2252
2253 if ( $field ) {
2254 my $cf = $self->LoadCustomFieldByIdentifier( $field );
2255
2256 # we were asked to search on a custom field we couldn't find
2257 unless ( $cf->id ) {
2258 $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
2259 return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
2260 }
2261 return ( $cf->ValuesForObject($self) );
2262 }
2263
2264 # we're not limiting to a specific custom field;
2265 my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
2266 $ocfs->LimitToObject( $self );
2267 return $ocfs;
2268}
2269
2270=head2 LoadCustomFieldByIdentifier IDENTIFER
2271
2272Find the custom field has id or name IDENTIFIER for this object.
2273
2274If no valid field is found, returns an empty RT::CustomField object.
2275
2276=cut
2277
2278sub LoadCustomFieldByIdentifier {
2279 my $self = shift;
2280 my $field = shift;
2281
2282 my $cf;
2283 if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
2284 $cf = RT::CustomField->new($self->CurrentUser);
2285 $cf->SetContextObject( $self );
2286 $cf->LoadById( $field->id );
2287 }
2288 elsif ($field =~ /^\d+$/) {
2289 $cf = RT::CustomField->new($self->CurrentUser);
2290 $cf->SetContextObject( $self );
2291 $cf->LoadById($field);
2292 } else {
2293
2294 my $cfs = $self->CustomFields($self->CurrentUser);
2295 $cfs->SetContextObject( $self );
2296 $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
2297 $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
2298 }
2299 return $cf;
2300}
2301
2302sub ACLEquivalenceObjects { }
2303
3ffc5f4f
MKG
2304=head2 HasRight
2305
2306 Takes a paramhash with the attributes 'Right' and 'Principal'
2307 'Right' is a ticket-scoped textual right from RT::ACE
2308 'Principal' is an RT::User object
2309
2310 Returns 1 if the principal has the right. Returns undef if not.
2311
2312=cut
2313
2314sub HasRight {
2315 my $self = shift;
2316 my %args = (
2317 Right => undef,
2318 Principal => undef,
2319 @_
2320 );
2321
2322 $args{Principal} ||= $self->CurrentUser->PrincipalObj;
2323
2324 return $args{'Principal'}->HasRight(
2325 Object => $self->Id ? $self : $RT::System,
2326 Right => $args{'Right'}
2327 );
2328}
2329
2330sub CurrentUserHasRight {
2331 my $self = shift;
2332 return $self->HasRight( Right => @_ );
2333}
2334
2335sub ModifyLinkRight { }
2336
2337=head2 ColumnMapClassName
2338
2339ColumnMap needs a massaged collection class name to load the correct list
2340display. Equivalent to L<RT::SearchBuilder/ColumnMapClassName>, but provided
2341for a record instead of a collection.
2342
2343Returns a string. May be called as a package method.
2344
2345=cut
2346
2347sub ColumnMapClassName {
2348 my $self = shift;
2349 my $Class = ref($self) || $self;
2350 $Class =~ s/:/_/g;
2351 return $Class;
2352}
2353
84fb5b46
MKG
2354sub BasicColumns { }
2355
2356sub WikiBase {
2357 return RT->Config->Get('WebPath'). "/index.html?q=";
2358}
2359
3ffc5f4f
MKG
2360sub UID {
2361 my $self = shift;
2362 return undef unless defined $self->Id;
2363 return "@{[ref $self]}-$RT::Organization-@{[$self->Id]}";
2364}
2365
2366sub FindDependencies {
2367 my $self = shift;
2368 my ($walker, $deps) = @_;
2369 for my $col (qw/Creator LastUpdatedBy/) {
2370 if ( $self->_Accessible( $col, 'read' ) ) {
2371 next unless $self->$col;
2372 my $obj = RT::Principal->new( $self->CurrentUser );
2373 $obj->Load( $self->$col );
2374 $deps->Add( out => $obj->Object );
2375 }
2376 }
2377
2378 # Object attributes, we have to check on every object
2379 my $objs = $self->Attributes;
2380 $deps->Add( in => $objs );
2381
2382 # Transactions
2383 if ( $self->isa("RT::Ticket")
2384 or $self->isa("RT::User")
2385 or $self->isa("RT::Group")
2386 or $self->isa("RT::Article")
2387 or $self->isa("RT::Queue") )
2388 {
2389 $objs = RT::Transactions->new( $self->CurrentUser );
2390 $objs->Limit( FIELD => 'ObjectType', VALUE => ref $self );
2391 $objs->Limit( FIELD => 'ObjectId', VALUE => $self->id );
2392 $deps->Add( in => $objs );
2393 }
2394
2395 # Object custom field values
2396 if (( $self->isa("RT::Transaction")
2397 or $self->isa("RT::Ticket")
2398 or $self->isa("RT::User")
2399 or $self->isa("RT::Group")
2400 or $self->isa("RT::Queue")
2401 or $self->isa("RT::Article") )
2402 and $self->can("CustomFieldValues") )
2403 {
2404 $objs = $self->CustomFieldValues; # Actually OCFVs
2405 $objs->{find_expired_rows} = 1;
2406 $deps->Add( in => $objs );
2407 }
2408
2409 # ACE records
2410 if ( $self->isa("RT::Group")
2411 or $self->isa("RT::Class")
2412 or $self->isa("RT::Queue")
2413 or $self->isa("RT::CustomField") )
2414 {
2415 $objs = RT::ACL->new( $self->CurrentUser );
2416 $objs->LimitToObject( $self );
2417 $deps->Add( in => $objs );
2418 }
2419}
2420
2421sub Serialize {
2422 my $self = shift;
2423 my %args = (
2424 Methods => {},
2425 UIDs => 1,
2426 @_,
2427 );
2428 my %methods = (
2429 Creator => "CreatorObj",
2430 LastUpdatedBy => "LastUpdatedByObj",
2431 %{ $args{Methods} || {} },
2432 );
2433
2434 my %values = %{$self->{values}};
2435
2436 my %ca = %{ $self->_ClassAccessible };
2437 my @cols = grep {exists $values{lc $_} and defined $values{lc $_}} keys %ca;
2438
2439 my %store;
2440 $store{$_} = $values{lc $_} for @cols;
2441 $store{id} = $values{id}; # Explicitly necessary in some cases
2442
2443 # Un-apply the _transfer_ encoding, but don't mess with the octets
2444 # themselves. Calling ->Content directly would, in some cases,
2445 # decode from some mostly-unknown character set -- which reversing
2446 # on the far end would be complicated.
2447 if ($ca{ContentEncoding} and $ca{ContentType}) {
2448 my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/;
2449 $store{$content_col} = $self->_DecodeLOB(
2450 "application/octet-stream", # Lie so that we get bytes, not characters
2451 $self->ContentEncoding,
2452 $self->_Value( $content_col, decode_utf8 => 0 )
2453 );
2454 delete $store{ContentEncoding};
2455 }
2456 return %store unless $args{UIDs};
2457
2458 # Use FooObj to turn Foo into a reference to the UID
2459 for my $col ( grep {$store{$_}} @cols ) {
2460 my $method = $methods{$col};
2461 if (not $method) {
2462 $method = $col;
2463 $method =~ s/(Id)?$/Obj/;
2464 }
2465 next unless $self->can($method);
2466
2467 my $obj = $self->$method;
2468 next unless $obj and $obj->isa("RT::Record");
2469 $store{$col} = \($obj->UID);
2470 }
2471
2472 # Anything on an object should get the UID stored instead
2473 if ($store{ObjectType} and $store{ObjectId} and $self->can("Object")) {
2474 delete $store{$_} for qw/ObjectType ObjectId/;
2475 $store{Object} = \($self->Object->UID);
2476 }
2477
2478 return %store;
2479}
2480
2481sub PreInflate {
2482 my $class = shift;
2483 my ($importer, $uid, $data) = @_;
2484
2485 my $ca = $class->_ClassAccessible;
2486 my %ca = %{ $ca };
2487
2488 if ($ca{ContentEncoding} and $ca{ContentType}) {
2489 my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/;
2490 if (defined $data->{$content_col}) {
2491 my ($ContentEncoding, $Content) = $class->_EncodeLOB(
2492 $data->{$content_col}, $data->{ContentType},
2493 );
2494 $data->{ContentEncoding} = $ContentEncoding;
2495 $data->{$content_col} = $Content;
2496 }
2497 }
2498
2499 if ($data->{Object} and not $ca{Object}) {
2500 my $ref_uid = ${ delete $data->{Object} };
2501 my $ref = $importer->Lookup( $ref_uid );
2502 if ($ref) {
2503 my ($class, $id) = @{$ref};
2504 $data->{ObjectId} = $id;
2505 $data->{ObjectType} = $class;
2506 } else {
2507 $data->{ObjectId} = 0;
2508 $data->{ObjectType} = "";
2509 $importer->Postpone(
2510 for => $ref_uid,
2511 uid => $uid,
2512 column => "ObjectId",
2513 classcolumn => "ObjectType",
2514 );
2515 }
2516 }
2517
2518 for my $col (keys %{$data}) {
2519 if (ref $data->{$col}) {
2520 my $ref_uid = ${ $data->{$col} };
2521 my $ref = $importer->Lookup( $ref_uid );
2522 if ($ref) {
2523 my (undef, $id) = @{$ref};
2524 $data->{$col} = $id;
2525 } else {
2526 $data->{$col} = 0;
2527 $importer->Postpone(
2528 for => $ref_uid,
2529 uid => $uid,
2530 column => $col,
2531 );
2532 }
2533 }
2534 }
2535
2536 return 1;
2537}
2538
2539sub PostInflate {
2540}
2541
84fb5b46
MKG
2542RT::Base->_ImportOverlays();
2543
25441;