File Coverage

blib/lib/Attean/TermMap.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	15	16	93.7
condition			n/a
subroutine	18	18	100.0
pod	6	6	100.0
total	105	106	99.0

use v5.14;
use warnings;

=head1 NAME

Attean::TermMap - Mapping terms to new terms

=head1 VERSION

This document describes Attean::TermMap version 0.033

=head1 SYNOPSIS

  use v5.14;
  use Attean;
  my $m = Attean::TermMap->short_blank_map;
  my $new_blank = $m->map( Attean::Blank->new('abcdefg') );
  say $new_blank->ntriples_string; # _:a

=head1 DESCRIPTION

The Attean::TermMap class represents a one-way mapping process from and to
L<Attean::API::Term> objects. This mapping may rename the blank identifiers,
skolemize nodes, or map the nodes in some other, custom way.

It conforms to the L<Attean::API::Mapper> role.

=head1 ATTRIBUTES

=over 4

=item C<< mapper >>

A CODE reference that will map L<Attean::API::Term> objects to (possibly different)
term objects.

=back

=head1 CLASS METHODS

=over 4

=cut

	use Moo;
	use Types::Standard qw(CodeRef);
	use Attean::API::Binding;
	use UUID::Tiny ':std';
	use namespace::clean;

	with 'Attean::Mapper';
	has 'mapper'	=> (is => 'ro', isa => CodeRef, default => sub { shift }, required => 1);

	around BUILDARGS => sub {
		my $orig 	= shift;
		my $class	= shift;
		if (scalar(@_) == 1) {
			return $class->$orig(mapper => shift);
		}
		return $class->$orig(@_);
	};

=item C<< canonicalization_map >>

Returns a new L<Attean::TermMap> that canonicalizes recognized typed
L<Attean::API::Literal> values.

=cut

		my $class	= shift;
		my %map;
		return $class->new(mapper => sub {
			my $term	= shift;
			return $term unless ($term->does('Attean::API::Literal'));

			if ($term->does('Attean::API::CanonicalizingLiteral')) {
				my $c	= eval { $term->canonicalized_term };
				return ($@) ? undef : $c;
			}

			return $term;
		});
	}

=item C<< uuid_blank_map >>

Returns a new L<Attean::TermMap> that renames blank nodes with UUID values.

=cut

		my $class	= shift;
		my %map;
		return $class->new(mapper => sub {
			my $term	= shift;
			return $term unless ($term->does('Attean::API::Blank'));
			my $id		= $term->value;
			return $map{$id} if (defined($map{$id}));

			my $uuid	= unpack('H*', create_uuid());
			my $new		= Attean::Blank->new( 'b' . $uuid );
			$map{$id}	= $new;
			return $new;
		});
	}

=item C<< short_blank_map >>

Returns a new L<Attean::TermMap> that renames blank nodes with short
alphabetic names (e.g. _:a, _:b).

=cut

		my $class	= shift;
		my %map;
		my $next	= 'a';
		return $class->new(mapper => sub {
			my $term	= shift;
			return $term unless ($term->does('Attean::API::Blank'));
			my $id		= $term->value;
			if (defined(my $t = $map{$id})) {
				return $t;
			} else {
				my $new		= Attean::Blank->new( $next++ );
				$map{$id}	= $new;
				return $new;
			}
		});
	}

=item C<< rewrite_map( \%map ) >>

Given C<< %map >> whose keys are term C<< as_string >> serializations, and
objects are L<Attean::API::Term> objects, returns a new term map object that
maps terms matching entries in C<< %map >>, and all other terms to themselves.

=cut

		my $class	= shift;
		my $map		= shift;
		return $class->new(mapper => sub {
			my $term	= shift;
			return $map->{ $term->as_string } if (exists $map->{ $term->as_string });
			return $term;
		});
	}

=back

=head1 METHODS

=over 4

=item C<< map( $term ) >>

Returns the term that is mapped to by the supplied C<< $term >>.

=cut

		my $self	= shift;
		my $term	= shift;
		return $self->mapper->( $term );
	}

=item C<< binding_mapper >>

Returns a mapping function reference that maps L<Attean::API::Binding>
objects by mapping their constituent mapped L<Attean::API::Term> objects.

=cut

		my $self	= shift;
		return sub {
			my $binding	= shift;
			return $binding->apply_map($self);
		}
	}
}

1;


=back

=head1 BUGS

Please report any bugs or feature requests to through the GitHub web interface
at L<https://github.com/kasei/attean/issues>.

=head1 SEE ALSO



=head1 AUTHOR

Gregory Todd Williams  C<< <[e-mail]> >>

=head1 COPYRIGHT

Copyright (c) 2014--2022 Gregory Todd Williams.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut