The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Data::Transpose;

use 5.010001;
use strict;
use warnings;

use Data::Transpose::Field;
use Data::Transpose::Group;

=head1 NAME

Data::Transpose - Transpose, iterate, filter and validate data

Caters to your needs for manipulating data by different operations,
which are filtering records, iterating records, validating and
transposing to different field names.

=head1 VERSION

Version 0.0006

=cut

our $VERSION = '0.0006';

=head1 SYNOPSIS

    use Data::Transpose;

    my $tp = Data::Transpose->new;

=head1 REFERENCE

=over 4

=item Validator

L<Data::Transpose::Validator>

=item Iterator

L<Data::Transpose::Iterator>

=back

=head1 METHODS

=head2 new

Parameters for the constructor are:

=over 4

=item unknown

Determines how to treat fields in the input hash
which are not known to the Data::Transpose object:

=over 4

=item fail

The transpose operation fails.

=item pass

Unknown fields in the input hash appear in the output
hash. This is the default behaviour.

=item skip

Unknown fields in the input hash don't appear in
the output hash.

=back

=back

=cut

sub new {
    my ($class, $self, %args);

    $class = shift;
    $self = {unknown => 'pass'};
    bless $self, $class;

    %args = @_;

    if (defined $args{unknown}) {
        if ($args{unknown} eq 'fail'
            || $args{unknown} eq 'pass'
            || $args{unknown} eq 'skip') {
            $self->{unknown} = $args{unknown};
        }
        else {
            die "Invalid parameter for unknown (use either fail, pass or skip).\n";
        }
    }

    $self->{fields} = [];

    return $self;
}

=head2 field

Add a new field object and returns it:

    $tp->field('email');

=cut

sub field {
    my ($self, $name) = @_;
    my ($object);

    $object = Data::Transpose::Field->new(name => $name);

    push @{$self->{fields}}, $object;

    return $object;
}

=head2 group

Add a new group object and return it:

    $tp->group('fullname', $tp->field('firstname'), $tp->field('lastname'));

=cut

sub group {
    my ($self, $name, @objects) = @_;
    
    my $object = Data::Transpose::Group->new(name => $name,
                                             objects => \@objects);

    push @{$self->{fields}}, $object;
    
    return $object;
}

=head2 transpose

=cut

sub transpose {
    my ($self, $vref) = @_;
    my ($weed_value, $fld_name, $new_name, %new_record, %status);

    $status{$_} = 1 for keys %$vref;

    for my $fld (@{$self->{fields}}) {
        $fld_name = $fld->name;

        # set value and apply operations
        if (exists $vref->{$fld_name}) {
            $weed_value = $fld->value($vref->{$fld_name});
        }
        else {
            $weed_value = $fld->value;
        }

        if ($new_name = $fld->target) {
            $new_record{$new_name} = $weed_value;
        }
        else {
            $new_record{$fld_name} = $weed_value;
        }

        delete $status{$fld_name};
    }

    if (keys %status) {
        # unknown fields
        if ($self->{unknown} eq 'pass') {
            # pass through unknown fields
            for (keys %status) {
                $new_record{$_} = $vref->{$_};
            }
        }
        elsif ($self->{unknown} eq 'fail') {
            die "Unknown fields in input: ", join(',', keys %status), '.';
        }
    }

    return \%new_record;
}

=head1 AUTHOR

Stefan Hornburg (Racke), C<< <racke at linuxia.de> >>

=head1 BUGS

Please report any bugs or feature requests at
L<https://github.com/racke/Data-Transpose/issues>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Data::Transpose

You can also look for information at:

=over 4

=item * Github's issue tracker (report bugs here)

L<https://github.com/racke/Data-Transpose/issues>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Data-Transpose>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Data-Transpose>

=item * Search CPAN

L<http://search.cpan.org/dist/Data-Transpose/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2012-2014 Stefan Hornburg (Racke).

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Data::Transpose