Mail-Make

 view release on metacpan or  search on metacpan

lib/MM/Table.pm  view on Meta::CPAN

            $self->merge( $e->{key}, $e->{val} ) || return( $self->pass_error );
        }
        else
        {
            $self->set( $e->{key}, $e->{val} ) || return( $self->pass_error );
        }
    }
    return( $self );
}

sub overlay
{
    my( $self, $other ) = @_;

    $self->_validate_table( $other ) || return( $self->pass_error );

    my $class = ref( $self ) || $self;

    my $state =
    {
        _entries   => [],

lib/MM/Table.pm  view on Meta::CPAN

    $t->set( Foo => "one" ) || die( $t->error );
    $t->add( foo => "two" ) || die( $t->error );

    my $v  = $t->get( 'FOO' );     # "one" (scalar ctx: oldest)
    my @vs = $t->get( 'foo' );     # ("one","two")

    $t->merge( foo => "three" );   # first "foo" becomes "one, three"

    my $copy = $t->copy;

    my $o = $t->overlay( $copy );

    $t->compress( OVERLAP_TABLES_SET );    # flattens to last value per key
    $t->compress( OVERLAP_TABLES_MERGE );  # flattens to "a, b, c"

    $t->do( sub{ print "$_[0] => $_[1]\n"; 1 } ) || die( $t->error );

    # APR-like deref:
    $t->{foo} = "bar";      # calls set()
    print $t->{foo};        # calls get()
    print "yes\n" if( exists( $t->{foo} ) );

lib/MM/Table.pm  view on Meta::CPAN

=head2 merge( $key, $value )

If an entry for C<$key> already exists, appends C<", $value"> to its value.
Otherwise behaves like L</add>. Returns C<$self>, or C<undef> on error.

=head2 overlap( $other_table, $flags )

Copies all entries from C<$other_table> into C<$self>. With C<OVERLAP_TABLES_SET> each key is replaced; with C<OVERLAP_TABLES_MERGE> values are appended. Returns C<$self>, or C<undef> on error.

=head2 overlay( $other_table )

Returns a new C<MM::Table> containing all entries from C<$other_table> followed by all entries from C<$self> (C<$other_table> entries come first).
Returns the new table, or C<undef> on error.

=head2 pass_error

Propagates the error currently stored in this instance by returning C<undef>. If called with arguments, delegates to L</error> to create a new exception first.

=head2 set( $key, $value )

t/89_mm_table.t  view on Meta::CPAN

    $t->merge( merge => 'a' );

    my @vals = $t->get( 'merge' );
    is_deeply( \@vals, [ '1, a', '2' ], 'merge affects only first (oldest) value of multivalued key' );

    $t->clear();
    $t->merge( miss => 'a' );
    is( $t->get( 'miss' ), 'a', 'merge on missing key behaves like add()' );
};

subtest 'overlay semantics (new table = overlay first, then base)' => sub
{
    my $base = MM::Table->make( undef, 10 );
    my $add  = MM::Table->make( undef, 10 );

    $base->set( bar => 'beer' );
    $base->set( foo => 'one' );
    $base->add( foo => 'two' );

    $add->set( foo => 'three' );

    my $ov = $base->overlay( $add, undef );

    _pairs_eq(
        _dump_table_pairs( $ov ),
        [
            [ 'foo', 'three' ],
            [ 'bar', 'beer' ],
            [ 'foo', 'one' ],
            [ 'foo', 'two'  ],
        ],
        'overlay pair order'
    );

    # Verify originals unmodified
    _pairs_eq(
        _dump_table_pairs( $base ),
        [
            [ 'bar', 'beer' ],
            [ 'foo', 'one'  ],
            [ 'foo', 'two'  ],
        ],
        'base unmodified after overlay'
    );

    _pairs_eq(
        _dump_table_pairs( $add ),
        [
            [ 'foo', 'three' ],
        ],
        'add unmodified after overlay'
    );
};

subtest 'compress SET (keep last) and MERGE (comma list) with stable order by first occurrence' => sub
{
    my $t = MM::Table->make( undef, 10 );

    $t->set( bar => 'beer' );
    $t->set( foo => 'one' );
    $t->add( foo => 'two' );