]> git.uio.no Git - usit-rt.git/blob - lib/RT/CustomField.pm
Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / CustomField.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 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 use warnings;
53 use 5.010;
54
55 use Scalar::Util 'blessed';
56
57 use base 'RT::Record';
58
59 use Role::Basic 'with';
60 with "RT::Record::Role::Rights";
61
62 sub Table {'CustomFields'}
63
64 use Scalar::Util qw(blessed);
65 use RT::CustomFieldValues;
66 use RT::ObjectCustomFields;
67 use RT::ObjectCustomFieldValues;
68
69 our %FieldTypes = (
70     Select => {
71         sort_order => 10,
72         selection_type => 1,
73
74         labels => [ 'Select multiple values',      # loc
75                     'Select one value',            # loc
76                     'Select up to [_1] values',    # loc
77                   ],
78
79         render_types => {
80             multiple => [
81
82                 # Default is the first one
83                 'Select box',              # loc
84                 'List',                    # loc
85             ],
86             single => [ 'Select box',              # loc
87                         'Dropdown',                # loc
88                         'List',                    # loc
89                       ]
90         },
91
92     },
93     Freeform => {
94         sort_order => 20,
95         selection_type => 0,
96
97         labels => [ 'Enter multiple values',       # loc
98                     'Enter one value',             # loc
99                     'Enter up to [_1] values',     # loc
100                   ]
101                 },
102     Text => {
103         sort_order => 30,
104         selection_type => 0,
105         labels         => [
106                     'Fill in multiple text areas',      # loc
107                     'Fill in one text area',            # loc
108                     'Fill in up to [_1] text areas',    # loc
109                   ]
110             },
111     Wikitext => {
112         sort_order => 40,
113         selection_type => 0,
114         labels         => [
115                     'Fill in multiple wikitext areas',      # loc
116                     'Fill in one wikitext area',            # loc
117                     'Fill in up to [_1] wikitext areas',    # loc
118                   ]
119                 },
120
121     Image => {
122         sort_order => 50,
123         selection_type => 0,
124         labels         => [
125                     'Upload multiple images',               # loc
126                     'Upload one image',                     # loc
127                     'Upload up to [_1] images',             # loc
128                   ]
129              },
130     Binary => {
131         sort_order => 60,
132         selection_type => 0,
133         labels         => [
134                     'Upload multiple files',                # loc
135                     'Upload one file',                      # loc
136                     'Upload up to [_1] files',              # loc
137                   ]
138               },
139
140     Combobox => {
141         sort_order => 70,
142         selection_type => 1,
143         labels         => [
144                     'Combobox: Select or enter multiple values',      # loc
145                     'Combobox: Select or enter one value',            # loc
146                     'Combobox: Select or enter up to [_1] values',    # loc
147                   ]
148                 },
149     Autocomplete => {
150         sort_order => 80,
151         selection_type => 1,
152         labels         => [
153                     'Enter multiple values with autocompletion',      # loc
154                     'Enter one value with autocompletion',            # loc
155                     'Enter up to [_1] values with autocompletion',    # loc
156                   ]
157     },
158
159     Date => {
160         sort_order => 90,
161         selection_type => 0,
162         labels         => [
163                     'Select multiple dates',                          # loc
164                     'Select date',                                    # loc
165                     'Select up to [_1] dates',                        # loc
166                   ]
167             },
168     DateTime => {
169         sort_order => 100,
170         selection_type => 0,
171         labels         => [
172                     'Select multiple datetimes',                      # loc
173                     'Select datetime',                                # loc
174                     'Select up to [_1] datetimes',                    # loc
175                   ]
176                 },
177
178     IPAddress => {
179         sort_order => 110,
180         selection_type => 0,
181
182         labels => [ 'Enter multiple IP addresses',       # loc
183                     'Enter one IP address',             # loc
184                     'Enter up to [_1] IP addresses',     # loc
185                   ]
186                 },
187     IPAddressRange => {
188         sort_order => 120,
189         selection_type => 0,
190
191         labels => [ 'Enter multiple IP address ranges',       # loc
192                     'Enter one IP address range',             # loc
193                     'Enter up to [_1] IP address ranges',     # loc
194                   ]
195                 },
196 );
197
198
199 my %BUILTIN_GROUPINGS;
200 my %FRIENDLY_LOOKUP_TYPES = ();
201
202 __PACKAGE__->RegisterLookupType( 'RT::Queue-RT::Ticket' => "Tickets", );    #loc
203 __PACKAGE__->RegisterLookupType( 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", ); #loc
204 __PACKAGE__->RegisterLookupType( 'RT::User'  => "Users", );                           #loc
205 __PACKAGE__->RegisterLookupType( 'RT::Queue'  => "Queues", );                         #loc
206 __PACKAGE__->RegisterLookupType( 'RT::Group' => "Groups", );                          #loc
207
208 __PACKAGE__->RegisterBuiltInGroupings(
209     'RT::Ticket'    => [ qw(Basics Dates Links People) ],
210     'RT::User'      => [ 'Identity', 'Access control', 'Location', 'Phones' ],
211 );
212
213 __PACKAGE__->AddRight( General => SeeCustomField         => 'View custom fields'); # loc_pair
214 __PACKAGE__->AddRight( Admin   => AdminCustomField       => 'Create, modify and delete custom fields'); # loc_pair
215 __PACKAGE__->AddRight( Admin   => AdminCustomFieldValues => 'Create, modify and delete custom fields values'); # loc_pair
216 __PACKAGE__->AddRight( Staff   => ModifyCustomField      => 'Add, modify and delete custom field values for objects'); # loc_pair
217
218 =head1 NAME
219
220   RT::CustomField_Overlay - overlay for RT::CustomField
221
222 =head1 DESCRIPTION
223
224 =head1 'CORE' METHODS
225
226 =head2 Create PARAMHASH
227
228 Create takes a hash of values and creates a row in the database:
229
230   varchar(200) 'Name'.
231   varchar(200) 'Type'.
232   int(11) 'MaxValues'.
233   varchar(255) 'Pattern'.
234   varchar(255) 'Description'.
235   int(11) 'SortOrder'.
236   varchar(255) 'LookupType'.
237   smallint(6) 'Disabled'.
238
239 C<LookupType> is generally the result of either
240 C<RT::Ticket->CustomFieldLookupType> or C<RT::Transaction->CustomFieldLookupType>.
241
242 =cut
243
244 sub Create {
245     my $self = shift;
246     my %args = (
247         Name        => '',
248         Type        => '',
249         MaxValues   => 0,
250         Pattern     => '',
251         Description => '',
252         Disabled    => 0,
253         LookupType  => '',
254         LinkValueTo => '',
255         IncludeContentForValue => '',
256         @_,
257     );
258
259     unless ( $self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField') ) {
260         return (0, $self->loc('Permission Denied'));
261     }
262
263     if ( $args{TypeComposite} ) {
264         @args{'Type', 'MaxValues'} = split(/-/, $args{TypeComposite}, 2);
265     }
266     elsif ( $args{Type} =~ s/(?:(Single)|Multiple)$// ) {
267         # old style Type string
268         $args{'MaxValues'} = $1 ? 1 : 0;
269     }
270     $args{'MaxValues'} = int $args{'MaxValues'};
271
272     if ( !exists $args{'Queue'}) {
273     # do nothing -- things below are strictly backward compat
274     }
275     elsif (  ! $args{'Queue'} ) {
276         unless ( $self->CurrentUser->HasRight( Object => $RT::System, Right => 'AssignCustomFields') ) {
277             return ( 0, $self->loc('Permission Denied') );
278         }
279         $args{'LookupType'} = 'RT::Queue-RT::Ticket';
280     }
281     else {
282         my $queue = RT::Queue->new($self->CurrentUser);
283         $queue->Load($args{'Queue'});
284         unless ($queue->Id) {
285             return (0, $self->loc("Queue not found"));
286         }
287         unless ( $queue->CurrentUserHasRight('AssignCustomFields') ) {
288             return ( 0, $self->loc('Permission Denied') );
289         }
290         $args{'LookupType'} = 'RT::Queue-RT::Ticket';
291         $args{'Queue'} = $queue->Id;
292     }
293
294     my ($ok, $msg) = $self->_IsValidRegex( $args{'Pattern'} );
295     return (0, $self->loc("Invalid pattern: [_1]", $msg)) unless $ok;
296
297     if ( $args{'MaxValues'} != 1 && $args{'Type'} =~ /(text|combobox)$/i ) {
298         $RT::Logger->debug("Support for 'multiple' Texts or Comboboxes is not implemented");
299         $args{'MaxValues'} = 1;
300     }
301
302     if ( $args{'RenderType'} ||= undef ) {
303         my $composite = join '-', @args{'Type', 'MaxValues'};
304         return (0, $self->loc("This custom field has no Render Types"))
305             unless $self->HasRenderTypes( $composite );
306
307         if ( $args{'RenderType'} eq $self->DefaultRenderType( $composite ) ) {
308             $args{'RenderType'} = undef;
309         } else {
310             return (0, $self->loc("Invalid Render Type") )
311                 unless grep $_ eq  $args{'RenderType'}, $self->RenderTypes( $composite );
312         }
313     }
314
315     $args{'ValuesClass'} = undef if ($args{'ValuesClass'} || '') eq 'RT::CustomFieldValues';
316     if ( $args{'ValuesClass'} ||= undef ) {
317         return (0, $self->loc("This Custom Field can not have list of values"))
318             unless $self->IsSelectionType( $args{'Type'} );
319
320         unless ( $self->ValidateValuesClass( $args{'ValuesClass'} ) ) {
321             return (0, $self->loc("Invalid Custom Field values source"));
322         }
323     }
324
325     $args{'Disabled'} ||= 0;
326
327     (my $rv, $msg) = $self->SUPER::Create(
328         Name        => $args{'Name'},
329         Type        => $args{'Type'},
330         RenderType  => $args{'RenderType'},
331         MaxValues   => $args{'MaxValues'},
332         Pattern     => $args{'Pattern'},
333         BasedOn     => $args{'BasedOn'},
334         ValuesClass => $args{'ValuesClass'},
335         Description => $args{'Description'},
336         Disabled    => $args{'Disabled'},
337         LookupType  => $args{'LookupType'},
338     );
339
340     if ($rv) {
341         if ( exists $args{'LinkValueTo'}) {
342             $self->SetLinkValueTo($args{'LinkValueTo'});
343         }
344
345         if ( exists $args{'IncludeContentForValue'}) {
346             $self->SetIncludeContentForValue($args{'IncludeContentForValue'});
347         }
348
349         return ($rv, $msg) unless exists $args{'Queue'};
350
351         # Compat code -- create a new ObjectCustomField mapping
352         my $OCF = RT::ObjectCustomField->new( $self->CurrentUser );
353         $OCF->Create(
354             CustomField => $self->Id,
355             ObjectId => $args{'Queue'},
356         );
357     }
358
359     return ($rv, $msg);
360 }
361
362 =head2 Load ID/NAME
363
364 Load a custom field.  If the value handed in is an integer, load by custom field ID. Otherwise, Load by name.
365
366 =cut
367
368 sub Load {
369     my $self = shift;
370     my $id = shift || '';
371
372     if ( $id =~ /^\d+$/ ) {
373         return $self->SUPER::Load( $id );
374     } else {
375         return $self->LoadByName( Name => $id );
376     }
377 }
378
379
380
381 =head2 LoadByName (Queue => QUEUEID, Name => NAME)
382
383 Loads the Custom field named NAME.
384
385 Will load a Disabled Custom Field even if there is a non-disabled Custom Field
386 with the same Name.
387
388 If a Queue parameter is specified, only look for ticket custom fields tied to that Queue.
389
390 If the Queue parameter is '0', look for global ticket custom fields.
391
392 If no queue parameter is specified, look for any and all custom fields with this name.
393
394 BUG/TODO, this won't let you specify that you only want user or group CFs.
395
396 =cut
397
398 # Compatibility for API change after 3.0 beta 1
399 *LoadNameAndQueue = \&LoadByName;
400 # Change after 3.4 beta.
401 *LoadByNameAndQueue = \&LoadByName;
402
403 sub LoadByName {
404     my $self = shift;
405     my %args = (
406         Queue => undef,
407         Name  => undef,
408         LookupType => undef,
409         @_,
410     );
411
412     unless ( defined $args{'Name'} && length $args{'Name'} ) {
413         $RT::Logger->error("Couldn't load Custom Field without Name");
414         return wantarray ? (0, $self->loc("No name provided")) : 0;
415     }
416
417     # if we're looking for a queue by name, make it a number
418     if ( defined $args{'Queue'} && ($args{'Queue'} =~ /\D/ || !$self->ContextObject) ) {
419         my $QueueObj = RT::Queue->new( $self->CurrentUser );
420         $QueueObj->Load( $args{'Queue'} );
421         $args{'Queue'} = $QueueObj->Id;
422         $self->SetContextObject( $QueueObj )
423             unless $self->ContextObject;
424     }
425
426     # XXX - really naive implementation.  Slow. - not really. still just one query
427
428     my $CFs = RT::CustomFields->new( $self->CurrentUser );
429     $CFs->SetContextObject( $self->ContextObject );
430     my $field = $args{'Name'} =~ /\D/? 'Name' : 'id';
431     $CFs->Limit( FIELD => $field, VALUE => $args{'Name'}, CASESENSITIVE => 0);
432
433     # The context object may be a ticket, for example, as context for a
434     # queue CF.  The valid lookup types are thus the entire set of
435     # ACLEquivalenceObjects for the context object.
436     $args{LookupType} ||= [
437         map {$_->CustomFieldLookupType}
438             ($self->ContextObject, $self->ContextObject->ACLEquivalenceObjects) ]
439         if $self->ContextObject;
440
441     $args{LookupType} = [ $args{LookupType} ]
442         if $args{LookupType} and not ref($args{LookupType});
443     $CFs->Limit( FIELD => "LookupType", OPERATOR => "IN", VALUE => $args{LookupType} )
444         if $args{LookupType};
445
446     # Don't limit to queue if queue is 0.  Trying to do so breaks
447     # RT::Group type CFs.
448     if ( defined $args{'Queue'} ) {
449         $CFs->LimitToQueue( $args{'Queue'} );
450     }
451
452     # When loading by name, we _can_ load disabled fields, but prefer
453     # non-disabled fields.
454     $CFs->FindAllRows;
455     $CFs->OrderByCols(
456         { FIELD => "Disabled", ORDER => 'ASC' },
457     );
458
459     # We only want one entry.
460     $CFs->RowsPerPage(1);
461
462     # version before 3.8 just returns 0, so we need to test if wantarray to be
463     # backward compatible.
464     return wantarray ? (0, $self->loc("Not found")) : 0 unless my $first = $CFs->First;
465
466     return $self->LoadById( $first->id );
467 }
468
469
470
471
472 =head2 Custom field values
473
474 =head3 Values FIELD
475
476 Return a object (collection) of all acceptable values for this Custom Field.
477 Class of the object can vary and depends on the return value
478 of the C<ValuesClass> method.
479
480 =cut
481
482 *ValuesObj = \&Values;
483
484 sub Values {
485     my $self = shift;
486
487     my $class = $self->ValuesClass;
488     if ( $class ne 'RT::CustomFieldValues') {
489         eval "require $class" or die "$@";
490     }
491     my $cf_values = $class->new( $self->CurrentUser );
492     # if the user has no rights, return an empty object
493     if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
494         $cf_values->LimitToCustomField( $self->Id );
495     } else {
496         $cf_values->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' );
497     }
498     return ($cf_values);
499 }
500
501
502 =head3 AddValue HASH
503
504 Create a new value for this CustomField.  Takes a paramhash containing the elements Name, Description and SortOrder
505
506 =cut
507
508 sub AddValue {
509     my $self = shift;
510     my %args = @_;
511
512     unless ($self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues')) {
513         return (0, $self->loc('Permission Denied'));
514     }
515
516     # allow zero value
517     if ( !defined $args{'Name'} || $args{'Name'} eq '' ) {
518         return (0, $self->loc("Can't add a custom field value without a name"));
519     }
520
521     my $newval = RT::CustomFieldValue->new( $self->CurrentUser );
522     return $newval->Create( %args, CustomField => $self->Id );
523 }
524
525
526
527
528 =head3 DeleteValue ID
529
530 Deletes a value from this custom field by id.
531
532 Does not remove this value for any article which has had it selected
533
534 =cut
535
536 sub DeleteValue {
537     my $self = shift;
538     my $id = shift;
539     unless ( $self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues') ) {
540         return (0, $self->loc('Permission Denied'));
541     }
542
543     my $val_to_del = RT::CustomFieldValue->new( $self->CurrentUser );
544     $val_to_del->Load( $id );
545     unless ( $val_to_del->Id ) {
546         return (0, $self->loc("Couldn't find that value"));
547     }
548     unless ( $val_to_del->CustomField == $self->Id ) {
549         return (0, $self->loc("That is not a value for this custom field"));
550     }
551
552     my $retval = $val_to_del->Delete;
553     unless ( $retval ) {
554         return (0, $self->loc("Custom field value could not be deleted"));
555     }
556     return ($retval, $self->loc("Custom field value deleted"));
557 }
558
559
560 =head2 ValidateQueue Queue
561
562 Make sure that the name specified is valid
563
564 =cut
565
566 sub ValidateName {
567     my $self = shift;
568     my $value = shift;
569
570     return 0 unless length $value;
571
572     return $self->SUPER::ValidateName($value);
573 }
574
575 =head2 ValidateQueue Queue
576
577 Make sure that the queue specified is a valid queue name
578
579 =cut
580
581 sub ValidateQueue {
582     my $self = shift;
583     my $id = shift;
584
585     return undef unless defined $id;
586     # 0 means "Global" null would _not_ be ok.
587     return 1 if $id eq '0';
588
589     my $q = RT::Queue->new( RT->SystemUser );
590     $q->Load( $id );
591     return undef unless $q->id;
592     return 1;
593 }
594
595
596
597 =head2 Types 
598
599 Retuns an array of the types of CustomField that are supported
600
601 =cut
602
603 sub Types {
604     return (sort {(($FieldTypes{$a}{sort_order}||999) <=> ($FieldTypes{$b}{sort_order}||999)) or ($a cmp $b)} keys %FieldTypes);
605 }
606
607
608 =head2 IsSelectionType 
609
610 Retuns a boolean value indicating whether the C<Values> method makes sense
611 to this Custom Field.
612
613 =cut
614
615 sub IsSelectionType {
616     my $self = shift;
617     my $type = @_? shift : $self->Type;
618     return undef unless $type;
619     return $FieldTypes{$type}->{selection_type};
620 }
621
622
623
624 =head2 IsExternalValues
625
626 =cut
627
628 sub IsExternalValues {
629     my $self = shift;
630     return 0 unless $self->IsSelectionType( @_ );
631     return $self->ValuesClass eq 'RT::CustomFieldValues'? 0 : 1;
632 }
633
634 sub ValuesClass {
635     my $self = shift;
636     return $self->_Value( ValuesClass => @_ ) || 'RT::CustomFieldValues';
637 }
638
639 sub SetValuesClass {
640     my $self = shift;
641     my $class = shift || 'RT::CustomFieldValues';
642     
643     if ( $class eq 'RT::CustomFieldValues' ) {
644         return $self->_Set( Field => 'ValuesClass', Value => undef, @_ );
645     }
646
647     return (0, $self->loc("This Custom Field can not have list of values"))
648         unless $self->IsSelectionType;
649
650     unless ( $self->ValidateValuesClass( $class ) ) {
651         return (0, $self->loc("Invalid Custom Field values source"));
652     }
653     return $self->_Set( Field => 'ValuesClass', Value => $class, @_ );
654 }
655
656 sub ValidateValuesClass {
657     my $self = shift;
658     my $class = shift;
659
660     return 1 if !$class || $class eq 'RT::CustomFieldValues';
661     return 1 if grep $class eq $_, RT->Config->Get('CustomFieldValuesSources');
662     return undef;
663 }
664
665
666 =head2 FriendlyType [TYPE, MAX_VALUES]
667
668 Returns a localized human-readable version of the custom field type.
669 If a custom field type is specified as the parameter, the friendly type for that type will be returned
670
671 =cut
672
673 sub FriendlyType {
674     my $self = shift;
675
676     my $type = @_ ? shift : $self->Type;
677     my $max  = @_ ? shift : $self->MaxValues;
678     $max = 0 unless $max;
679
680     if (my $friendly_type = $FieldTypes{$type}->{labels}->[$max>2 ? 2 : $max]) {
681         return ( $self->loc( $friendly_type, $max ) );
682     }
683     else {
684         return ( $self->loc( $type ) );
685     }
686 }
687
688 sub FriendlyTypeComposite {
689     my $self = shift;
690     my $composite = shift || $self->TypeComposite;
691     return $self->FriendlyType(split(/-/, $composite, 2));
692 }
693
694
695 =head2 ValidateType TYPE
696
697 Takes a single string. returns true if that string is a value
698 type of custom field
699
700
701 =cut
702
703 sub ValidateType {
704     my $self = shift;
705     my $type = shift;
706
707     if ( $type =~ s/(?:Single|Multiple)$// ) {
708         RT->Deprecated(
709             Arguments => "suffix 'Single' or 'Multiple'",
710             Instead   => "MaxValues",
711             Remove    => "4.4",
712         );
713     }
714
715     if ( $FieldTypes{$type} ) {
716         return 1;
717     }
718     else {
719         return undef;
720     }
721 }
722
723
724 sub SetType {
725     my $self = shift;
726     my $type = shift;
727     if ($type =~ s/(?:(Single)|Multiple)$//) {
728         RT->Deprecated(
729             Arguments => "suffix 'Single' or 'Multiple'",
730             Instead   => "MaxValues",
731             Remove    => "4.4",
732         );
733         $self->SetMaxValues($1 ? 1 : 0);
734     }
735     $self->_Set(Field => 'Type', Value =>$type);
736 }
737
738 =head2 SetPattern STRING
739
740 Takes a single string representing a regular expression.  Performs basic
741 validation on that regex, and sets the C<Pattern> field for the CF if it
742 is valid.
743
744 =cut
745
746 sub SetPattern {
747     my $self = shift;
748     my $regex = shift;
749
750     my ($ok, $msg) = $self->_IsValidRegex($regex);
751     if ($ok) {
752         return $self->_Set(Field => 'Pattern', Value => $regex);
753     }
754     else {
755         return (0, $self->loc("Invalid pattern: [_1]", $msg));
756     }
757 }
758
759 =head2 _IsValidRegex(Str $regex) returns (Bool $success, Str $msg)
760
761 Tests if the string contains an invalid regex.
762
763 =cut
764
765 sub _IsValidRegex {
766     my $self  = shift;
767     my $regex = shift or return (1, 'valid');
768
769     local $^W; local $@;
770     local $SIG{__DIE__} = sub { 1 };
771     local $SIG{__WARN__} = sub { 1 };
772
773     if (eval { qr/$regex/; 1 }) {
774         return (1, 'valid');
775     }
776
777     my $err = $@;
778     $err =~ s{[,;].*}{};    # strip debug info from error
779     chomp $err;
780     return (0, $err);
781 }
782
783
784 =head2 SingleValue
785
786 Returns true if this CustomField only accepts a single value. 
787 Returns false if it accepts multiple values
788
789 =cut
790
791 sub SingleValue {
792     my $self = shift;
793     if (($self->MaxValues||0) == 1) {
794         return 1;
795     } 
796     else {
797         return undef;
798     }
799 }
800
801 sub UnlimitedValues {
802     my $self = shift;
803     if (($self->MaxValues||0) == 0) {
804         return 1;
805     } 
806     else {
807         return undef;
808     }
809 }
810
811
812 =head2 ACLEquivalenceObjects
813
814 Returns list of objects via which users can get rights on this custom field. For custom fields
815 these objects can be set using L<ContextObject|/"ContextObject and SetContextObject">.
816
817 =cut
818
819 sub ACLEquivalenceObjects {
820     my $self = shift;
821
822     my $ctx = $self->ContextObject
823         or return;
824     return ($ctx, $ctx->ACLEquivalenceObjects);
825 }
826
827 =head2 ContextObject and SetContextObject
828
829 Set or get a context for this object. It can be ticket, queue or another
830 object this CF added to. Used for ACL control, for example
831 SeeCustomField can be granted on queue level to allow people to see all
832 fields added to the queue.
833
834 =cut
835
836 sub SetContextObject {
837     my $self = shift;
838     return $self->{'context_object'} = shift;
839 }
840   
841 sub ContextObject {
842     my $self = shift;
843     return $self->{'context_object'};
844 }
845
846 sub ValidContextType {
847     my $self = shift;
848     my $class = shift;
849
850     my %valid;
851     $valid{$_}++ for split '-', $self->LookupType;
852     delete $valid{'RT::Transaction'};
853
854     return $valid{$class};
855 }
856
857 =head2 LoadContextObject
858
859 Takes an Id for a Context Object and loads the right kind of RT::Object
860 for this particular Custom Field (based on the LookupType) and returns it.
861 This is a good way to ensure you don't try to use a Queue as a Context
862 Object on a User Custom Field.
863
864 =cut
865
866 sub LoadContextObject {
867     my $self = shift;
868     my $type = shift;
869     my $contextid = shift;
870
871     unless ( $self->ValidContextType($type) ) {
872         RT->Logger->debug("Invalid ContextType $type for Custom Field ".$self->Id);
873         return;
874     }
875
876     my $context_object = $type->new( $self->CurrentUser );
877     my ($id, $msg) = $context_object->LoadById( $contextid );
878     unless ( $id ) {
879         RT->Logger->debug("Invalid ContextObject id: $msg");
880         return;
881     }
882     return $context_object;
883 }
884
885 =head2 ValidateContextObject
886
887 Ensure that a given ContextObject applies to this Custom Field.  For
888 custom fields that are assigned to Queues or to Classes, this checks
889 that the Custom Field is actually added to that object.  For Global
890 Custom Fields, it returns true as long as the Object is of the right
891 type, because you may be using your permissions on a given Queue of
892 Class to see a Global CF.  For CFs that are only added globally, you
893 don't need a ContextObject.
894
895 =cut
896
897 sub ValidateContextObject {
898     my $self = shift;
899     my $object = shift;
900
901     return 1 if $self->IsGlobal;
902
903     # global only custom fields don't have objects
904     # that should be used as context objects.
905     return if $self->IsOnlyGlobal;
906
907     # Otherwise, make sure we weren't passed a user object that we're
908     # supposed to treat as a queue.
909     return unless $self->ValidContextType(ref $object);
910
911     # Check that it is added correctly
912     my ($added_to) = grep {ref($_) eq $self->RecordClassFromLookupType} ($object, $object->ACLEquivalenceObjects);
913     return unless $added_to;
914     return $self->IsAdded($added_to->id);
915 }
916
917
918 sub _Set {
919     my $self = shift;
920
921     unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
922         return ( 0, $self->loc('Permission Denied') );
923     }
924     return $self->SUPER::_Set( @_ );
925
926 }
927
928
929
930 =head2 _Value
931
932 Takes the name of a table column.
933 Returns its value as a string, if the user passes an ACL check
934
935 =cut
936
937 sub _Value {
938     my $self  = shift;
939     return undef unless $self->id;
940
941     # we need to do the rights check
942     unless ( $self->CurrentUserHasRight('SeeCustomField') ) {
943         $RT::Logger->debug(
944             "Permission denied. User #". $self->CurrentUser->id
945             ." has no SeeCustomField right on CF #". $self->id
946         );
947         return (undef);
948     }
949     return $self->__Value( @_ );
950 }
951
952
953 =head2 SetDisabled
954
955 Takes a boolean.
956 1 will cause this custom field to no longer be avaialble for objects.
957 0 will re-enable this field.
958
959 =cut
960
961
962 =head2 SetTypeComposite
963
964 Set this custom field's type and maximum values as a composite value
965
966 =cut
967
968 sub SetTypeComposite {
969     my $self = shift;
970     my $composite = shift;
971
972     my $old = $self->TypeComposite;
973
974     my ($type, $max_values) = split(/-/, $composite, 2);
975     if ( $type ne $self->Type ) {
976         my ($status, $msg) = $self->SetType( $type );
977         return ($status, $msg) unless $status;
978     }
979     if ( ($max_values || 0) != ($self->MaxValues || 0) ) {
980         my ($status, $msg) = $self->SetMaxValues( $max_values );
981         return ($status, $msg) unless $status;
982     }
983     my $render = $self->RenderType;
984     if ( $render and not grep { $_ eq $render } $self->RenderTypes ) {
985         # We switched types and our render type is no longer valid, so unset it
986         # and use the default
987         $self->SetRenderType( undef );
988     }
989     return 1, $self->loc(
990         "Type changed from '[_1]' to '[_2]'",
991         $self->FriendlyTypeComposite( $old ),
992         $self->FriendlyTypeComposite( $composite ),
993     );
994 }
995
996 =head2 TypeComposite
997
998 Returns a composite value composed of this object's type and maximum values
999
1000 =cut
1001
1002
1003 sub TypeComposite {
1004     my $self = shift;
1005     return join '-', ($self->Type || ''), ($self->MaxValues || 0);
1006 }
1007
1008 =head2 TypeComposites
1009
1010 Returns an array of all possible composite values for custom fields.
1011
1012 =cut
1013
1014 sub TypeComposites {
1015     my $self = shift;
1016     return grep !/(?:[Tt]ext|Combobox|Date|DateTime)-0/, map { ("$_-1", "$_-0") } $self->Types;
1017 }
1018
1019 =head2 RenderType
1020
1021 Returns the type of form widget to render for this custom field.  Currently
1022 this only affects fields which return true for L</HasRenderTypes>. 
1023
1024 =cut
1025
1026 sub RenderType {
1027     my $self = shift;
1028     return '' unless $self->HasRenderTypes;
1029
1030     return $self->_Value( 'RenderType', @_ )
1031         || $self->DefaultRenderType;
1032 }
1033
1034 =head2 SetRenderType TYPE
1035
1036 Sets this custom field's render type.
1037
1038 =cut
1039
1040 sub SetRenderType {
1041     my $self = shift;
1042     my $type = shift;
1043     return (0, $self->loc("This custom field has no Render Types"))
1044         unless $self->HasRenderTypes;
1045
1046     if ( !$type || $type eq $self->DefaultRenderType ) {
1047         return $self->_Set( Field => 'RenderType', Value => undef, @_ );
1048     }
1049
1050     if ( not grep { $_ eq $type } $self->RenderTypes ) {
1051         return (0, $self->loc("Invalid Render Type for custom field of type [_1]",
1052                                 $self->FriendlyType));
1053     }
1054
1055     # XXX: Remove this restriction once we support lists and cascaded selects
1056     if ( $self->BasedOnObj->id and $type =~ /List/ ) {
1057         return (0, $self->loc("We can't currently render as a List when basing categories on another custom field.  Please use another render type."));
1058     }
1059
1060     return $self->_Set( Field => 'RenderType', Value => $type, @_ );
1061 }
1062
1063 =head2 DefaultRenderType [TYPE COMPOSITE]
1064
1065 Returns the default render type for this custom field's type or the TYPE
1066 COMPOSITE specified as an argument.
1067
1068 =cut
1069
1070 sub DefaultRenderType {
1071     my $self = shift;
1072     my $composite    = @_ ? shift : $self->TypeComposite;
1073     my ($type, $max) = split /-/, $composite, 2;
1074     return unless $type and $self->HasRenderTypes($composite);
1075     return $FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }[0];
1076 }
1077
1078 =head2 HasRenderTypes [TYPE_COMPOSITE]
1079
1080 Returns a boolean value indicating whether the L</RenderTypes> and
1081 L</RenderType> methods make sense for this custom field.
1082
1083 Currently true only for type C<Select>.
1084
1085 =cut
1086
1087 sub HasRenderTypes {
1088     my $self = shift;
1089     my ($type, $max) = split /-/, (@_ ? shift : $self->TypeComposite), 2;
1090     return undef unless $type;
1091     return defined $FieldTypes{$type}->{render_types}
1092         ->{ $max == 1 ? 'single' : 'multiple' };
1093 }
1094
1095 =head2 RenderTypes [TYPE COMPOSITE]
1096
1097 Returns the valid render types for this custom field's type or the TYPE
1098 COMPOSITE specified as an argument.
1099
1100 =cut
1101
1102 sub RenderTypes {
1103     my $self = shift;
1104     my $composite    = @_ ? shift : $self->TypeComposite;
1105     my ($type, $max) = split /-/, $composite, 2;
1106     return unless $type and $self->HasRenderTypes($composite);
1107     return @{$FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }};
1108 }
1109
1110 =head2 SetLookupType
1111
1112 Autrijus: care to doc how LookupTypes work?
1113
1114 =cut
1115
1116 sub SetLookupType {
1117     my $self = shift;
1118     my $lookup = shift;
1119     if ( $lookup ne $self->LookupType ) {
1120         # Okay... We need to invalidate our existing relationships
1121         RT::ObjectCustomField->new($self->CurrentUser)->DeleteAll( CustomField => $self );
1122     }
1123     return $self->_Set(Field => 'LookupType', Value =>$lookup);
1124 }
1125
1126 =head2 LookupTypes
1127
1128 Returns an array of LookupTypes available
1129
1130 =cut
1131
1132
1133 sub LookupTypes {
1134     my $self = shift;
1135     return sort keys %FRIENDLY_LOOKUP_TYPES;
1136 }
1137
1138 =head2 FriendlyLookupType
1139
1140 Returns a localized description of the type of this custom field
1141
1142 =cut
1143
1144 sub FriendlyLookupType {
1145     my $self = shift;
1146     my $lookup = shift || $self->LookupType;
1147
1148     return ($self->loc( $FRIENDLY_LOOKUP_TYPES{$lookup} ))
1149         if defined $FRIENDLY_LOOKUP_TYPES{$lookup};
1150
1151     my @types = map { s/^RT::// ? $self->loc($_) : $_ }
1152       grep { defined and length }
1153       split( /-/, $lookup )
1154       or return;
1155
1156     state $LocStrings = [
1157         "[_1] objects",            # loc
1158         "[_1]'s [_2] objects",        # loc
1159         "[_1]'s [_2]'s [_3] objects",   # loc
1160     ];
1161     return ( $self->loc( $LocStrings->[$#types], @types ) );
1162 }
1163
1164 =head1 RecordClassFromLookupType
1165
1166 Returns the type of Object referred to by ObjectCustomFields' ObjectId column
1167
1168 Optionally takes a LookupType to use instead of using the value on the loaded
1169 record.  In this case, the method may be called on the class instead of an
1170 object.
1171
1172 =cut
1173
1174 sub RecordClassFromLookupType {
1175     my $self = shift;
1176     my $type = shift || $self->LookupType;
1177     my ($class) = ($type =~ /^([^-]+)/);
1178     unless ( $class ) {
1179         if (blessed($self) and $self->LookupType eq $type) {
1180             $RT::Logger->error(
1181                 "Custom Field #". $self->id
1182                 ." has incorrect LookupType '$type'"
1183             );
1184         } else {
1185             RT->Logger->error("Invalid LookupType passed as argument: $type");
1186         }
1187         return undef;
1188     }
1189     return $class;
1190 }
1191
1192 =head1 ObjectTypeFromLookupType
1193
1194 Returns the ObjectType used in ObjectCustomFieldValues rows for this CF
1195
1196 Optionally takes a LookupType to use instead of using the value on the loaded
1197 record.  In this case, the method may be called on the class instead of an
1198 object.
1199
1200 =cut
1201
1202 sub ObjectTypeFromLookupType {
1203     my $self = shift;
1204     my $type = shift || $self->LookupType;
1205     my ($class) = ($type =~ /([^-]+)$/);
1206     unless ( $class ) {
1207         if (blessed($self) and $self->LookupType eq $type) {
1208             $RT::Logger->error(
1209                 "Custom Field #". $self->id
1210                 ." has incorrect LookupType '$type'"
1211             );
1212         } else {
1213             RT->Logger->error("Invalid LookupType passed as argument: $type");
1214         }
1215         return undef;
1216     }
1217     return $class;
1218 }
1219
1220 sub CollectionClassFromLookupType {
1221     my $self = shift;
1222
1223     my $record_class = $self->RecordClassFromLookupType;
1224     return undef unless $record_class;
1225
1226     my $collection_class;
1227     if ( UNIVERSAL::can($record_class.'Collection', 'new') ) {
1228         $collection_class = $record_class.'Collection';
1229     } elsif ( UNIVERSAL::can($record_class.'es', 'new') ) {
1230         $collection_class = $record_class.'es';
1231     } elsif ( UNIVERSAL::can($record_class.'s', 'new') ) {
1232         $collection_class = $record_class.'s';
1233     } else {
1234         $RT::Logger->error("Can not find a collection class for record class '$record_class'");
1235         return undef;
1236     }
1237     return $collection_class;
1238 }
1239
1240 =head2 Groupings
1241
1242 Returns a (sorted and lowercased) list of the groupings in which this custom
1243 field appears.
1244
1245 If called on a loaded object, the returned list is limited to groupings which
1246 apply to the record class this CF applies to (L</RecordClassFromLookupType>).
1247
1248 If passed a loaded object or a class name, the returned list is limited to
1249 groupings which apply to the class of the object or the specified class.
1250
1251 If called on an unloaded object, all potential groupings are returned.
1252
1253 =cut
1254
1255 sub Groupings {
1256     my $self = shift;
1257     my $record_class = $self->_GroupingClass(shift);
1258
1259     my $config = RT->Config->Get('CustomFieldGroupings');
1260        $config = {} unless ref($config) eq 'HASH';
1261
1262     my @groups;
1263     if ( $record_class ) {
1264         push @groups, sort {lc($a) cmp lc($b)} keys %{ $BUILTIN_GROUPINGS{$record_class} || {} };
1265         if ( ref($config->{$record_class} ||= []) eq "ARRAY") {
1266             my @order = @{ $config->{$record_class} };
1267             while (@order) {
1268                 push @groups, shift(@order);
1269                 shift(@order);
1270             }
1271         } else {
1272             @groups = sort {lc($a) cmp lc($b)} keys %{ $config->{$record_class} };
1273         }
1274     } else {
1275         my %all = (%$config, %BUILTIN_GROUPINGS);
1276         @groups = sort {lc($a) cmp lc($b)} map {$self->Groupings($_)} grep {$_} keys(%all);
1277     }
1278
1279     my %seen;
1280     return
1281         grep defined && length && !$seen{lc $_}++,
1282         @groups;
1283 }
1284
1285 =head2 CustomGroupings
1286
1287 Identical to L</Groupings> but filters out built-in groupings from the the
1288 returned list.
1289
1290 =cut
1291
1292 sub CustomGroupings {
1293     my $self = shift;
1294     my $record_class = $self->_GroupingClass(shift);
1295     return grep !$BUILTIN_GROUPINGS{$record_class}{$_}, $self->Groupings( $record_class );
1296 }
1297
1298 sub _GroupingClass {
1299     my $self    = shift;
1300     my $record  = shift;
1301
1302     my $record_class = ref($record) || $record || '';
1303     $record_class = $self->RecordClassFromLookupType
1304         if !$record_class and blessed($self) and $self->id;
1305
1306     return $record_class;
1307 }
1308
1309 =head2 RegisterBuiltInGroupings
1310
1311 Registers groupings to be considered a fundamental part of RT, either via use
1312 in core RT or via an extension.  These groupings must be rendered explicitly in
1313 Mason by specific calls to F</Elements/ShowCustomFields> and
1314 F</Elements/EditCustomFields>.  They will not show up automatically on normal
1315 display pages like configured custom groupings.
1316
1317 Takes a set of key-value pairs of class names (valid L<RT::Record> subclasses)
1318 and array refs of grouping names to consider built-in.
1319
1320 If a class already contains built-in groupings (such as L<RT::Ticket> and
1321 L<RT::User>), new groupings are appended.
1322
1323 =cut
1324
1325 sub RegisterBuiltInGroupings {
1326     my $self = shift;
1327     my %new  = @_;
1328
1329     while (my ($k,$v) = each %new) {
1330         $v = [$v] unless ref($v) eq 'ARRAY';
1331         $BUILTIN_GROUPINGS{$k} = {
1332             %{$BUILTIN_GROUPINGS{$k} || {}},
1333             map { $_ => 1 } @$v
1334         };
1335     }
1336     $BUILTIN_GROUPINGS{''} = { map { %$_ } values %BUILTIN_GROUPINGS  };
1337 }
1338
1339 =head1 IsOnlyGlobal
1340
1341 Certain custom fields (users, groups) should only be added globally;
1342 codify that set here for reference.
1343
1344 =cut
1345
1346 sub IsOnlyGlobal {
1347     my $self = shift;
1348
1349     return ($self->LookupType =~ /^RT::(?:Group|User)/io);
1350
1351 }
1352 sub ApplyGlobally {
1353     RT->Deprecated(
1354         Instead   => "IsOnlyGlobal",
1355         Remove    => "4.4",
1356     );
1357     return shift->IsOnlyGlobal(@_);
1358 }
1359
1360 =head1 AddedTo
1361
1362 Returns collection with objects this custom field is added to.
1363 Class of the collection depends on L</LookupType>.
1364 See all L</NotAddedTo> .
1365
1366 Doesn't takes into account if object is added globally.
1367
1368 =cut
1369
1370 sub AddedTo {
1371     my $self = shift;
1372     return RT::ObjectCustomField->new( $self->CurrentUser )
1373         ->AddedTo( CustomField => $self );
1374 }
1375 sub AppliedTo {
1376     RT->Deprecated(
1377         Instead   => "AddedTo",
1378         Remove    => "4.4",
1379     );
1380     shift->AddedTo(@_);
1381 };
1382
1383 =head1 NotAddedTo
1384
1385 Returns collection with objects this custom field is not added to.
1386 Class of the collection depends on L</LookupType>.
1387 See all L</AddedTo> .
1388
1389 Doesn't take into account if the object is added globally.
1390
1391 =cut
1392
1393 sub NotAddedTo {
1394     my $self = shift;
1395     return RT::ObjectCustomField->new( $self->CurrentUser )
1396         ->NotAddedTo( CustomField => $self );
1397 }
1398 sub NotAppliedTo {
1399     RT->Deprecated(
1400         Instead   => "NotAddedTo",
1401         Remove    => "4.4",
1402     );
1403     shift->NotAddedTo(@_)
1404 };
1405
1406 =head2 IsAdded
1407
1408 Takes object id and returns corresponding L<RT::ObjectCustomField>
1409 record if this custom field is added to the object. Use 0 to check
1410 if custom field is added globally.
1411
1412 =cut
1413
1414 sub IsAdded {
1415     my $self = shift;
1416     my $id = shift;
1417     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
1418     $ocf->LoadByCols( CustomField => $self->id, ObjectId => $id || 0 );
1419     return undef unless $ocf->id;
1420     return $ocf;
1421 }
1422 sub IsApplied {
1423     RT->Deprecated(
1424         Instead   => "IsAdded",
1425         Remove    => "4.4",
1426     );
1427     shift->IsAdded(@_);
1428 };
1429
1430 sub IsGlobal { return shift->IsAdded(0) }
1431
1432 =head2 IsAddedToAny
1433
1434 Returns true if custom field is applied to any object.
1435
1436 =cut
1437
1438 sub IsAddedToAny {
1439     my $self = shift;
1440     my $id = shift;
1441     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
1442     $ocf->LoadByCols( CustomField => $self->id );
1443     return $ocf->id ? 1 : 0;
1444 }
1445
1446 =head2 AddToObject OBJECT
1447
1448 Add this custom field as a custom field for a single object, such as a queue or group.
1449
1450 Takes an object 
1451
1452 =cut
1453
1454 sub AddToObject {
1455     my $self  = shift;
1456     my $object = shift;
1457     my $id = $object->Id || 0;
1458
1459     unless (index($self->LookupType, ref($object)) == 0) {
1460         return ( 0, $self->loc('Lookup type mismatch') );
1461     }
1462
1463     unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
1464         return ( 0, $self->loc('Permission Denied') );
1465     }
1466
1467     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
1468     my ( $oid, $msg ) = $ocf->Add(
1469         CustomField => $self->id, ObjectId => $id,
1470     );
1471     return ( $oid, $msg );
1472 }
1473
1474
1475 =head2 RemoveFromObject OBJECT
1476
1477 Remove this custom field  for a single object, such as a queue or group.
1478
1479 Takes an object 
1480
1481 =cut
1482
1483 sub RemoveFromObject {
1484     my $self = shift;
1485     my $object = shift;
1486     my $id = $object->Id || 0;
1487
1488     unless (index($self->LookupType, ref($object)) == 0) {
1489         return ( 0, $self->loc('Object type mismatch') );
1490     }
1491
1492     unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
1493         return ( 0, $self->loc('Permission Denied') );
1494     }
1495
1496     my $ocf = $self->IsAdded( $id );
1497     unless ( $ocf ) {
1498         return ( 0, $self->loc("This custom field cannot be added to that object") );
1499     }
1500
1501     # XXX: Delete doesn't return anything
1502     my ( $oid, $msg ) = $ocf->Delete;
1503     return ( $oid, $msg );
1504 }
1505
1506
1507 =head2 AddValueForObject HASH
1508
1509 Adds a custom field value for a record object of some kind. 
1510 Takes a param hash of 
1511
1512 Required:
1513
1514     Object
1515     Content
1516
1517 Optional:
1518
1519     LargeContent
1520     ContentType
1521
1522 =cut
1523
1524 sub AddValueForObject {
1525     my $self = shift;
1526     my %args = (
1527         Object       => undef,
1528         Content      => undef,
1529         LargeContent => undef,
1530         ContentType  => undef,
1531         @_
1532     );
1533     my $obj = $args{'Object'} or return ( 0, $self->loc('Invalid object') );
1534
1535     unless ( $self->CurrentUserHasRight('ModifyCustomField') ) {
1536         return ( 0, $self->loc('Permission Denied') );
1537     }
1538
1539     unless ( $self->MatchPattern($args{'Content'}) ) {
1540         return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
1541     }
1542
1543     $RT::Handle->BeginTransaction;
1544
1545     if ( $self->MaxValues ) {
1546         my $current_values = $self->ValuesForObject($obj);
1547         my $extra_values = ( $current_values->Count + 1 ) - $self->MaxValues;
1548
1549         # (The +1 is for the new value we're adding)
1550
1551         # If we have a set of current values and we've gone over the maximum
1552         # allowed number of values, we'll need to delete some to make room.
1553         # which former values are blown away is not guaranteed
1554
1555         while ($extra_values) {
1556             my $extra_item = $current_values->Next;
1557             unless ( $extra_item->id ) {
1558                 $RT::Logger->crit( "We were just asked to delete "
1559                     ."a custom field value that doesn't exist!" );
1560                 $RT::Handle->Rollback();
1561                 return (undef);
1562             }
1563             $extra_item->Delete;
1564             $extra_values--;
1565         }
1566     }
1567
1568     if (my $canonicalizer = $self->can('_CanonicalizeValue'.$self->Type)) {
1569          $canonicalizer->($self, \%args);
1570     }
1571
1572
1573
1574     my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1575     my ($val, $msg) = $newval->Create(
1576         ObjectType   => ref($obj),
1577         ObjectId     => $obj->Id,
1578         Content      => $args{'Content'},
1579         LargeContent => $args{'LargeContent'},
1580         ContentType  => $args{'ContentType'},
1581         CustomField  => $self->Id
1582     );
1583
1584     unless ($val) {
1585         $RT::Handle->Rollback();
1586         return ($val, $self->loc("Couldn't create record: [_1]", $msg));
1587     }
1588
1589     $RT::Handle->Commit();
1590     return ($val);
1591
1592 }
1593
1594
1595
1596 sub _CanonicalizeValueDateTime {
1597     my $self    = shift;
1598     my $args    = shift;
1599     my $DateObj = RT::Date->new( $self->CurrentUser );
1600     $DateObj->Set( Format => 'unknown',
1601                    Value  => $args->{'Content'} );
1602     $args->{'Content'} = $DateObj->ISO;
1603 }
1604
1605 # For date, we need to store Content as ISO date
1606 sub _CanonicalizeValueDate {
1607     my $self = shift;
1608     my $args = shift;
1609
1610     # in case user input date with time, let's omit it by setting timezone
1611     # to utc so "hour" won't affect "day"
1612     my $DateObj = RT::Date->new( $self->CurrentUser );
1613     $DateObj->Set( Format   => 'unknown',
1614                    Value    => $args->{'Content'},
1615                  );
1616     $args->{'Content'} = $DateObj->Date( Timezone => 'user' );
1617 }
1618
1619 =head2 MatchPattern STRING
1620
1621 Tests the incoming string against the Pattern of this custom field object
1622 and returns a boolean; returns true if the Pattern is empty.
1623
1624 =cut
1625
1626 sub MatchPattern {
1627     my $self = shift;
1628     my $regex = $self->Pattern or return 1;
1629
1630     return (( defined $_[0] ? $_[0] : '') =~ $regex);
1631 }
1632
1633
1634
1635
1636 =head2 FriendlyPattern
1637
1638 Prettify the pattern of this custom field, by taking the text in C<(?#text)>
1639 and localizing it.
1640
1641 =cut
1642
1643 sub FriendlyPattern {
1644     my $self = shift;
1645     my $regex = $self->Pattern;
1646
1647     return '' unless length $regex;
1648     if ( $regex =~ /\(\?#([^)]*)\)/ ) {
1649         return '[' . $self->loc($1) . ']';
1650     }
1651     else {
1652         return $regex;
1653     }
1654 }
1655
1656
1657
1658
1659 =head2 DeleteValueForObject HASH
1660
1661 Deletes a custom field value for a ticket. Takes a param hash of Object and Content
1662
1663 Returns a tuple of (STATUS, MESSAGE). If the call succeeded, the STATUS is true. otherwise it's false
1664
1665 =cut
1666
1667 sub DeleteValueForObject {
1668     my $self = shift;
1669     my %args = ( Object => undef,
1670                  Content => undef,
1671                  Id => undef,
1672              @_ );
1673
1674
1675     unless ($self->CurrentUserHasRight('ModifyCustomField')) {
1676         return (0, $self->loc('Permission Denied'));
1677     }
1678
1679     my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser);
1680
1681     if (my $id = $args{'Id'}) {
1682         $oldval->Load($id);
1683     }
1684     unless ($oldval->id) { 
1685         $oldval->LoadByObjectContentAndCustomField(
1686             Object => $args{'Object'}, 
1687             Content =>  $args{'Content'}, 
1688             CustomField => $self->Id,
1689         );
1690     }
1691
1692
1693     # check to make sure we found it
1694     unless ($oldval->Id) {
1695         return(0, $self->loc("Custom field value [_1] could not be found for custom field [_2]", $args{'Content'}, $self->Name));
1696     }
1697
1698     # for single-value fields, we need to validate that empty string is a valid value for it
1699     if ( $self->SingleValue and not $self->MatchPattern( '' ) ) {
1700         return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
1701     }
1702
1703     # delete it
1704
1705     my $ret = $oldval->Delete();
1706     unless ($ret) {
1707         return(0, $self->loc("Custom field value could not be found"));
1708     }
1709     return($oldval->Id, $self->loc("Custom field value deleted"));
1710 }
1711
1712
1713 =head2 ValuesForObject OBJECT
1714
1715 Return an L<RT::ObjectCustomFieldValues> object containing all of this custom field's values for OBJECT 
1716
1717 =cut
1718
1719 sub ValuesForObject {
1720     my $self = shift;
1721     my $object = shift;
1722
1723     my $values = RT::ObjectCustomFieldValues->new($self->CurrentUser);
1724     unless ($self->id and $self->CurrentUserHasRight('SeeCustomField')) {
1725         # Return an empty object if they have no rights to see
1726         $values->Limit( FIELD => "id", VALUE => 0, SUBCLAUSE => "ACL" );
1727         return ($values);
1728     }
1729
1730     $values->LimitToCustomField($self->Id);
1731     $values->LimitToObject($object);
1732
1733     return ($values);
1734 }
1735
1736
1737 =head2 RegisterLookupType LOOKUPTYPE FRIENDLYNAME
1738
1739 Tell RT that a certain object accepts custom fields via a lookup type and
1740 provide a friendly name for such CFs.
1741
1742 Examples:
1743
1744     'RT::Queue-RT::Ticket'                 => "Tickets",                # loc
1745     'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions",    # loc
1746     'RT::User'                             => "Users",                  # loc
1747     'RT::Group'                            => "Groups",                 # loc
1748     'RT::Queue'                            => "Queues",                 # loc
1749
1750 This is a class method. 
1751
1752 =cut
1753
1754 sub RegisterLookupType {
1755     my $self = shift;
1756     my $path = shift;
1757     my $friendly_name = shift;
1758
1759     $FRIENDLY_LOOKUP_TYPES{$path} = $friendly_name;
1760 }
1761
1762 sub _ForObjectType {
1763     RT->Deprecated(
1764         Instead => 'RegisterLookupType',
1765         Remove  => '4.4',
1766     );
1767     my $self = shift;
1768     $self->RegisterLookupType(@_);
1769 }
1770
1771
1772 =head2 IncludeContentForValue [VALUE] (and SetIncludeContentForValue)
1773
1774 Gets or sets the  C<IncludeContentForValue> for this custom field. RT
1775 uses this field to automatically include content into the user's browser
1776 as they display records with custom fields in RT.
1777
1778 =cut
1779
1780 sub SetIncludeContentForValue {
1781     shift->IncludeContentForValue(@_);
1782 }
1783 sub IncludeContentForValue{
1784     my $self = shift;
1785     $self->_URLTemplate('IncludeContentForValue', @_);
1786 }
1787
1788
1789
1790 =head2 LinkValueTo [VALUE] (and SetLinkValueTo)
1791
1792 Gets or sets the  C<LinkValueTo> for this custom field. RT
1793 uses this field to make custom field values into hyperlinks in the user's
1794 browser as they display records with custom fields in RT.
1795
1796 =cut
1797
1798
1799 sub SetLinkValueTo {
1800     shift->LinkValueTo(@_);
1801 }
1802
1803 sub LinkValueTo {
1804     my $self = shift;
1805     $self->_URLTemplate('LinkValueTo', @_);
1806
1807 }
1808
1809
1810 =head2 _URLTemplate  NAME [VALUE]
1811
1812 With one argument, returns the _URLTemplate named C<NAME>, but only if
1813 the current user has the right to see this custom field.
1814
1815 With two arguments, attemptes to set the relevant template value.
1816
1817 =cut
1818
1819 sub _URLTemplate {
1820     my $self          = shift;
1821     my $template_name = shift;
1822     if (@_) {
1823
1824         my $value = shift;
1825         unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
1826             return ( 0, $self->loc('Permission Denied') );
1827         }
1828         $self->SetAttribute( Name => $template_name, Content => $value );
1829         return ( 1, $self->loc('Updated') );
1830     } else {
1831         unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) {
1832             return (undef);
1833         }
1834
1835         my @attr = $self->Attributes->Named($template_name);
1836         my $attr = shift @attr;
1837
1838         if ($attr) { return $attr->Content }
1839
1840     }
1841 }
1842
1843 sub SetBasedOn {
1844     my $self = shift;
1845     my $value = shift;
1846
1847     return $self->_Set( Field => 'BasedOn', Value => $value, @_ )
1848         unless defined $value and length $value;
1849
1850     my $cf = RT::CustomField->new( $self->CurrentUser );
1851     $cf->SetContextObject( $self->ContextObject );
1852     $cf->Load( ref $value ? $value->id : $value );
1853
1854     return (0, "Permission Denied")
1855         unless $cf->id && $cf->CurrentUserHasRight('SeeCustomField');
1856
1857     # XXX: Remove this restriction once we support lists and cascaded selects
1858     if ( $self->RenderType =~ /List/ ) {
1859         return (0, $self->loc("We can't currently render as a List when basing categories on another custom field.  Please use another render type."));
1860     }
1861
1862     return $self->_Set( Field => 'BasedOn', Value => $value, @_ )
1863 }
1864
1865 sub BasedOnObj {
1866     my $self = shift;
1867
1868     my $obj = RT::CustomField->new( $self->CurrentUser );
1869     $obj->SetContextObject( $self->ContextObject );
1870     if ( $self->BasedOn ) {
1871         $obj->Load( $self->BasedOn );
1872     }
1873     return $obj;
1874 }
1875
1876
1877
1878
1879
1880
1881 =head2 id
1882
1883 Returns the current value of id. 
1884 (In the database, id is stored as int(11).)
1885
1886
1887 =cut
1888
1889
1890 =head2 Name
1891
1892 Returns the current value of Name. 
1893 (In the database, Name is stored as varchar(200).)
1894
1895
1896
1897 =head2 SetName VALUE
1898
1899
1900 Set Name to VALUE. 
1901 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1902 (In the database, Name will be stored as a varchar(200).)
1903
1904
1905 =cut
1906
1907
1908 =head2 Type
1909
1910 Returns the current value of Type. 
1911 (In the database, Type is stored as varchar(200).)
1912
1913
1914
1915 =head2 SetType VALUE
1916
1917
1918 Set Type to VALUE. 
1919 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1920 (In the database, Type will be stored as a varchar(200).)
1921
1922
1923 =cut
1924
1925
1926 =head2 RenderType
1927
1928 Returns the current value of RenderType. 
1929 (In the database, RenderType is stored as varchar(64).)
1930
1931
1932
1933 =head2 SetRenderType VALUE
1934
1935
1936 Set RenderType to VALUE. 
1937 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1938 (In the database, RenderType will be stored as a varchar(64).)
1939
1940
1941 =cut
1942
1943
1944 =head2 MaxValues
1945
1946 Returns the current value of MaxValues. 
1947 (In the database, MaxValues is stored as int(11).)
1948
1949
1950
1951 =head2 SetMaxValues VALUE
1952
1953
1954 Set MaxValues to VALUE. 
1955 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1956 (In the database, MaxValues will be stored as a int(11).)
1957
1958
1959 =cut
1960
1961
1962 =head2 Pattern
1963
1964 Returns the current value of Pattern. 
1965 (In the database, Pattern is stored as text.)
1966
1967
1968
1969 =head2 SetPattern VALUE
1970
1971
1972 Set Pattern to VALUE. 
1973 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1974 (In the database, Pattern will be stored as a text.)
1975
1976
1977 =cut
1978
1979
1980 =head2 BasedOn
1981
1982 Returns the current value of BasedOn. 
1983 (In the database, BasedOn is stored as int(11).)
1984
1985
1986
1987 =head2 SetBasedOn VALUE
1988
1989
1990 Set BasedOn to VALUE. 
1991 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1992 (In the database, BasedOn will be stored as a int(11).)
1993
1994
1995 =cut
1996
1997
1998 =head2 Description
1999
2000 Returns the current value of Description. 
2001 (In the database, Description is stored as varchar(255).)
2002
2003
2004
2005 =head2 SetDescription VALUE
2006
2007
2008 Set Description to VALUE. 
2009 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2010 (In the database, Description will be stored as a varchar(255).)
2011
2012
2013 =cut
2014
2015
2016 =head2 SortOrder
2017
2018 Returns the current value of SortOrder. 
2019 (In the database, SortOrder is stored as int(11).)
2020
2021
2022
2023 =head2 SetSortOrder VALUE
2024
2025
2026 Set SortOrder to VALUE. 
2027 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2028 (In the database, SortOrder will be stored as a int(11).)
2029
2030
2031 =cut
2032
2033
2034 =head2 LookupType
2035
2036 Returns the current value of LookupType. 
2037 (In the database, LookupType is stored as varchar(255).)
2038
2039
2040
2041 =head2 SetLookupType VALUE
2042
2043
2044 Set LookupType to VALUE. 
2045 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2046 (In the database, LookupType will be stored as a varchar(255).)
2047
2048
2049 =cut
2050
2051
2052 =head2 Creator
2053
2054 Returns the current value of Creator. 
2055 (In the database, Creator is stored as int(11).)
2056
2057
2058 =cut
2059
2060
2061 =head2 Created
2062
2063 Returns the current value of Created. 
2064 (In the database, Created is stored as datetime.)
2065
2066
2067 =cut
2068
2069
2070 =head2 LastUpdatedBy
2071
2072 Returns the current value of LastUpdatedBy. 
2073 (In the database, LastUpdatedBy is stored as int(11).)
2074
2075
2076 =cut
2077
2078
2079 =head2 LastUpdated
2080
2081 Returns the current value of LastUpdated. 
2082 (In the database, LastUpdated is stored as datetime.)
2083
2084
2085 =cut
2086
2087
2088 =head2 Disabled
2089
2090 Returns the current value of Disabled. 
2091 (In the database, Disabled is stored as smallint(6).)
2092
2093
2094
2095 =head2 SetDisabled VALUE
2096
2097
2098 Set Disabled to VALUE. 
2099 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2100 (In the database, Disabled will be stored as a smallint(6).)
2101
2102
2103 =cut
2104
2105
2106
2107 sub _CoreAccessible {
2108     {
2109      
2110         id =>
2111         {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
2112         Name => 
2113         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2114         Type => 
2115         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2116         RenderType => 
2117         {read => 1, write => 1, sql_type => 12, length => 64,  is_blob => 0,  is_numeric => 0,  type => 'varchar(64)', default => ''},
2118         MaxValues => 
2119         {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
2120         Pattern => 
2121         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2122         ValuesClass => 
2123         {read => 1, write => 1, sql_type => 12, length => 64,  is_blob => 0,  is_numeric => 0,  type => 'varchar(64)', default => ''},
2124         BasedOn => 
2125         {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
2126         Description => 
2127         {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
2128         SortOrder => 
2129         {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2130         LookupType => 
2131         {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
2132         Creator => 
2133         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2134         Created => 
2135         {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
2136         LastUpdatedBy => 
2137         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2138         LastUpdated => 
2139         {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
2140         Disabled => 
2141         {read => 1, write => 1, sql_type => 5, length => 6,  is_blob => 0,  is_numeric => 1,  type => 'smallint(6)', default => '0'},
2142
2143  }
2144 };
2145
2146 sub FindDependencies {
2147     my $self = shift;
2148     my ($walker, $deps) = @_;
2149
2150     $self->SUPER::FindDependencies($walker, $deps);
2151
2152     $deps->Add( out => $self->BasedOnObj )
2153         if $self->BasedOnObj->id;
2154
2155     my $applied = RT::ObjectCustomFields->new( $self->CurrentUser );
2156     $applied->LimitToCustomField( $self->id );
2157     $deps->Add( in => $applied );
2158
2159     $deps->Add( in => $self->Values ) if $self->ValuesClass eq "RT::CustomFieldValues";
2160 }
2161
2162
2163 RT::Base->_ImportOverlays();
2164
2165 1;