#!/usr/bin/perl -w
#
# Data::Toolkit::Map
#
# Andrew Findlay
# Nov 2006
# andrew.findlay@skills-1st.co.uk
#
# $Id: Map.pm 186 2008-01-28 12:30:35Z remotesvn $

package Data::Toolkit::Map;

use strict;
use Data::Dumper;
use Carp;
use Clone qw(clone);

=head1 NAME

Data::Toolkit::Map

=head1 DESCRIPTION

Data::Toolkit::Map objects implement mapping functions for attribute names
and values in Data::Toolkit::Entry objects. This is useful when converting between
different data representations in directory-synchronisation projects.

=head1 SYNOPSIS

   my $map = Data::Toolkit::Map->new();

   $map->set("surname", "sn" );

   $map->set("objectclass", [ "inetOrgPerson", "organizationalPerson", "person" ] );
   $map->set("phone","+44 1234 567890");
   $map->set("address", \&buildAddress);
   $map->set("fn", sub { return firstValue("fullname", @_) });

   $arrayRef = $map->outputs();

   $values = $map->generate('attributeName', $entry [, $entry...]);

   $newEntry = $map->newEntry($source1, $source2 ...);

   $result = $map->delete('thisAttribute');

   my $currentDebugLevel = Data::Toolkit::Map->debug();
   my $newDebugLevel = Data::Toolkit::Map->debug(1);

   my $string = $map->dump();

=head1 DEPENDENCIES

   Carp
   Clone
   Data::Dumper

=cut

########################################################################
# Package globals
########################################################################

use vars qw($VERSION);
$VERSION = '0.1';

# Set this non-zero for debug logging
#
my $debug = 0;

########################################################################
# Constructors and destructors
########################################################################

=head1 Constructor

=head2 new

   my $map = Data::Toolkit::Map->new();

Creates an object of type Data::Toolkit::Map

=cut

sub new {
	my $class = shift;
	my $configParam = shift;

	my $self  = {};
	$self->{mapping} = {};

	# Take a copy of the config hash
	# - we don't want to store a ref to the one we were given
	#   in case it is part of another object
	#
	if (defined($configParam)) {
		if ((ref $configParam) ne 'HASH') {
			croak "Data::Toolkit::Map->new expects a hash ref but was given something else"
		}

		$self->{config} = clone($configParam);
	}
	else {
		# Start with empty config
		$self->{config} = {};
	}

	bless ($self, $class);

	carp "Data::Toolkit::Map->new $self" if $debug;
	return $self;
}

sub DESTROY {
	my $self = shift;
	carp "Data::Toolkit::Map Destroying $self" if $debug;
}

########################################################################
# Methods
########################################################################

=head1 Methods

=cut

########################################

=head2 set

Set or replace a mapping.

   $map->set( outputAttribute, generator )

outputAttribute must be a text string. Generator can be of several types:

=over

=item SCALAR - the value is the name of an attribute in the source entry, which is copied
to the outputAttribute

=item ARRAY - the value is a fixed array of strings which will be used as the value of
the outputAttribute

=item CODE - the value is a procedure or closure that is run to generate the value of
the outputAttribute. The procedure must return undef or an array reference.

=back

This is a simple mapping that generates a "surname" attribute by copying
the value of the input entry's "sn" attribute:

   $map->set("surname", "sn" );

This is a fixed mapping generating an LDAP objectClass attribute with
several values:

   $map->set("objectclass", [ "inetOrgPerson", "organizationalPerson", "person" ] );

This is a fixed mapping generating a single value (note the use of a list
to distinguish this from the first case above):

   $map->set("phone", ["+44 1234 567890"]);

This is a dynamic mapping where the attribute is generated by a procedure:

   $map->set("address", \&buildAddress);

When a dynamic mapping is evaluated, it is given the name of the attribute being generated
followed by all the parameters that were passed to the "generate" call,
so it can refer to entries and other objects.

Similarly, closures can be used:

   $map->set("fn", sub { return firstValue("xyzzy", @_) });

In this example, when the firstValue() procedure is called by "generate",
it gets one fixed parameter plus anything else that was passed to the "generate" call.
Thus the call:

   $map->generate("fn",$entry)

would result in a call like this:

   firstValue("fn","xyzzy",$entry)


=cut

sub set {
	my $self = shift;
	my $attrib = shift;
	my $values = shift;

	croak "set requires an attribute name" if (!$attrib);
	croak "set requires a value" if (!$values);

	carp "Data::Toolkit::Map->set attribute '$attrib'" if $debug;

	return $self->{mapping}->{$attrib} = $values;
}


########################################

=head2 unset

Removes an attribute from a map.
Returns a reference to the deleted value.

=cut

sub unset {
	my $self = shift;
	my $attrib = shift;

	croak "unset requires an attribute name" if (!$attrib);

	carp "Data::Toolkit::Map->unset attribute '$attrib'" if $debug;

	return delete $self->{mapping}->{$attrib};
}


