view release on metacpan or  search on metacpan

lib/Data/Hash/Diff/Smart/Engine.pm  view on Meta::CPAN

		$keys{$_}++ for keys %count_new;

		for my $k (sort keys %keys) {
			my $o = $count_old{$k} || 0;
			my $n = $count_new{$k} || 0;

			if ($n > $o) {
				push @$changes, { op => 'add',    path => "$path/*", value => $k } for 1 .. $n - $o;
			} elsif ($o > $n) {
				push @$changes, { op => 'remove',  path => "$path/*", from  => $k } for 1 .. $o - $n;
			}
		}
	}
}

sub _key {
	my $v = $_[0];

	return $v unless ref($v);

	require Data::Dumper;
	local $Data::Dumper::Sortkeys = 1;
	local $Data::Dumper::Indent   = 0;
	local $Data::Dumper::Terse    = 1;
	return Data::Dumper::Dumper($v);
}

# -------------------------------------------------------------------------
# Helpers
# -------------------------------------------------------------------------

sub _reftype {
	my ($v) = @_;
	return unless ref $v;
	return reftype($v) || 'SCALAR';
}

sub _eq {
	my ($a, $b) = @_;
	return 1 if !defined($a) && !defined($b);
	return 0 if defined($a) xor defined($b);
	return $a eq $b;
}

sub _normalize_ignore {
	my ($ignore) = @_;
	return [] unless $ignore;

	my @rules;

	for my $r (@$ignore) {

		# Regex rule
		if (ref($r) eq 'Regexp') {
			push @rules, { type => 'regex', re => $r };
			next;
		}

		# String rule: check for wildcard
		if ($r =~ /\*/) {
			my @parts = grep { length $_ } split m{/}, $r;
			push @rules, { type => 'wildcard', parts => \@parts };
		}
		else {
			push @rules, { type => 'exact', path => $r };
		}
	}

	return \@rules;
}

sub _is_ignored {
	my ($path, $rules) = @_;
	return 0 unless $rules && @$rules;

	# Split current path into parts
	my @path_parts = grep { length $_ } split m{/}, $path;

	RULE:
	for my $rule (@$rules) {

		if ($rule->{type} eq 'exact') {
			return 1 if $path eq $rule->{path};
		}

		elsif ($rule->{type} eq 'regex') {
			return 1 if $path =~ $rule->{re};
		}

		elsif ($rule->{type} eq 'wildcard') {
			my @r = @{ $rule->{parts} };

			next RULE unless @r == @path_parts;

			for my $i (0 .. $#r) {
				next if $r[$i] eq '*';
				next RULE if $r[$i] ne $path_parts[$i];
			}

			return 1;
		}
	}

	return 0;
}

=head1 LICENCE AND COPYRIGHT

Copyright 2026 Nigel Horne.

Usage is subject to licence terms.

The licence terms of this software are as follows:

=over 4

=item * Personal single user, single computer use: GPL2

=item * All other users (including Commercial, Charity, Educational, Government)
  must apply in writing for a licence for use from Nigel Horne at the
  above e-mail.

=back

=cut

1;