view release on metacpan or  search on metacpan

lib/DS/TypeSpec.pm  view on Meta::CPAN

        $field = new DS::TypeSpec::Field( $field );
    }
    assert($field->isa('DS::TypeSpec::Field'));
    if( $self->{fields}->{ $field->{name} } ) {
        croak("Can't add field to data stream type spec, since another field with the same name already exists");
    } else {
        $self->{fields}->{ $field->{name} } = $field;
    }
}

sub remove_fields {
    my( $self, $fields ) = @_;
    
    foreach my $field (@$fields) {
        $self->remove_field( $field );
    }
}

sub remove_field {
    my( $self, $field ) = @_;
    
    my $field_name;
    if( not ref($field) eq '' ) {
        should($field->isa, 'DS::TypeSpec::Field');
        $field_name = $field->{name};
    } else {
        $field_name = $field;
    }
    if( not $self->{fields}->{ $field->{name} } ) {
        croak("Can't remove field from data stream type spec - name not recognized. The name is $field_name, but I only have " . join(", ", keys %{$self->{fields}}));
    } else {
        delete $self->{fields}->{ $field->{name} };
    }
}

sub fields {
    my( $self, $fields ) = @_;
    
    my $result = 1;
    if( $fields ) {
        should(ref($fields), 'ARRAY');
        my %remove_fields = ( %{$self->{fields}} );
        foreach my $field ( @$fields ) {
            if( $self->{fields}->{$field} ) {
                $self->add_field( $field );
                delete $remove_fields{ $field };
            }
        }
        $self->{fields} = $fields;
    } else {
        $result = $self->{fields};
    }
    return $result;
}

sub field_names {
    my( $self, $fields ) = @_;
    return keys %{$self->{fields}};
}    

sub keys_locked {
    my( $self, $keys_locked ) = @_;

    my $result = 1;
    if( $keys_locked ) {
       $self->{keys_locked} = $keys_locked ? 1 : 0;
    } else {
        $keys_locked = $self->{keys_locked};
    }
    return $result;
}

sub values_readonly {
    my( $self, $values_readonly ) = @_;

    my $result = 1;
    if( $values_readonly ) {
       $self->{values_readonly} = $values_readonly ? 1 : 0;
    } else {
        $values_readonly = $self->{values_readonly};
    }
    return $result;
}

sub contains {
    my( $self, $other ) = @_;

    my $result;

    if( $other->isa('DS::TypeSpec::Any') ) {
        $result = 1;
    } else {
        # This is equivalent to the subset operator in mathematics
        # For all of the $other fields
        $result = all { 
            my $other = $_;
            # There must be one key with the same name
            any { $_ eq $other } keys %{$self->{fields}}; 
        } keys %{$other->{fields}};
    }
    
    return $result;
}

sub project {
    my( $self, $arg1, $arg2 ) = @_;

    my $name = '';
    my $new_fields;
    if( $arg1 ) {
        if( ref( $arg1 ) eq '' ) {
            $name = $arg1;
            if( $arg2 ) {
                $new_fields = $arg2;
            } 
        } else {
           $new_fields = $arg1;
        }
    }

#    if( ref( $fields ) eq 'ARRAY' ) {
#        my $new_fields = {};
#        foreach my $field ( @$fields ) {
#            $new_fields->{$field} = 1;
#        }
#        $fields = $new_fields;
#    }
    should(ref($new_fields), 'HASH');