view release on metacpan or  search on metacpan

lib/CPAN/Meta/Merge.pm  view on Meta::CPAN

  my %mapping = %default;
  my %extra = %{ $arguments{extra_mappings} || {} };
  for my $key (keys %extra) {
    if (ref($mapping{$key}) eq 'HASH') {
      $mapping{$key} = { %{ $mapping{$key} }, %{ $extra{$key} } };
    }
    else {
      $mapping{$key} = $extra{$key};
    }
  }
  return bless {
    default_version => $arguments{default_version},
    mapping => _coerce_mapping(\%mapping, []),
  }, $class;
}

my %coderef_for = (
  set_addition => \&_set_addition,
  uniq_map     => \&_uniq_map,
  identical    => \&_identical,
  improvise    => \&_improvise,
  improvize    => \&_improvise, # [sic] for backwards compatibility
);

sub _coerce_mapping {
  my ($orig, $map_path) = @_;
  my %ret;
  for my $key (keys %{$orig}) {
    my $value = $orig->{$key};
    if (ref($orig->{$key}) eq 'CODE') {
      $ret{$key} = $value;
    }
    elsif (ref($value) eq 'HASH') {
      my $mapping = _coerce_mapping($value, [ @{$map_path}, $key ]);
      $ret{$key} = sub {
        my ($left, $right, $path) = @_;
        return _merge($left, $right, $mapping, [ @{$path} ]);
      };
    }
    elsif ($coderef_for{$value}) {
      $ret{$key} = $coderef_for{$value};
    }
    else {
      croak "Don't know what to do with " . join '.', @{$map_path}, $key;
    }
  }
  return \%ret;
}

sub merge {
  my ($self, @items) = @_;
  my $current = {};
  for my $next (@items) {
    if ( blessed($next) && $next->isa('CPAN::Meta') ) {
      $next = $next->as_struct;
    }
    elsif ( ref($next) eq 'HASH' ) {
      my $cmc = CPAN::Meta::Converter->new(
        $next, default_version => $self->{default_version}
      );
      $next = $cmc->upgrade_fragment;
    }
    else {
      croak "Don't know how to merge '$next'";
    }
    $current = _merge($current, $next, $self->{mapping}, []);
  }
  return $current;
}

1;

# ABSTRACT: Merging CPAN Meta fragments


# vim: ts=2 sts=2 sw=2 et :

__END__

=pod

=encoding UTF-8

=head1 NAME

CPAN::Meta::Merge - Merging CPAN Meta fragments

=head1 VERSION

version 2.150015

=head1 SYNOPSIS

 my $merger = CPAN::Meta::Merge->new(default_version => "2");
 my $meta = $merger->merge($base, @additional);

=head1 DESCRIPTION

=head1 METHODS

=head2 new

This creates a CPAN::Meta::Merge object. It takes one mandatory named
argument, C<version>, declaring the version of the meta-spec that must be
used for the merge. It can optionally take an C<extra_mappings> argument
that allows one to add additional merging functions for specific elements.

The C<extra_mappings> arguments takes a hash ref with the same type of
structure as described in L<CPAN::Meta::Spec>, except with its values as
one of the L<defined merge strategies|/"MERGE STRATEGIES"> or a code ref
to a merging function.

  my $merger = CPAN::Meta::Merge->new(
      default_version => '2',
      extra_mappings => {
          'optional_features' => \&custom_merge_function,
          'x_custom' => 'set_addition',
          'x_meta_meta' => {
              name => 'identical',
              tags => 'set_addition',
          }
      }
  );

=head2 merge(@fragments)

Merge all C<@fragments> together. It will accept both CPAN::Meta objects and
(possibly incomplete) hashrefs of metadata.

=head1 MERGE STRATEGIES

C<merge> uses various strategies to combine different elements of the CPAN::Meta objects.  The following strategies can be used with the extra_mappings argument of C<new>:

=over

=item identical

The elements must be identical

=item set_addition

The union of two array refs

  [ a, b ] U [ a, c]  = [ a, b, c ]

=item uniq_map

Key value pairs from the right hash are merged to the left hash.  Key
collisions are only allowed if their values are the same.  This merge
function will recurse into nested hash refs following the same merge
rules.

=item improvise

This merge strategy will try to pick the appropriate predefined strategy
based on what element type.  Array refs will try to use the
C<set_addition> strategy,  Hash refs will try to use the C<uniq_map>
strategy, and everything else will try the C<identical> strategy.

=back

=head1 AUTHORS

=over 4

=item *

David Golden <dagolden@cpan.org>

=item *

Ricardo Signes <cpan@semiotic.systems>

=item *

Adam Kennedy <adamk@cpan.org>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut