view release on metacpan or  search on metacpan

lib/Data/Overlay.pm  view on Meta::CPAN

            ...;
            return $result;
        },
        args => [ ... ], # optional argument list
      }

=cut

$action_map{run} = sub {
    my ($old_ds, $overlay) = @_;
    return $overlay->{code}->($old_ds, @{ $overlay->{args} || [] });
};

=item foreach

Apply one overlay to all elements of an array or values of a hash
(or just a scalar).  Often useful with =run if the overlay is
a function of the original value.

=cut

# XXX each with (k,v) or [i,...]
$action_map{foreach} = sub {
    my ($old_ds, $overlay, $conf) = @_;
    if (_isreftype(ARRAY => $old_ds)) {
        return [
            map { overlay($_, $overlay, $conf) } @$old_ds
        ];
    } elsif (_isreftype(HASH => $old_ds)) {
        return {
            map {
                $_ => overlay($old_ds->{$_}, $overlay, $conf)
            } keys %$old_ds
        };
    } else {
        return overlay($old_ds, $overlay, $conf);
    }
};

=item seq

Apply in sequence an array of overlays.

=cut

$action_map{seq} = sub {
    my ($old_ds, $overlay, $conf) = @_;
    # XXX reftype $overlay
    my $ds = $old_ds;
    for my $ol (@$overlay) {
        $ds = overlay($ds, $ol, $conf);
    }
    return $ds;
};

=back

=cut

for my $action (keys %action_map) {
    # debuggable names for callbacks (not the used perl names)
    subname "$action-overlay", $action_map{$action};

    # XXX
    warn "$action not in \@action_order"
        if ! grep { $action eq $_ } @action_order;
}

sub _wrap_debug {
    my ($action_name, $inner_sub) = @_;

    my $s = subname "$action_name-debug", sub {
        my ($old_ds, $overlay, $conf) = @_;

        my $debug = max($conf->{debug},
                        (   ref($conf->{debug_actions})
                         && $conf->{debug_actions}{$action_name} ));
        if ($debug) {
            warn "Calling $action_name $inner_sub\n";
            warn "  with ", _dt($overlay), "\n" if $debug >= 1;
            warn "    conf ", _dt({map { "$_" } %$conf}), "\n" if $debug >= 2;
            cluck " CALL STACK" if $debug >= 3;
        }
        my $result = $inner_sub->($old_ds, $overlay, $conf);
        if ($debug) {
            warn " Back from $action_name\n";
            warn "  got ", _dt($result), "\n" if $debug >= 2;
        }
        return $result;
    };
    warn "Wrapped $inner_sub with $s";

    return $s;
}


sub _dt {
    require Data::Dumper;
    my $dumper = Data::Dumper->new( map [$_], @_ );
    $dumper->Indent(0)->Terse(1);
    $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
    return $dumper->Dump;
}


__PACKAGE__; # true return
__END__

exists
delete

and/if/ifthen replace if $ds is true
sprintf prepend_str append_str interpolate $_
splice grep map sort
+/-/*/++/--/x/%/**/./<</>>
| & ^ ~ masks boolean logic
conditionals? comparison?
deref?
invert apply inverted
swap overlay and ds roles
splitting one ds val into multiple new_ds?