+=head2 SetTypeComposite
+
+Set this custom field's type and maximum values as a composite value
+
+=cut
+
+sub SetTypeComposite {
+ my $self = shift;
+ my $composite = shift;
+
+ my $old = $self->TypeComposite;
+
+ my ($type, $max_values) = split(/-/, $composite, 2);
+ if ( $type ne $self->Type ) {
+ my ($status, $msg) = $self->SetType( $type );
+ return ($status, $msg) unless $status;
+ }
+ if ( ($max_values || 0) != ($self->MaxValues || 0) ) {
+ my ($status, $msg) = $self->SetMaxValues( $max_values );
+ return ($status, $msg) unless $status;
+ }
+ return 1, $self->loc(
+ "Type changed from '[_1]' to '[_2]'",
+ $self->FriendlyTypeComposite( $old ),
+ $self->FriendlyTypeComposite( $composite ),
+ );
+}
+
+=head2 TypeComposite
+
+Returns a composite value composed of this object's type and maximum values
+
+=cut
+
+
+sub TypeComposite {
+ my $self = shift;
+ return join '-', ($self->Type || ''), ($self->MaxValues || 0);
+}
+
+=head2 TypeComposites
+
+Returns an array of all possible composite values for custom fields.
+
+=cut
+
+sub TypeComposites {
+ my $self = shift;
+ return grep !/(?:[Tt]ext|Combobox)-0/, map { ("$_-1", "$_-0") } $self->Types;
+}
+
+=head2 SetLookupType
+
+Autrijus: care to doc how LookupTypes work?
+
+=cut
+
+sub SetLookupType {
+ my $self = shift;
+ my $lookup = shift;
+ if ( $lookup ne $self->LookupType ) {
+ # Okay... We need to invalidate our existing relationships
+ my $ObjectCustomFields = RT::ObjectCustomFields->new($self->CurrentUser);
+ $ObjectCustomFields->LimitToCustomField($self->Id);
+ $_->Delete foreach @{$ObjectCustomFields->ItemsArrayRef};
+ }
+ return $self->SUPER::SetLookupType($lookup);
+}
+
+=head2 LookupTypes
+
+Returns an array of LookupTypes available
+
+=cut
+
+
+sub LookupTypes {
+ my $self = shift;
+ return keys %FRIENDLY_OBJECT_TYPES;
+}
+
+my @FriendlyObjectTypes = (
+ "[_1] objects", # loc
+ "[_1]'s [_2] objects", # loc
+ "[_1]'s [_2]'s [_3] objects", # loc
+);
+
+=head2 FriendlyLookupType
+
+Returns a localized description of the type of this custom field
+
+=cut
+
+sub FriendlyLookupType {
+ my $self = shift;
+ my $lookup = shift || $self->LookupType;
+
+ return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} ))
+ if (defined $FRIENDLY_OBJECT_TYPES{$lookup} );
+
+ my @types = map { s/^RT::// ? $self->loc($_) : $_ }
+ grep { defined and length }
+ split( /-/, $lookup )
+ or return;
+ return ( $self->loc( $FriendlyObjectTypes[$#types], @types ) );
+}
+
+sub RecordClassFromLookupType {
+ my $self = shift;
+ my ($class) = ($self->LookupType =~ /^([^-]+)/);
+ unless ( $class ) {
+ $RT::Logger->error(
+ "Custom Field #". $self->id
+ ." has incorrect LookupType '". $self->LookupType ."'"
+ );
+ return undef;
+ }
+ return $class;
+}
+
+sub CollectionClassFromLookupType {
+ my $self = shift;
+
+ my $record_class = $self->RecordClassFromLookupType;
+ return undef unless $record_class;
+
+ my $collection_class;
+ if ( UNIVERSAL::can($record_class.'Collection', 'new') ) {
+ $collection_class = $record_class.'Collection';
+ } elsif ( UNIVERSAL::can($record_class.'es', 'new') ) {
+ $collection_class = $record_class.'es';
+ } elsif ( UNIVERSAL::can($record_class.'s', 'new') ) {
+ $collection_class = $record_class.'s';
+ } else {
+ $RT::Logger->error("Can not find a collection class for record class '$record_class'");
+ return undef;
+ }
+ return $collection_class;
+}
+
+=head1 AppliedTo
+
+Returns collection with objects this custom field is applied to.
+Class of the collection depends on L</LookupType>.
+See all L</NotAppliedTo> .
+
+Doesn't takes into account if object is applied globally.
+
+=cut
+
+sub AppliedTo {
+ my $self = shift;
+
+ my ($res, $ocfs_alias) = $self->_AppliedTo;
+ return $res unless $res;
+
+ $res->Limit(
+ ALIAS => $ocfs_alias,
+ FIELD => 'id',
+ OPERATOR => 'IS NOT',
+ VALUE => 'NULL',
+ );
+
+ return $res;
+}
+
+=head1 NotAppliedTo
+
+Returns collection with objects this custom field is not applied to.
+Class of the collection depends on L</LookupType>.
+See all L</AppliedTo> .
+
+Doesn't takes into account if object is applied globally.
+
+=cut
+
+sub NotAppliedTo {
+ my $self = shift;
+
+ my ($res, $ocfs_alias) = $self->_AppliedTo;
+ return $res unless $res;
+
+ $res->Limit(
+ ALIAS => $ocfs_alias,
+ FIELD => 'id',
+ OPERATOR => 'IS',
+ VALUE => 'NULL',
+ );
+
+ return $res;
+}
+
+sub _AppliedTo {
+ my $self = shift;
+
+ my ($class) = $self->CollectionClassFromLookupType;
+ return undef unless $class;
+
+ my $res = $class->new( $self->CurrentUser );
+
+ # If CF is a Group CF, only display user-defined groups
+ if ( $class eq 'RT::Groups' ) {
+ $res->LimitToUserDefinedGroups;
+ }
+
+ $res->OrderBy( FIELD => 'Name' );
+ my $ocfs_alias = $res->Join(
+ TYPE => 'LEFT',
+ ALIAS1 => 'main',
+ FIELD1 => 'id',
+ TABLE2 => 'ObjectCustomFields',
+ FIELD2 => 'ObjectId',
+ );
+ $res->Limit(
+ LEFTJOIN => $ocfs_alias,
+ ALIAS => $ocfs_alias,
+ FIELD => 'CustomField',
+ VALUE => $self->id,
+ );
+ return ($res, $ocfs_alias);
+}
+
+=head2 IsApplied
+
+Takes object id and returns corresponding L<RT::ObjectCustomField>
+record if this custom field is applied to the object. Use 0 to check
+if custom field is applied globally.
+
+=cut
+
+sub IsApplied {
+ my $self = shift;
+ my $id = shift;
+ my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
+ $ocf->LoadByCols( CustomField => $self->id, ObjectId => $id || 0 );
+ return undef unless $ocf->id;
+ return $ocf;
+}
+
+=head2 AddToObject OBJECT
+
+Add this custom field as a custom field for a single object, such as a queue or group.
+
+Takes an object
+
+=cut
+
+
+sub AddToObject {
+ my $self = shift;
+ my $object = shift;
+ my $id = $object->Id || 0;
+
+ unless (index($self->LookupType, ref($object)) == 0) {
+ return ( 0, $self->loc('Lookup type mismatch') );
+ }
+
+ unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+
+ if ( $self->IsApplied( $id ) ) {
+ return ( 0, $self->loc("Custom field is already applied to the object") );
+ }
+
+ if ( $id ) {
+ # applying locally
+ return (0, $self->loc("Couldn't apply custom field to an object as it's global already") )
+ if $self->IsApplied( 0 );
+ }
+ else {
+ my $applied = RT::ObjectCustomFields->new( $self->CurrentUser );
+ $applied->LimitToCustomField( $self->id );
+ while ( my $record = $applied->Next ) {
+ $record->Delete;
+ }
+ }
+
+ my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
+ my ( $oid, $msg ) = $ocf->Create(
+ ObjectId => $id, CustomField => $self->id,
+ );
+ return ( $oid, $msg );
+}
+
+
+=head2 RemoveFromObject OBJECT
+
+Remove this custom field for a single object, such as a queue or group.
+
+Takes an object
+
+=cut
+
+sub RemoveFromObject {
+ my $self = shift;
+ my $object = shift;
+ my $id = $object->Id || 0;
+
+ unless (index($self->LookupType, ref($object)) == 0) {
+ return ( 0, $self->loc('Object type mismatch') );
+ }
+
+ unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+
+ my $ocf = $self->IsApplied( $id );
+ unless ( $ocf ) {
+ return ( 0, $self->loc("This custom field does not apply to that object") );
+ }
+
+ # XXX: Delete doesn't return anything
+ my ( $oid, $msg ) = $ocf->Delete;
+ return ( $oid, $msg );
+}
+
+# {{{ AddValueForObject
+
+=head2 AddValueForObject HASH
+
+Adds a custom field value for a record object of some kind.
+Takes a param hash of
+
+Required:
+
+ Object
+ Content
+
+Optional:
+
+ LargeContent
+ ContentType
+
+=cut
+
+sub AddValueForObject {
+ my $self = shift;
+ my %args = (
+ Object => undef,
+ Content => undef,
+ LargeContent => undef,
+ ContentType => undef,
+ @_
+ );
+ my $obj = $args{'Object'} or return ( 0, $self->loc('Invalid object') );
+
+ unless ( $self->CurrentUserHasRight('ModifyCustomField') ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+
+ unless ( $self->MatchPattern($args{'Content'}) ) {
+ return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
+ }
+
+ $RT::Handle->BeginTransaction;
+
+ if ( $self->MaxValues ) {
+ my $current_values = $self->ValuesForObject($obj);
+ my $extra_values = ( $current_values->Count + 1 ) - $self->MaxValues;
+
+ # (The +1 is for the new value we're adding)
+
+ # If we have a set of current values and we've gone over the maximum
+ # allowed number of values, we'll need to delete some to make room.
+ # which former values are blown away is not guaranteed
+
+ while ($extra_values) {
+ my $extra_item = $current_values->Next;
+ unless ( $extra_item->id ) {
+ $RT::Logger->crit( "We were just asked to delete "
+ ."a custom field value that doesn't exist!" );
+ $RT::Handle->Rollback();
+ return (undef);
+ }
+ $extra_item->Delete;
+ $extra_values--;
+ }
+ }
+ my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
+ my $val = $newval->Create(
+ ObjectType => ref($obj),
+ ObjectId => $obj->Id,
+ Content => $args{'Content'},
+ LargeContent => $args{'LargeContent'},
+ ContentType => $args{'ContentType'},
+ CustomField => $self->Id
+ );
+
+ unless ($val) {
+ $RT::Handle->Rollback();
+ return ($val, $self->loc("Couldn't create record"));
+ }
+
+ $RT::Handle->Commit();
+ return ($val);
+
+}
+
+# }}}
+
+# {{{ MatchPattern
+
+=head2 MatchPattern STRING
+
+Tests the incoming string against the Pattern of this custom field object
+and returns a boolean; returns true if the Pattern is empty.
+
+=cut
+
+sub MatchPattern {
+ my $self = shift;
+ my $regex = $self->Pattern or return 1;
+
+ return (( defined $_[0] ? $_[0] : '') =~ $regex);
+}
+
+
+# }}}
+
+# {{{ FriendlyPattern
+
+=head2 FriendlyPattern
+
+Prettify the pattern of this custom field, by taking the text in C<(?#text)>
+and localizing it.
+
+=cut
+
+sub FriendlyPattern {
+ my $self = shift;
+ my $regex = $self->Pattern;
+
+ return '' unless length $regex;
+ if ( $regex =~ /\(\?#([^)]*)\)/ ) {
+ return '[' . $self->loc($1) . ']';
+ }
+ else {
+ return $regex;
+ }
+}
+
+
+# }}}
+
+# {{{ DeleteValueForObject
+
+=head2 DeleteValueForObject HASH
+
+Deletes a custom field value for a ticket. Takes a param hash of Object and Content
+
+Returns a tuple of (STATUS, MESSAGE). If the call succeeded, the STATUS is true. otherwise it's false
+
+=cut
+
+sub DeleteValueForObject {
+ my $self = shift;
+ my %args = ( Object => undef,
+ Content => undef,
+ Id => undef,
+ @_ );
+
+
+ unless ($self->CurrentUserHasRight('ModifyCustomField')) {
+ return (0, $self->loc('Permission Denied'));
+ }
+
+ my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser);
+
+ if (my $id = $args{'Id'}) {
+ $oldval->Load($id);
+ }
+ unless ($oldval->id) {
+ $oldval->LoadByObjectContentAndCustomField(
+ Object => $args{'Object'},
+ Content => $args{'Content'},
+ CustomField => $self->Id,
+ );
+ }
+
+
+ # check to make sure we found it
+ unless ($oldval->Id) {
+ return(0, $self->loc("Custom field value [_1] could not be found for custom field [_2]", $args{'Content'}, $self->Name));
+ }
+
+ # for single-value fields, we need to validate that empty string is a valid value for it
+ if ( $self->SingleValue and not $self->MatchPattern( '' ) ) {
+ return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
+ }
+
+ # delete it
+
+ my $ret = $oldval->Delete();
+ unless ($ret) {
+ return(0, $self->loc("Custom field value could not be found"));
+ }
+ return($oldval->Id, $self->loc("Custom field value deleted"));
+}
+
+
+=head2 ValuesForObject OBJECT
+
+Return an L<RT::ObjectCustomFieldValues> object containing all of this custom field's values for OBJECT
+
+=cut
+
+sub ValuesForObject {
+ my $self = shift;
+ my $object = shift;
+
+ my $values = new RT::ObjectCustomFieldValues($self->CurrentUser);
+ unless ($self->CurrentUserHasRight('SeeCustomField')) {
+ # Return an empty object if they have no rights to see
+ return ($values);
+ }
+
+
+ $values->LimitToCustomField($self->Id);
+ $values->LimitToEnabled();
+ $values->LimitToObject($object);
+
+ return ($values);
+}
+
+
+=head2 _ForObjectType PATH FRIENDLYNAME
+
+Tell RT that a certain object accepts custom fields
+
+Examples:
+
+ 'RT::Queue-RT::Ticket' => "Tickets", # loc
+ 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", # loc
+ 'RT::User' => "Users", # loc
+ 'RT::Group' => "Groups", # loc
+
+This is a class method.
+
+=cut
+
+sub _ForObjectType {
+ my $self = shift;
+ my $path = shift;
+ my $friendly_name = shift;
+
+ $FRIENDLY_OBJECT_TYPES{$path} = $friendly_name;
+
+}
+
+
+=head2 IncludeContentForValue [VALUE] (and SetIncludeContentForValue)
+
+Gets or sets the C<IncludeContentForValue> for this custom field. RT
+uses this field to automatically include content into the user's browser
+as they display records with custom fields in RT.
+
+=cut
+
+sub SetIncludeContentForValue {
+ shift->IncludeContentForValue(@_);
+}
+sub IncludeContentForValue{
+ my $self = shift;
+ $self->_URLTemplate('IncludeContentForValue', @_);
+}
+
+
+
+=head2 LinkValueTo [VALUE] (and SetLinkValueTo)
+
+Gets or sets the C<LinkValueTo> for this custom field. RT
+uses this field to make custom field values into hyperlinks in the user's
+browser as they display records with custom fields in RT.
+
+=cut
+
+
+sub SetLinkValueTo {
+ shift->LinkValueTo(@_);
+}
+
+sub LinkValueTo {
+ my $self = shift;
+ $self->_URLTemplate('LinkValueTo', @_);
+
+}
+
+
+=head2 _URLTemplate NAME [VALUE]
+
+With one argument, returns the _URLTemplate named C<NAME>, but only if
+the current user has the right to see this custom field.
+
+With two arguments, attemptes to set the relevant template value.
+
+=cut
+
+sub _URLTemplate {
+ my $self = shift;
+ my $template_name = shift;
+ if (@_) {
+
+ my $value = shift;
+ unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+ $self->SetAttribute( Name => $template_name, Content => $value );
+ return ( 1, $self->loc('Updated') );
+ } else {
+ unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) {
+ return (undef);
+ }
+
+ my @attr = $self->Attributes->Named($template_name);
+ my $attr = shift @attr;
+
+ if ($attr) { return $attr->Content }
+
+ }
+}
+
+sub SetBasedOn {
+ my $self = shift;
+ my $value = shift;
+
+ return $self->DeleteAttribute( "BasedOn" )
+ unless defined $value and length $value;
+
+ my $cf = RT::CustomField->new( $self->CurrentUser );
+ $cf->Load( ref $value ? $value->Id : $value );
+
+ return (0, "Permission denied")
+ unless $cf->Id && $cf->CurrentUserHasRight('SeeCustomField');
+
+ return $self->AddAttribute(
+ Name => "BasedOn",
+ Description => "Custom field whose CF we depend on",
+ Content => $cf->Id,
+ );
+}
+
+sub BasedOnObj {
+ my $self = shift;
+ my $obj = RT::CustomField->new( $self->CurrentUser );
+
+ my $attribute = $self->FirstAttribute("BasedOn");
+ $obj->Load($attribute->Content) if defined $attribute;
+ return $obj;
+}
+