ja1200/stat/encoding.pl

#!/usr/bin/perl
use strict;

use Encode::Guess;

my $GuessEncode = {};

our $target = shift;
our $code = sub {
  my ($entity, $file_name) = @_;

  my $enc = guess_encoding
    ($entity->{body}, qw/euc-jp shiftjis 7bit-jis/);
  $GuessEncode->{ref $enc ? $enc->name : $enc}++;
  print $file_name, "\t", $enc, "\n" unless ref $enc;
};

require 'foreach.pl';

print "Guessed encoding:\n";
for (sort {$a cmp $b} keys %$GuessEncode) {
  print $_, "\t", $GuessEncode->{$_}, "\n";
}

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut

1;
## $Date:$

1	#!/usr/bin/perl
2	use strict;
3
4	use Encode::Guess;
5
6	my $GuessEncode = {};
7
8	our $target = shift;
9	our $code = sub {
10	my ($entity, $file_name) = @_;
11
12	my $enc = guess_encoding
13	($entity->{body}, qw/euc-jp shiftjis 7bit-jis/);
14	$GuessEncode->{ref $enc ? $enc->name : $enc}++;
15	print $file_name, "\t", $enc, "\n" unless ref $enc;
16	};
17
18	require 'foreach.pl';
19
20	print "Guessed encoding:\n";
21	for (sort {$a cmp $b} keys %$GuessEncode) {
22	print $_, "\t", $GuessEncode->{$_}, "\n";
23	}
24
25	=head1 AUTHOR
26
27	Wakaba <w@suika.fam.cx>.
28
29	=head1 LICENSE
30
31	Copyright 2007 Wakaba <w@suika.fam.cx>
32
33	This library is free software; you can redistribute it
34	and/or modify it under the same terms as Perl itself.
35
36	=cut
37
38	1;
39	## $Date:$
40