#!perl use warnings; use strict; my(@tagsi_fname); $tagsi_fname[0] = ...; # some hard-coded filenames encoded here $tagsi_fname[1] = ...; binmode STDOUT, ":encoding(utf-8)" or die "binmode STDOUT: $!"; my(@tagit, @tagil); for my$v (0,1) { my$dbgname = "tags$v"; my$fname = $tagsi_fname[$v]; open my$tabfh, "<:encoding(utf-16)", $fname or die qq(error opening $dbgname file: $!); my$enable; my$prevempty = 1; my@r; while (my$l = <$tabfh>) { $l =~ s/\r?\n?\z//; my$empty = $l!~/\S/; my@l = split /\t/, $l; if (!$enable && $l[0] && "DmTag" eq $l[0] && $prevempty) { $enable = 1; } if ($enable && !$empty) { push @r, \@l; } $prevempty = $empty; } eof($tabfh) or die; !$enable and die; my($_hdr0, $_hdr1, $tags_hdr, @tags_tab) = @r; ... printf "%s %s\n", ($v ? "+++" : "---"), $fname; $tagit[$v] = \@tags_tab; }; for my$v (0,1) { for my$i (keys @{$tagit[$v]}) { my$l = ${$tagit[$v]}[$i]; my$name = $$l[0]; push @{${$tagil[$v]}{$name}}, $i; } } sub fmttag { my($prefix, $l) = @_; ... printf(...) } for my$v (0,1) { print "@@ tags ", ($v ? "added" : "deleted"), "\n"; my$prefix = $v ? "+" : "-"; for my$l (@{$tagit[$v]}) { my$name = $$l[0]; if (!${$tagil[1-$v]}{$name}) { fmttag $prefix, $l; } } if (0 == $v) { my%u; print "@@ tags changed\n"; for my$l (@{$tagit[0]}) { my$name = $$l[0]; if (${$tagil[1]}{$name} && !$u{$name}++ && (1 < @{${$tagil[1]}{$name}} || 1 < @{${$tagil[0]}{$name}} || pack("(j/a)*", @{${$tagit[0]}[${${$tagil[0]}{$name}}[0]]}) ne pack("(j/a)*", @{${$tagit[1]}[${${$tagil[1]}{$name}}[0]]}))) { for my$vv (0,1) { for my$i (@{${$tagil[$vv]}{$name}}) { fmttag+($vv ? "+" : "-"), ${$tagit[$vv]}[$i]; } } } } } } print "@@ end of diff\n" __END__