########################################

=head2 outputs

Return the list of attributes that the map generates.

Returns an empty list if there are no attributes.

   $arrayRef = $map->outputs();

=cut

sub outputs {
	my $self = shift;

	my @keys_list = CORE::keys %{$self->{mapping}};
	carp "Data::Toolkit::Map->outputs are: " . (join ',', @keys_list) if $debug;
        return( wantarray ? @keys_list : \@keys_list );

}

########################################

=head2 generate

Generate a list of values for a given attribute.

   $values = $map->generate('attributeName', $entry [, $entry...]);

=cut

sub generate {
	my $self = shift;
	my $attrib = shift;

	croak "generate requires an attribute name" if (!$attrib);
	carp "Data::Toolkit::Map->generate for attribute '$attrib'" if $debug;

	my $mapping = $self->{mapping}->{$attrib};
	# If that is undef or empty, return it immediately
	return $mapping if !$mapping;

	my $refMap = ref $mapping;
	if (!$refMap) {
		# We have a mapping but it is not a reference
		carp "Data::Toolkit::Map->generate attribute '$attrib' from source attribute '$mapping'" if $debug;

		# Must be a simple attribute map so get the source entry
		my $entry = shift;
		my @values = $entry->get($mapping);
		return wantarray ? @values : \@values;
	}
	elsif ($refMap eq 'ARRAY') {
		# Arrays represent constant data so just return it as-is
		carp "Data::Toolkit::Map->generate attribute '$attrib' from fixed array" if $debug;

		return wantarray ? @$mapping : $mapping;
	}
	elsif ($refMap eq 'CODE') {
		# We have been given some code to run
		carp "Data::Toolkit::Map->generate attribute '$attrib' from supplied code" if $debug;

		my $result = &$mapping($attrib, @_);
		# Do some sanity checking on the result
		return undef if !defined($result);
		my $resType = ref $result;
		$resType = 'SCALAR' if !$resType;
		if ($resType ne 'ARRAY') {
			croak "mapping procedure returned $resType while mapping for '$attrib' - it should have returned an ARRAY";
		}

		return $result;
	}
	else {
		# Don't know what to do with this!
		croak "generate does not know how to handle a $refMap mapping";
	}

}

########################################

=head2 newEntry

Create a new entry object by applying a map to one or more existing entries

   $newEntry = $map->newEntry($source1, $source2 ...);

The source objects are Data::Toolkit::Entry objects

=cut

sub newEntry {
	my $self = shift;

	# If we have been passed any source entries, use the first one as a template
	# to create the new entry
	if ($_[0]) {
		carp "Data::Toolkit::Map->newEntry from template entry" if $debug;
		my $template = shift;
		return $template->map( $self, @_ );
	}

	# Hmm - we seem to be mapping from nothing to create something!
	carp "Data::Toolkit::Map->newEntry from nothing" if $debug;

	# Create a new entry with default config to act as source
	my $newEntry = Data::Template::Entry->new();

	return $newEntry->map( $self );
}


########################################

=head2 delete

Delete an output from a map.

   $result = $map->delete('thisAttribute');

=cut

sub delete {
	my $self = shift;
	my $attrib = shift;

	croak "delete requires an attribute name" if (!$attrib);
	carp "Data::Toolkit::Map->delete '$attrib'" if $debug;

	return delete $self->{$attrib};
}


########################################################################
# Debugging methods
########################################################################

=head1 Debugging methods

=head2 debug

Set and/or get the debug level for Data::Toolkit::Map

   my $currentDebugLevel = Data::Toolkit::Map->debug();
   my $newDebugLevel = Data::Toolkit::Map->debug(1);

Any non-zero debug level causes the module to print copious debugging information.

Note that this is a package method, not an object method. It should always be
called exactly as shown above.

All debug information is reported using "carp" from the Carp module, so if
you want a full stack backtrace included you can run your program like this:

   perl -MCarp=verbose myProg

=cut

# Class method to set and/or get debug level
#
sub debug {
	my $class = shift;
	if (ref $class)  { croak "Class method 'debug' called as object method" }
	# print "DEBUG: ", (join '/', @_), "\n";
	$debug = shift if (@_ == 1);
	return $debug
}

########################################

=head2 dump

Returns a text representation of the map.

   my $string = $map->dump();

=cut


sub dump {
	my $self = shift;

	my %hash = $self->{mapping};
	return Dumper(\%hash);
}


########################################################################
########################################################################

=head1 Error handling

If you miss out an essential parameter, the module will throw an exception
using "croak" from the Carp module. These exceptions represent programming
errors in most cases so there is little point in trapping them with "eval".

=head1 Author

Andrew Findlay

Skills 1st Ltd

andrew.findlay@skills-1st.co.uk

http://www.skills-1st.co.uk/

=cut

########################################################################
########################################################################
1;
