view release on metacpan or  search on metacpan

lib/Data/Domain/SemanticAdapter.pm  view on Meta::CPAN

  Data::Inherited
  Class::Accessor::Complex
);
__PACKAGE__->mk_scalar_accessors(qw(adaptee));

# sub adaptee() to be defined in subclasses
use constant OPTIONS => ();

sub new {
    my $class   = shift;
    my $self    = bless {}, $class;
    my @options = (qw/-not_in/, $self->every_list('OPTIONS'));
    my $parsed  = Data::Domain::_parse_args(\@_, \@options);
    while (my ($key, $value) = each %{ $parsed || {} }) {
        $self->{$key} = $value;
    }
    if ($self->{-not_in}) {
        @{ $self->{-not_in} || [] } > 0
          or croak "-not_in : needs an arrayref of values";
    }
    my $semantic_class_name = $self->semantic_class_name;
    $semantic_class_name->require;
    $self->adaptee($semantic_class_name->new($self->semantic_args));
    $self;
}

# Default; subclasses can redefine this. But it makes sense to keep the
# Data::Domain::* and Data::Semantic::* namespaces in sync.
sub semantic_class_name {
    my $self = shift;
    (my $semantic_class_name = ref $self) =~
      s/^Data::Domain::/Data::Semantic::/;
    $semantic_class_name;
}

# Turn the options accepted because of OPTIONS() into args to be passed to the
# adaptee constructor. Here we provide a sensibe default.
sub semantic_args {
    my $self = shift;
    my %args;
    for my $option ($self->OPTIONS) {
        (my $semantic_key = $option) =~ s/^-//;
        $args{$semantic_key} = $self->{$option} if defined $self->{$option};
    }
    %args;
}

sub _inspect {
    my ($self, $data) = @_;
    $self->adaptee->is_valid($data)
      or return $self->msg(INVALID => $data);
    if (defined $self->{-not_in}) {
        grep { $data eq $_ } @{ $self->{-not_in} }
          and return $self->msg(EXCLUSION_SET => $data);
    }
}

# mirror the Data::Semantic::Name namespace classes
sub install_shortcuts {
    my %map      = @_;
    my $call_pkg = (caller)[0];
    while (my ($domain, $class) = each %map) {
        no strict 'refs';
        my $domain_class_name = "Data::Domain::$class";
        $domain_class_name->require;
        *{"${call_pkg}::${domain}"} = sub { $domain_class_name->new(@_) };
    }
}
1;


__END__
=pod

=head1 NAME

Data::Domain::SemanticAdapter - Adapter for Data::Semantic objects

=head1 VERSION

version 1.100840

=head1 DESCRIPTION

This class is an adapter (wrapper) that turns L<Data::Semantic> objects into
L<Data::Domain> objects.

It, and therefore all the subclasses, support a C<-not_in> options. If given,
the data must be different from all values in the exclusion set, supplied
as an arrayref.

=head1 METHODS

=head2 semantic_class_name

Returns the corresponding semantic class name. This method provides a default
mapping, the idea of which is to mirror the layout of the Data::Semantic class
tree. If you have a different mapping, override this method in a subclass.

So in the Data::Domain::URI::http class, it will return
C<Data::Semantic::URI::http>.

=head2 adaptee

Takes the results of C<semantic_class_name()> and C<semantic_args()>, loads
the semantic data class and returns a semantic data object with the given args
passed to its constructor.

=head2 semantic_args

Turns the object's options, specified via C<OPTIONS()>, into arguments to be
passed to the semantic data object's constructor. Returns a hash.

=head2 _inspect

Inspects the data using the C<adaptee()>. See L<Data::Domain> for more
information. Respects the C<-not_in> option and returns a C<EXCLUSION_SET>
message, if appropriate. If the adaptee() says that the data is not valid
under the given options, an C<INVALID> message is returned.

=head2 install_shortcuts