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