view release on metacpan or  search on metacpan

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

package Data::Transmute;

use 5.010001;
use strict 'subs', 'vars';
use warnings;
use Log::ger;

use Ref::Util qw(is_hashref is_arrayref is_plain_hashref is_plain_arrayref);
use Scalar::Util qw(refaddr);

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-07-17'; # DATE
our $DIST = 'Data-Transmute'; # DIST
our $VERSION = '0.040'; # VERSION

our @EXPORT_OK = qw(transmute_data reverse_rules);

sub _rule_create_hash_key {
    my %args = @_;

    my $data = $args{data};
    return unless ($args{transmute_object} // 1) ? is_hashref($data) : is_plain_hashref($data);

    my $name = $args{name};
    die "Rule create_hash_key: Please specify 'name'" unless defined $name;

    if (exists $data->{$name}) {
        return if $args{ignore};
        die "Rule create_hash_key: Key '$name' already exists" unless $args{replace};
    }
    die "Rule create_hash_key: Please specify 'value' or 'value_code'"
        unless exists $args{value} || $args{value_code};
    $data->{$name} = $args{value_code} ? $args{value_code}->($data->{$name}) : $args{value};
}

sub _rulereverse_create_hash_key {
    my %args = @_;
    die "Cannot generate reverse rule create_hash_key with value_code" if $args{value_code};
    die "Cannot generate reverse rule create_hash_key with ignore=1"   if $args{ignore};
    die "Cannot generate reverse rule create_hash_key with replace=1"  if $args{replace};
    [delete_hash_key => {name=>$args{name}, transmute_object=>$args{transmute_object}}];
}

sub _rule_rename_hash_key {
    my %args = @_;

    my $data = $args{data};
    return unless ($args{transmute_object} // 1) ? is_hashref($data) : is_plain_hashref($data);

    my $from = $args{from};
    die "Rule rename_hash_key: Please specify 'from'" unless defined $from;
    my $to   = $args{to};
    die "Rule rename_hash_key: Please specify 'to'" unless defined $to;

    # noop
    return if $from eq $to;

    if (!exists($data->{$from})) {
        die "Rule rename_hash_key: Can't rename '$from' -> '$to': Old key '$from' doesn't exist" unless $args{ignore_missing_from};
        return;
    }
    if (exists $data->{$to}) {
        return if $args{ignore_existing_target};
        die "Rule rename_hash_key: Can't rename '$from' -> '$to': Target key '$from' already exists" unless $args{replace};
    }
    $data->{$to} = delete $data->{$from};