TimeWorked-like custom fields, RT#11168
[freeside.git] / rt / lib / RT / CustomField_Overlay.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
6 #                                          <sales@bestpractical.com>
7 #
8 # (Except where explicitly superseded by other copyright notices)
9 #
10 #
11 # LICENSE:
12 #
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
16 # from www.gnu.org.
17 #
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28 #
29 #
30 # CONTRIBUTION SUBMISSION POLICY:
31 #
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
37 #
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
46 #
47 # END BPS TAGGED BLOCK }}}
48
49 package RT::CustomField;
50
51 use strict;
52 no warnings qw(redefine);
53
54 use RT::CustomFieldValues;
55 use RT::ObjectCustomFields;
56 use RT::ObjectCustomFieldValues;
57
58
59 our %FieldTypes = (
60     Select => [
61         'Select multiple values',    # loc
62         'Select one value',        # loc
63         'Select up to [_1] values',    # loc
64     ],
65     Freeform => [
66         'Enter multiple values',    # loc
67         'Enter one value',        # loc
68         'Enter up to [_1] values',    # loc
69     ],
70     Text => [
71         'Fill in multiple text areas',    # loc
72         'Fill in one text area',    # loc
73         'Fill in up to [_1] text areas',# loc
74     ],
75     Wikitext => [
76         'Fill in multiple wikitext areas',    # loc
77         'Fill in one wikitext area',    # loc
78         'Fill in up to [_1] wikitext areas',# loc
79     ],
80     Image => [
81         'Upload multiple images',    # loc
82         'Upload one image',        # loc
83         'Upload up to [_1] images',    # loc
84     ],
85     Binary => [
86         'Upload multiple files',    # loc
87         'Upload one file',        # loc
88         'Upload up to [_1] files',    # loc
89     ],
90     Combobox => [
91         'Combobox: Select or enter multiple values',    # loc
92         'Combobox: Select or enter one value',        # loc
93         'Combobox: Select or enter up to [_1] values',    # loc
94     ],
95     Autocomplete => [
96         'Enter multiple values with autocompletion',    # loc
97         'Enter one value with autocompletion',            # loc
98         'Enter up to [_1] values with autocompletion',    # loc
99     ],
100     Date => [
101         'Select multiple dates',        # loc
102         'Select date',                  # loc
103         'Select up to [_1] dates',      # loc
104     ],
105     TimeValue => [
106         'Enter multiple time values (UNSUPPORTED)',
107         'Enter a time value',
108         'Enter [_1] time values (UNSUPPORTED)',
109     ],
110 );
111
112
113 our %FRIENDLY_OBJECT_TYPES =  ();
114
115 RT::CustomField->_ForObjectType( 'RT::Queue-RT::Ticket' => "Tickets", );    #loc
116 RT::CustomField->_ForObjectType(
117     'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", );    #loc
118 RT::CustomField->_ForObjectType( 'RT::User'  => "Users", );                           #loc
119 RT::CustomField->_ForObjectType( 'RT::Queue'  => "Queues", );                         #loc
120 RT::CustomField->_ForObjectType( 'RT::Group' => "Groups", );                          #loc
121
122 our $RIGHTS = {
123     SeeCustomField            => 'See custom fields',       # loc_pair
124     AdminCustomField          => 'Create, delete and modify custom fields',        # loc_pair
125     AdminCustomFieldValues    => 'Create, delete and modify custom fields values',        # loc_pair
126     ModifyCustomField         => 'Add, delete and modify custom field values for objects' #loc_pair
127 };
128
129 # Tell RT::ACE that this sort of object can get acls granted
130 $RT::ACE::OBJECT_TYPES{'RT::CustomField'} = 1;
131
132 foreach my $right ( keys %{$RIGHTS} ) {
133     $RT::ACE::LOWERCASERIGHTNAMES{ lc $right } = $right;
134 }
135
136 =head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...]
137
138 Adds the given rights to the list of possible rights.  This method
139 should be called during server startup, not at runtime.
140
141 =cut
142
143 sub AddRights {
144     my $self = shift;
145     my %new = @_;
146     $RIGHTS = { %$RIGHTS, %new };
147     %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES,
148                                       map { lc($_) => $_ } keys %new);
149 }
150
151 sub AvailableRights {
152     my $self = shift;
153     return $RIGHTS;
154 }
155
156 =head1 NAME
157
158   RT::CustomField_Overlay - overlay for RT::CustomField
159
160 =head1 DESCRIPTION
161
162 =head1 'CORE' METHODS
163
164 =head2 Create PARAMHASH
165
166 Create takes a hash of values and creates a row in the database:
167
168   varchar(200) 'Name'.
169   varchar(200) 'Type'.
170   int(11) 'MaxValues'.
171   varchar(255) 'Pattern'.
172   smallint(6) 'Repeated'.
173   varchar(255) 'Description'.
174   int(11) 'SortOrder'.
175   varchar(255) 'LookupType'.
176   smallint(6) 'Disabled'.
177
178 C<LookupType> is generally the result of either
179 C<RT::Ticket->CustomFieldLookupType> or C<RT::Transaction->CustomFieldLookupType>.
180
181 =cut
182
183 sub Create {
184     my $self = shift;
185     my %args = (
186         Name        => '',
187         Type        => '',
188         MaxValues   => 0,
189         Pattern     => '',
190         Description => '',
191         Disabled    => 0,
192         LookupType  => '',
193         Repeated    => 0,
194         LinkValueTo => '',
195         IncludeContentForValue => '',
196         @_,
197     );
198
199     unless ( $self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField') ) {
200         return (0, $self->loc('Permission Denied'));
201     }
202
203     if ( $args{TypeComposite} ) {
204         @args{'Type', 'MaxValues'} = split(/-/, $args{TypeComposite}, 2);
205     }
206     elsif ( $args{Type} =~ s/(?:(Single)|Multiple)$// ) {
207         # old style Type string
208         $args{'MaxValues'} = $1 ? 1 : 0;
209     }
210     $args{'MaxValues'} = int $args{'MaxValues'};
211
212     if ( !exists $args{'Queue'}) {
213     # do nothing -- things below are strictly backward compat
214     }
215     elsif (  ! $args{'Queue'} ) {
216         unless ( $self->CurrentUser->HasRight( Object => $RT::System, Right => 'AssignCustomFields') ) {
217             return ( 0, $self->loc('Permission Denied') );
218         }
219         $args{'LookupType'} = 'RT::Queue-RT::Ticket';
220     }
221     else {
222         my $queue = RT::Queue->new($self->CurrentUser);
223         $queue->Load($args{'Queue'});
224         unless ($queue->Id) {
225             return (0, $self->loc("Queue not found"));
226         }
227         unless ( $queue->CurrentUserHasRight('AssignCustomFields') ) {
228             return ( 0, $self->loc('Permission Denied') );
229         }
230         $args{'LookupType'} = 'RT::Queue-RT::Ticket';
231         $args{'Queue'} = $queue->Id;
232     }
233
234     my ($ok, $msg) = $self->_IsValidRegex( $args{'Pattern'} );
235     return (0, $self->loc("Invalid pattern: [_1]", $msg)) unless $ok;
236
237     if ( $args{'MaxValues'} != 1 && $args{'Type'} =~ /(text|combobox)$/i ) {
238         $RT::Logger->warning("Support for 'multiple' Texts or Comboboxes is not implemented");
239         $args{'MaxValues'} = 1;
240     }
241
242     (my $rv, $msg) = $self->SUPER::Create(
243         Name        => $args{'Name'},
244         Type        => $args{'Type'},
245         MaxValues   => $args{'MaxValues'},
246         Pattern     => $args{'Pattern'},
247         Description => $args{'Description'},
248         Disabled    => $args{'Disabled'},
249         LookupType  => $args{'LookupType'},
250         Repeated    => $args{'Repeated'},
251     );
252
253     if ( exists $args{'LinkValueTo'}) {
254         $self->SetLinkValueTo($args{'LinkValueTo'});
255     }
256
257     if ( exists $args{'IncludeContentForValue'}) {
258         $self->SetIncludeContentForValue($args{'IncludeContentForValue'});
259     }
260
261     if ( exists $args{'ValuesClass'} ) {
262         $self->SetValuesClass( $args{'ValuesClass'} );
263     }
264
265     if ( exists $args{'BasedOn'} ) {
266         $self->SetBasedOn( $args{'BasedOn'} );
267     }
268
269     if ( exists $args{'UILocation'} ) {
270         $self->SetUILocation( $args{'UILocation'} );
271     }
272
273     return ($rv, $msg) unless exists $args{'Queue'};
274
275     # Compat code -- create a new ObjectCustomField mapping
276     my $OCF = RT::ObjectCustomField->new( $self->CurrentUser );
277     $OCF->Create(
278         CustomField => $self->Id,
279         ObjectId => $args{'Queue'},
280     );
281
282     return ($rv, $msg);
283 }
284
285 =head2 Load ID/NAME
286
287 Load a custom field.  If the value handed in is an integer, load by custom field ID. Otherwise, Load by name.
288
289 =cut
290
291 sub Load {
292     my $self = shift;
293     my $id = shift || '';
294
295     if ( $id =~ /^\d+$/ ) {
296         return $self->SUPER::Load( $id );
297     } else {
298         return $self->LoadByName( Name => $id );
299     }
300 }
301
302
303 # {{{ sub LoadByName
304
305 =head2 LoadByName (Queue => QUEUEID, Name => NAME)
306
307 Loads the Custom field named NAME.
308
309 Will load a Disabled Custom Field even if there is a non-disabled Custom Field
310 with the same Name.
311
312 If a Queue parameter is specified, only look for ticket custom fields tied to that Queue.
313
314 If the Queue parameter is '0', look for global ticket custom fields.
315
316 If no queue parameter is specified, look for any and all custom fields with this name.
317
318 BUG/TODO, this won't let you specify that you only want user or group CFs.
319
320 =cut
321
322 # Compatibility for API change after 3.0 beta 1
323 *LoadNameAndQueue = \&LoadByName;
324 # Change after 3.4 beta.
325 *LoadByNameAndQueue = \&LoadByName;
326
327 sub LoadByName {
328     my $self = shift;
329     my %args = (
330         Queue => undef,
331         Name  => undef,
332         @_,
333     );
334
335     unless ( defined $args{'Name'} && length $args{'Name'} ) {
336         $RT::Logger->error("Couldn't load Custom Field without Name");
337         return wantarray ? (0, $self->loc("No name provided")) : 0;
338     }
339
340     # if we're looking for a queue by name, make it a number
341     if ( defined $args{'Queue'} && $args{'Queue'} =~ /\D/ ) {
342         my $QueueObj = RT::Queue->new( $self->CurrentUser );
343         $QueueObj->Load( $args{'Queue'} );
344         $args{'Queue'} = $QueueObj->Id;
345     }
346
347     # XXX - really naive implementation.  Slow. - not really. still just one query
348
349     my $CFs = RT::CustomFields->new( $self->CurrentUser );
350     $CFs->SetContextObject( $self->ContextObject );
351     my $field = $args{'Name'} =~ /\D/? 'Name' : 'id';
352     $CFs->Limit( FIELD => $field, VALUE => $args{'Name'}, CASESENSITIVE => 0);
353     # Don't limit to queue if queue is 0.  Trying to do so breaks
354     # RT::Group type CFs.
355     if ( defined $args{'Queue'} ) {
356         $CFs->LimitToQueue( $args{'Queue'} );
357     }
358
359     # When loading by name, we _can_ load disabled fields, but prefer
360     # non-disabled fields.
361     $CFs->FindAllRows;
362     $CFs->OrderByCols(
363         { FIELD => "Disabled", ORDER => 'ASC' },
364     );
365
366     # We only want one entry.
367     $CFs->RowsPerPage(1);
368
369     # version before 3.8 just returns 0, so we need to test if wantarray to be
370     # backward compatible.
371     return wantarray ? (0, $self->loc("Not found")) : 0 unless my $first = $CFs->First;
372
373     return $self->LoadById( $first->id );
374 }
375
376 # }}}
377
378 # {{{ Dealing with custom field values 
379
380
381 =head2 Custom field values
382
383 =head3 Values FIELD
384
385 Return a object (collection) of all acceptable values for this Custom Field.
386 Class of the object can vary and depends on the return value
387 of the C<ValuesClass> method.
388
389 =cut
390
391 *ValuesObj = \&Values;
392
393 sub Values {
394     my $self = shift;
395
396     my $class = $self->ValuesClass || 'RT::CustomFieldValues';
397     eval "require $class" or die "$@";
398     my $cf_values = $class->new( $self->CurrentUser );
399     # if the user has no rights, return an empty object
400     if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
401         $cf_values->LimitToCustomField( $self->Id );
402     }
403     return ($cf_values);
404 }
405
406 # {{{ AddValue
407
408 =head3 AddValue HASH
409
410 Create a new value for this CustomField.  Takes a paramhash containing the elements Name, Description and SortOrder
411
412 =cut
413
414 sub AddValue {
415     my $self = shift;
416     my %args = @_;
417
418     unless ($self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues')) {
419         return (0, $self->loc('Permission Denied'));
420     }
421
422     # allow zero value
423     if ( !defined $args{'Name'} || $args{'Name'} eq '' ) {
424         return (0, $self->loc("Can't add a custom field value without a name"));
425     }
426
427     my $newval = RT::CustomFieldValue->new( $self->CurrentUser );
428     return $newval->Create( %args, CustomField => $self->Id );
429 }
430
431
432 # }}}
433
434 # {{{ DeleteValue
435
436 =head3 DeleteValue ID
437
438 Deletes a value from this custom field by id.
439
440 Does not remove this value for any article which has had it selected
441
442 =cut
443
444 sub DeleteValue {
445     my $self = shift;
446     my $id = shift;
447     unless ( $self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues') ) {
448         return (0, $self->loc('Permission Denied'));
449     }
450
451     my $val_to_del = RT::CustomFieldValue->new( $self->CurrentUser );
452     $val_to_del->Load( $id );
453     unless ( $val_to_del->Id ) {
454         return (0, $self->loc("Couldn't find that value"));
455     }
456     unless ( $val_to_del->CustomField == $self->Id ) {
457         return (0, $self->loc("That is not a value for this custom field"));
458     }
459
460     my $retval = $val_to_del->Delete;
461     unless ( $retval ) {
462         return (0, $self->loc("Custom field value could not be deleted"));
463     }
464     return ($retval, $self->loc("Custom field value deleted"));
465 }
466
467 # }}}
468
469
470 =head2 ValidateQueue Queue
471
472 Make sure that the queue specified is a valid queue name
473
474 =cut
475
476 sub ValidateQueue {
477     my $self = shift;
478     my $id = shift;
479
480     return undef unless defined $id;
481     # 0 means "Global" null would _not_ be ok.
482     return 1 if $id eq '0';
483
484     my $q = RT::Queue->new( $RT::SystemUser );
485     $q->Load( $id );
486     return undef unless $q->id;
487     return 1;
488 }
489
490
491 # {{{ Types
492
493 =head2 Types 
494
495 Retuns an array of the types of CustomField that are supported
496
497 =cut
498
499 sub Types {
500     return (keys %FieldTypes);
501 }
502
503 # }}}
504
505 # {{{ IsSelectionType
506
507 =head2 IsSelectionType 
508
509 Retuns a boolean value indicating whether the C<Values> method makes sense
510 to this Custom Field.
511
512 =cut
513
514 sub IsSelectionType {
515     my $self = shift;
516     my $type = @_? shift : $self->Type;
517     return undef unless $type;
518
519     $type =~ /(?:Select|Combobox|Autocomplete)/;
520 }
521
522 # }}}
523
524
525 =head2 IsExternalValues
526
527 =cut
528
529 sub IsExternalValues {
530     my $self = shift;
531     my $selectable = $self->IsSelectionType( @_ );
532     return $selectable unless $selectable;
533
534     my $class = $self->ValuesClass;
535     return 0 if $class eq 'RT::CustomFieldValues';
536     return 1;
537 }
538
539 sub ValuesClass {
540     my $self = shift;
541     return '' unless $self->IsSelectionType;
542
543     my $class = $self->FirstAttribute( 'ValuesClass' );
544     $class = $class->Content if $class;
545     return $class || 'RT::CustomFieldValues';
546 }
547
548 sub SetValuesClass {
549     my $self = shift;
550     my $class = shift || 'RT::CustomFieldValues';
551
552     if( $class eq 'RT::CustomFieldValues' ) {
553         return $self->DeleteAttribute( 'ValuesClass' );
554     }
555     return $self->SetAttribute( Name => 'ValuesClass', Content => $class );
556 }
557
558
559 =head2 FriendlyType [TYPE, MAX_VALUES]
560
561 Returns a localized human-readable version of the custom field type.
562 If a custom field type is specified as the parameter, the friendly type for that type will be returned
563
564 =cut
565
566 sub FriendlyType {
567     my $self = shift;
568
569     my $type = @_ ? shift : $self->Type;
570     my $max  = @_ ? shift : $self->MaxValues;
571     $max = 0 unless $max;
572
573     if (my $friendly_type = $FieldTypes{$type}[$max>2 ? 2 : $max]) {
574         return ( $self->loc( $friendly_type, $max ) );
575     }
576     else {
577         return ( $self->loc( $type ) );
578     }
579 }
580
581 sub FriendlyTypeComposite {
582     my $self = shift;
583     my $composite = shift || $self->TypeComposite;
584     return $self->FriendlyType(split(/-/, $composite, 2));
585 }
586
587
588 =head2 ValidateType TYPE
589
590 Takes a single string. returns true if that string is a value
591 type of custom field
592
593
594 =cut
595
596 sub ValidateType {
597     my $self = shift;
598     my $type = shift;
599
600     if ( $type =~ s/(?:Single|Multiple)$// ) {
601         $RT::Logger->warning( "Prefix 'Single' and 'Multiple' to Type deprecated, use MaxValues instead at (". join(":",caller).")");
602     }
603
604     if ( $FieldTypes{$type} ) {
605         return 1;
606     }
607     else {
608         return undef;
609     }
610 }
611
612
613 sub SetType {
614     my $self = shift;
615     my $type = shift;
616     if ($type =~ s/(?:(Single)|Multiple)$//) {
617         $RT::Logger->warning("'Single' and 'Multiple' on SetType deprecated, use SetMaxValues instead at (". join(":",caller).")");
618         $self->SetMaxValues($1 ? 1 : 0);
619     }
620     $self->SUPER::SetType($type);
621 }
622
623 =head2 SetPattern STRING
624
625 Takes a single string representing a regular expression.  Performs basic
626 validation on that regex, and sets the C<Pattern> field for the CF if it
627 is valid.
628
629 =cut
630
631 sub SetPattern {
632     my $self = shift;
633     my $regex = shift;
634
635     my ($ok, $msg) = $self->_IsValidRegex($regex);
636     if ($ok) {
637         return $self->SUPER::SetPattern($regex);
638     }
639     else {
640         return (0, $self->loc("Invalid pattern: [_1]", $msg));
641     }
642 }
643
644 =head2 _IsValidRegex(Str $regex) returns (Bool $success, Str $msg)
645
646 Tests if the string contains an invalid regex.
647
648 =cut
649
650 sub _IsValidRegex {
651     my $self  = shift;
652     my $regex = shift or return (1, 'valid');
653
654     local $^W; local $@;
655     local $SIG{__DIE__} = sub { 1 };
656     local $SIG{__WARN__} = sub { 1 };
657
658     if (eval { qr/$regex/; 1 }) {
659         return (1, 'valid');
660     }
661
662     my $err = $@;
663     $err =~ s{[,;].*}{};    # strip debug info from error
664     chomp $err;
665     return (0, $err);
666 }
667
668 # {{{ SingleValue
669
670 =head2 SingleValue
671
672 Returns true if this CustomField only accepts a single value. 
673 Returns false if it accepts multiple values
674
675 =cut
676
677 sub SingleValue {
678     my $self = shift;
679     if (($self->MaxValues||0) == 1) {
680         return 1;
681     } 
682     else {
683         return undef;
684     }
685 }
686
687 sub UnlimitedValues {
688     my $self = shift;
689     if (($self->MaxValues||0) == 0) {
690         return 1;
691     } 
692     else {
693         return undef;
694     }
695 }
696
697 # }}}
698
699 =head2 CurrentUserHasRight RIGHT
700
701 Helper function to call the custom field's queue's CurrentUserHasRight with the passed in args.
702
703 =cut
704
705 sub CurrentUserHasRight {
706     my $self  = shift;
707     my $right = shift;
708
709     return $self->CurrentUser->HasRight(
710         Object => $self,
711         Right  => $right,
712     );
713 }
714
715 =head2 ACLEquivalenceObjects
716
717 Returns list of objects via which users can get rights on this custom field. For custom fields
718 these objects can be set using L<ContextObject|/"ContextObject and SetContextObject">.
719
720 =cut
721
722 sub ACLEquivalenceObjects {
723     my $self = shift;
724
725     my $ctx = $self->ContextObject
726         or return;
727     return ($ctx, $ctx->ACLEquivalenceObjects);
728 }
729
730 =head2 ContextObject and SetContextObject
731
732 Set or get a context for this object. It can be ticket, queue or another object
733 this CF applies to. Used for ACL control, for example SeeCustomField can be granted on
734 queue level to allow people to see all fields applied to the queue.
735
736 =cut
737
738 sub SetContextObject {
739     my $self = shift;
740     return $self->{'context_object'} = shift;
741 }
742   
743 sub ContextObject {
744     my $self = shift;
745     return $self->{'context_object'};
746 }
747   
748 # {{{ sub _Set
749
750 sub _Set {
751     my $self = shift;
752
753     unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
754         return ( 0, $self->loc('Permission Denied') );
755     }
756     return $self->SUPER::_Set( @_ );
757
758 }
759
760 # }}}
761
762 # {{{ sub _Value 
763
764 =head2 _Value
765
766 Takes the name of a table column.
767 Returns its value as a string, if the user passes an ACL check
768
769 =cut
770
771 sub _Value {
772     my $self  = shift;
773     return undef unless $self->id;
774
775     # we need to do the rights check
776     unless ( $self->CurrentUserHasRight('SeeCustomField') ) {
777         $RT::Logger->debug(
778             "Permission denied. User #". $self->CurrentUser->id
779             ." has no SeeCustomField right on CF #". $self->id
780         );
781         return (undef);
782     }
783     return $self->__Value( @_ );
784 }
785
786 # }}}
787 # {{{ sub SetDisabled
788
789 =head2 SetDisabled
790
791 Takes a boolean.
792 1 will cause this custom field to no longer be avaialble for objects.
793 0 will re-enable this field.
794
795 =cut
796
797 # }}}
798
799 =head2 SetTypeComposite
800
801 Set this custom field's type and maximum values as a composite value
802
803 =cut
804
805 sub SetTypeComposite {
806     my $self = shift;
807     my $composite = shift;
808
809     my $old = $self->TypeComposite;
810
811     my ($type, $max_values) = split(/-/, $composite, 2);
812     if ( $type ne $self->Type ) {
813         my ($status, $msg) = $self->SetType( $type );
814         return ($status, $msg) unless $status;
815     }
816     if ( ($max_values || 0) != ($self->MaxValues || 0) ) {
817         my ($status, $msg) = $self->SetMaxValues( $max_values );
818         return ($status, $msg) unless $status;
819     }
820     return 1, $self->loc(
821         "Type changed from '[_1]' to '[_2]'",
822         $self->FriendlyTypeComposite( $old ),
823         $self->FriendlyTypeComposite( $composite ),
824     );
825 }
826
827 =head2 TypeComposite
828
829 Returns a composite value composed of this object's type and maximum values
830
831 =cut
832
833
834 sub TypeComposite {
835     my $self = shift;
836     return join '-', ($self->Type || ''), ($self->MaxValues || 0);
837 }
838
839 =head2 TypeComposites
840
841 Returns an array of all possible composite values for custom fields.
842
843 =cut
844
845 sub TypeComposites {
846     my $self = shift;
847     return grep !/(?:[Tt]ext|Combobox|Date|TimeValue)-0/, map { ("$_-1", "$_-0") } $self->Types;
848 }
849
850 =head2 SetLookupType
851
852 Autrijus: care to doc how LookupTypes work?
853
854 =cut
855
856 sub SetLookupType {
857     my $self = shift;
858     my $lookup = shift;
859     if ( $lookup ne $self->LookupType ) {
860         # Okay... We need to invalidate our existing relationships
861         my $ObjectCustomFields = RT::ObjectCustomFields->new($self->CurrentUser);
862         $ObjectCustomFields->LimitToCustomField($self->Id);
863         $_->Delete foreach @{$ObjectCustomFields->ItemsArrayRef};
864     }
865     return $self->SUPER::SetLookupType($lookup);
866 }
867
868 =head2 LookupTypes
869
870 Returns an array of LookupTypes available
871
872 =cut
873
874
875 sub LookupTypes {
876     my $self = shift;
877     return keys %FRIENDLY_OBJECT_TYPES;
878 }
879
880 my @FriendlyObjectTypes = (
881     "[_1] objects",            # loc
882     "[_1]'s [_2] objects",        # loc
883     "[_1]'s [_2]'s [_3] objects",   # loc
884 );
885
886 =head2 FriendlyLookupType
887
888 Returns a localized description of the type of this custom field
889
890 =cut
891
892 sub FriendlyLookupType {
893     my $self = shift;
894     my $lookup = shift || $self->LookupType;
895    
896     return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} ))
897                      if (defined  $FRIENDLY_OBJECT_TYPES{$lookup} );
898
899     my @types = map { s/^RT::// ? $self->loc($_) : $_ }
900       grep { defined and length }
901       split( /-/, $lookup )
902       or return;
903     return ( $self->loc( $FriendlyObjectTypes[$#types], @types ) );
904 }
905
906 sub RecordClassFromLookupType {
907     my $self = shift;
908     my ($class) = ($self->LookupType =~ /^([^-]+)/);
909     unless ( $class ) {
910         $RT::Logger->error(
911             "Custom Field #". $self->id 
912             ." has incorrect LookupType '". $self->LookupType ."'"
913         );
914         return undef;
915     }
916     return $class;
917 }
918
919 sub CollectionClassFromLookupType {
920     my $self = shift;
921
922     my $record_class = $self->RecordClassFromLookupType;
923     return undef unless $record_class;
924
925     my $collection_class;
926     if ( UNIVERSAL::can($record_class.'Collection', 'new') ) {
927         $collection_class = $record_class.'Collection';
928     } elsif ( UNIVERSAL::can($record_class.'es', 'new') ) {
929         $collection_class = $record_class.'es';
930     } elsif ( UNIVERSAL::can($record_class.'s', 'new') ) {
931         $collection_class = $record_class.'s';
932     } else {
933         $RT::Logger->error("Can not find a collection class for record class '$record_class'");
934         return undef;
935     }
936     return $collection_class;
937 }
938
939 =head1 AppliedTo
940
941 Returns collection with objects this custom field is applied to.
942 Class of the collection depends on L</LookupType>.
943 See all L</NotAppliedTo> .
944
945 Doesn't takes into account if object is applied globally.
946
947 =cut
948
949 sub AppliedTo {
950     my $self = shift;
951
952     my ($res, $ocfs_alias) = $self->_AppliedTo;
953     return $res unless $res;
954
955     $res->Limit(
956         ALIAS     => $ocfs_alias,
957         FIELD     => 'id',
958         OPERATOR  => 'IS NOT',
959         VALUE     => 'NULL',
960     );
961
962     return $res;
963 }
964
965 =head1 NotAppliedTo
966
967 Returns collection with objects this custom field is not applied to.
968 Class of the collection depends on L</LookupType>.
969 See all L</AppliedTo> .
970
971 Doesn't takes into account if object is applied globally.
972
973 =cut
974
975 sub NotAppliedTo {
976     my $self = shift;
977
978     my ($res, $ocfs_alias) = $self->_AppliedTo;
979     return $res unless $res;
980
981     $res->Limit(
982         ALIAS     => $ocfs_alias,
983         FIELD     => 'id',
984         OPERATOR  => 'IS',
985         VALUE     => 'NULL',
986     );
987
988     return $res;
989 }
990
991 sub _AppliedTo {
992     my $self = shift;
993
994     my ($class) = $self->CollectionClassFromLookupType;
995     return undef unless $class;
996
997     my $res = $class->new( $self->CurrentUser );
998
999     # If CF is a Group CF, only display user-defined groups
1000     if ( $class eq 'RT::Groups' ) {
1001         $res->LimitToUserDefinedGroups;
1002     }
1003
1004     $res->OrderBy( FIELD => 'Name' );
1005     my $ocfs_alias = $res->Join(
1006         TYPE   => 'LEFT',
1007         ALIAS1 => 'main',
1008         FIELD1 => 'id',
1009         TABLE2 => 'ObjectCustomFields',
1010         FIELD2 => 'ObjectId',
1011     );
1012     $res->Limit(
1013         LEFTJOIN => $ocfs_alias,
1014         ALIAS    => $ocfs_alias,
1015         FIELD    => 'CustomField',
1016         VALUE    => $self->id,
1017     );
1018     return ($res, $ocfs_alias);
1019 }
1020
1021 =head2 IsApplied
1022
1023 Takes object id and returns corresponding L<RT::ObjectCustomField>
1024 record if this custom field is applied to the object. Use 0 to check
1025 if custom field is applied globally.
1026
1027 =cut
1028
1029 sub IsApplied {
1030     my $self = shift;
1031     my $id = shift;
1032     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
1033     $ocf->LoadByCols( CustomField => $self->id, ObjectId => $id || 0 );
1034     return undef unless $ocf->id;
1035     return $ocf;
1036 }
1037
1038 =head2 AddToObject OBJECT
1039
1040 Add this custom field as a custom field for a single object, such as a queue or group.
1041
1042 Takes an object 
1043
1044 =cut
1045
1046
1047 sub AddToObject {
1048     my $self  = shift;
1049     my $object = shift;
1050     my $id = $object->Id || 0;
1051
1052     unless (index($self->LookupType, ref($object)) == 0) {
1053         return ( 0, $self->loc('Lookup type mismatch') );
1054     }
1055
1056     unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
1057         return ( 0, $self->loc('Permission Denied') );
1058     }
1059
1060     if ( $self->IsApplied( $id ) ) {
1061         return ( 0, $self->loc("Custom field is already applied to the object") );
1062     }
1063
1064     if ( $id ) {
1065         # applying locally
1066         return (0, $self->loc("Couldn't apply custom field to an object as it's global already") )
1067             if $self->IsApplied( 0 );
1068     }
1069     else {
1070         my $applied = RT::ObjectCustomFields->new( $self->CurrentUser );
1071         $applied->LimitToCustomField( $self->id );
1072         while ( my $record = $applied->Next ) {
1073             $record->Delete;
1074         }
1075     }
1076
1077     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
1078     my ( $oid, $msg ) = $ocf->Create(
1079         ObjectId => $id, CustomField => $self->id,
1080     );
1081     return ( $oid, $msg );
1082 }
1083
1084
1085 =head2 RemoveFromObject OBJECT
1086
1087 Remove this custom field  for a single object, such as a queue or group.
1088
1089 Takes an object 
1090
1091 =cut
1092
1093 sub RemoveFromObject {
1094     my $self = shift;
1095     my $object = shift;
1096     my $id = $object->Id || 0;
1097
1098     unless (index($self->LookupType, ref($object)) == 0) {
1099         return ( 0, $self->loc('Object type mismatch') );
1100     }
1101
1102     unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
1103         return ( 0, $self->loc('Permission Denied') );
1104     }
1105
1106     my $ocf = $self->IsApplied( $id );
1107     unless ( $ocf ) {
1108         return ( 0, $self->loc("This custom field does not apply to that object") );
1109     }
1110
1111     # XXX: Delete doesn't return anything
1112     my ( $oid, $msg ) = $ocf->Delete;
1113     return ( $oid, $msg );
1114 }
1115
1116 # {{{ AddValueForObject
1117
1118 =head2 AddValueForObject HASH
1119
1120 Adds a custom field value for a record object of some kind. 
1121 Takes a param hash of 
1122
1123 Required:
1124
1125     Object
1126     Content
1127
1128 Optional:
1129
1130     LargeContent
1131     ContentType
1132
1133 =cut
1134
1135 sub AddValueForObject {
1136     my $self = shift;
1137     my %args = (
1138         Object       => undef,
1139         Content      => undef,
1140         LargeContent => undef,
1141         ContentType  => undef,
1142         @_
1143     );
1144     my $obj = $args{'Object'} or return ( 0, $self->loc('Invalid object') );
1145
1146     unless ( $self->CurrentUserHasRight('ModifyCustomField') ) {
1147         return ( 0, $self->loc('Permission Denied') );
1148     }
1149
1150     unless ( $self->MatchPattern($args{'Content'}) ) {
1151         return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
1152     }
1153
1154     $RT::Handle->BeginTransaction;
1155
1156     if ( $self->MaxValues ) {
1157         my $current_values = $self->ValuesForObject($obj);
1158         my $extra_values = ( $current_values->Count + 1 ) - $self->MaxValues;
1159
1160         # (The +1 is for the new value we're adding)
1161
1162         # If we have a set of current values and we've gone over the maximum
1163         # allowed number of values, we'll need to delete some to make room.
1164         # which former values are blown away is not guaranteed
1165
1166         while ($extra_values) {
1167             my $extra_item = $current_values->Next;
1168             unless ( $extra_item->id ) {
1169                 $RT::Logger->crit( "We were just asked to delete "
1170                     ."a custom field value that doesn't exist!" );
1171                 $RT::Handle->Rollback();
1172                 return (undef);
1173             }
1174             $extra_item->Delete;
1175             $extra_values--;
1176         }
1177     }
1178     # For date, we need to store Content as ISO date
1179     if ($self->Type eq 'Date') {
1180         my $DateObj = new RT::Date( $self->CurrentUser );
1181         $DateObj->Set(
1182             Format => 'unknown',
1183             Value  => $args{'Content'},
1184         );
1185         $args{'Content'} = $DateObj->ISO;
1186     }
1187     my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1188     my $val    = $newval->Create(
1189         ObjectType   => ref($obj),
1190         ObjectId     => $obj->Id,
1191         Content      => $args{'Content'},
1192         LargeContent => $args{'LargeContent'},
1193         ContentType  => $args{'ContentType'},
1194         CustomField  => $self->Id
1195     );
1196
1197     unless ($val) {
1198         $RT::Handle->Rollback();
1199         return ($val, $self->loc("Couldn't create record"));
1200     }
1201
1202     $RT::Handle->Commit();
1203     return ($val);
1204
1205 }
1206
1207 # }}}
1208
1209 # {{{ MatchPattern
1210
1211 =head2 MatchPattern STRING
1212
1213 Tests the incoming string against the Pattern of this custom field object
1214 and returns a boolean; returns true if the Pattern is empty.
1215
1216 =cut
1217
1218 sub MatchPattern {
1219     my $self = shift;
1220     my $regex = $self->Pattern or return 1;
1221
1222     return (( defined $_[0] ? $_[0] : '') =~ $regex);
1223 }
1224
1225
1226 # }}}
1227
1228 # {{{ FriendlyPattern
1229
1230 =head2 FriendlyPattern
1231
1232 Prettify the pattern of this custom field, by taking the text in C<(?#text)>
1233 and localizing it.
1234
1235 =cut
1236
1237 sub FriendlyPattern {
1238     my $self = shift;
1239     my $regex = $self->Pattern;
1240
1241     return '' unless length $regex;
1242     if ( $regex =~ /\(\?#([^)]*)\)/ ) {
1243         return '[' . $self->loc($1) . ']';
1244     }
1245     else {
1246         return $regex;
1247     }
1248 }
1249
1250
1251 # }}}
1252
1253 # {{{ DeleteValueForObject
1254
1255 =head2 DeleteValueForObject HASH
1256
1257 Deletes a custom field value for a ticket. Takes a param hash of Object and Content
1258
1259 Returns a tuple of (STATUS, MESSAGE). If the call succeeded, the STATUS is true. otherwise it's false
1260
1261 =cut
1262
1263 sub DeleteValueForObject {
1264     my $self = shift;
1265     my %args = ( Object => undef,
1266                  Content => undef,
1267                  Id => undef,
1268              @_ );
1269
1270
1271     unless ($self->CurrentUserHasRight('ModifyCustomField')) {
1272         return (0, $self->loc('Permission Denied'));
1273     }
1274
1275     my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser);
1276
1277     if (my $id = $args{'Id'}) {
1278         $oldval->Load($id);
1279     }
1280     unless ($oldval->id) { 
1281         $oldval->LoadByObjectContentAndCustomField(
1282             Object => $args{'Object'}, 
1283             Content =>  $args{'Content'}, 
1284             CustomField => $self->Id,
1285         );
1286     }
1287
1288
1289     # check to make sure we found it
1290     unless ($oldval->Id) {
1291         return(0, $self->loc("Custom field value [_1] could not be found for custom field [_2]", $args{'Content'}, $self->Name));
1292     }
1293
1294     # for single-value fields, we need to validate that empty string is a valid value for it
1295     if ( $self->SingleValue and not $self->MatchPattern( '' ) ) {
1296         return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
1297     }
1298
1299     # delete it
1300
1301     my $ret = $oldval->Delete();
1302     unless ($ret) {
1303         return(0, $self->loc("Custom field value could not be found"));
1304     }
1305     return($oldval->Id, $self->loc("Custom field value deleted"));
1306 }
1307
1308
1309 =head2 ValuesForObject OBJECT
1310
1311 Return an L<RT::ObjectCustomFieldValues> object containing all of this custom field's values for OBJECT 
1312
1313 =cut
1314
1315 sub ValuesForObject {
1316     my $self = shift;
1317     my $object = shift;
1318
1319     my $values = new RT::ObjectCustomFieldValues($self->CurrentUser);
1320     unless ($self->CurrentUserHasRight('SeeCustomField')) {
1321         # Return an empty object if they have no rights to see
1322         return ($values);
1323     }
1324     
1325     
1326     $values->LimitToCustomField($self->Id);
1327     $values->LimitToEnabled();
1328     $values->LimitToObject($object);
1329
1330     return ($values);
1331 }
1332
1333
1334 =head2 _ForObjectType PATH FRIENDLYNAME
1335
1336 Tell RT that a certain object accepts custom fields
1337
1338 Examples:
1339
1340     'RT::Queue-RT::Ticket'                 => "Tickets",                # loc
1341     'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions",    # loc
1342     'RT::User'                             => "Users",                  # loc
1343     'RT::Group'                            => "Groups",                 # loc
1344
1345 This is a class method. 
1346
1347 =cut
1348
1349 sub _ForObjectType {
1350     my $self = shift;
1351     my $path = shift;
1352     my $friendly_name = shift;
1353
1354     $FRIENDLY_OBJECT_TYPES{$path} = $friendly_name;
1355
1356 }
1357
1358
1359 =head2 IncludeContentForValue [VALUE] (and SetIncludeContentForValue)
1360
1361 Gets or sets the  C<IncludeContentForValue> for this custom field. RT
1362 uses this field to automatically include content into the user's browser
1363 as they display records with custom fields in RT.
1364
1365 =cut
1366
1367 sub SetIncludeContentForValue {
1368     shift->IncludeContentForValue(@_);
1369 }
1370 sub IncludeContentForValue{
1371     my $self = shift;
1372     $self->_URLTemplate('IncludeContentForValue', @_);
1373 }
1374
1375
1376
1377 =head2 LinkValueTo [VALUE] (and SetLinkValueTo)
1378
1379 Gets or sets the  C<LinkValueTo> for this custom field. RT
1380 uses this field to make custom field values into hyperlinks in the user's
1381 browser as they display records with custom fields in RT.
1382
1383 =cut
1384
1385
1386 sub SetLinkValueTo {
1387     shift->LinkValueTo(@_);
1388 }
1389
1390 sub LinkValueTo {
1391     my $self = shift;
1392     $self->_URLTemplate('LinkValueTo', @_);
1393
1394 }
1395
1396
1397 =head2 _URLTemplate  NAME [VALUE]
1398
1399 With one argument, returns the _URLTemplate named C<NAME>, but only if
1400 the current user has the right to see this custom field.
1401
1402 With two arguments, attemptes to set the relevant template value.
1403
1404 =cut
1405
1406 sub _URLTemplate {
1407     my $self          = shift;
1408     my $template_name = shift;
1409     if (@_) {
1410
1411         my $value = shift;
1412         unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
1413             return ( 0, $self->loc('Permission Denied') );
1414         }
1415         $self->SetAttribute( Name => $template_name, Content => $value );
1416         return ( 1, $self->loc('Updated') );
1417     } else {
1418         unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) {
1419             return (undef);
1420         }
1421
1422         my @attr = $self->Attributes->Named($template_name);
1423         my $attr = shift @attr;
1424
1425         if ($attr) { return $attr->Content }
1426
1427     }
1428 }
1429
1430 sub SetBasedOn {
1431     my $self = shift;
1432     my $value = shift;
1433
1434     return $self->DeleteAttribute( "BasedOn" )
1435         unless defined $value and length $value;
1436
1437     my $cf = RT::CustomField->new( $self->CurrentUser );
1438     $cf->Load( ref $value ? $value->Id : $value );
1439
1440     return (0, "Permission denied")
1441         unless $cf->Id && $cf->CurrentUserHasRight('SeeCustomField');
1442
1443     return $self->AddAttribute(
1444         Name => "BasedOn",
1445         Description => "Custom field whose CF we depend on",
1446         Content => $cf->Id,
1447     );
1448 }
1449
1450 sub BasedOnObj {
1451     my $self = shift;
1452     my $obj = RT::CustomField->new( $self->CurrentUser );
1453
1454     my $attribute = $self->FirstAttribute("BasedOn");
1455     $obj->Load($attribute->Content) if defined $attribute;
1456     return $obj;
1457 }
1458
1459 sub UILocation {
1460     my $self = shift;
1461     my $tag = $self->FirstAttribute( 'UILocation' );
1462     return $tag ? $tag->Content : '';
1463 }
1464
1465 sub SetUILocation {
1466     my $self = shift;
1467     my $tag = shift;
1468     if ( $tag ) {
1469         return $self->SetAttribute( Name => 'UILocation', Content => $tag );
1470     }
1471     else {
1472         return $self->DeleteAttribute('UILocation');
1473     }
1474 }
1475
1476 1;