1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
#!/usr/bin/perl
use File::Temp qw(tempfile);
($katalog = $0) =~ s|/[^/]*$||;
# Konwersja any-test wypisuje tylko oznaczenie rozpoznanego standardu zamiast
# konwersji. Konwersja any-test/all wypisuje tabelk wspczynnikw zgodnoci
# z poszczeglnymi zestawami.
if ($ARGV[0] eq "-test") {shift @ARGV; $test = 1;}
# Szukamy jzyka w argumentach i pliku z jego opisem:
foreach (split " ", $ENV{ARG})
{
if ($test && $_ eq "all") {$test = 2}
elsif (!$jest && open JEZYK, "$katalog/../aux/any/$_") {$jest = 1}
}
# Jeli nie znalelimy jzyka, to przepuszczamy tekst bez zmian:
unless ($jest)
{
if ($test == 1)
{
print "-\n";
}
elsif ($test == 2)
{
print "Unknown or unspecified language\n";
}
else
{
print while <>;
}
exit;
}
# Odczytujemy dane o zestawach znakw w danym jzyku:
while (<JEZYK>)
{
chomp;
@znaki = split;
$zestaw = shift @znaki;
# '%' zamiast zestawu oznacza czstoci wystpowania znakw:
if ($zestaw eq '%') {@czestosci = @znaki}
else
{
push @zestawy, {ZESTAW => $zestaw, ZNAKI => [@znaki]};
# Znaki zliczamy dwoma sposobami:
# - Poszczeglne bajty zliczamy tak czy siak, nie patrzc na
# to, ktre s akurat potrzebne.
# - Znaki dusze ni jeden bajt musimy zliczy osobno. Dla
# szybkoci zapamitujemy je w osobnych tablicach, wzgldem
# pierwszego bajtu.
foreach (@znaki)
{
push @{$dlugie[ord]}, $_ if length > 1
}
}
}
close JEZYK;
unless ($test)
{
# Musimy przelecie tekst dwa razy - raz, eby zliczy znaki, i drugi
# raz, eby go skonwertowa. Podczas pierwszego przebiegu zapamitujemy
# wic test w tymczasowym pliku:
($fh, $filename) = tempfile();
close $fh;
open TEMP, "+>$filename";
unlink $filename;
}
# Zliczamy wystpienia poszczeglnych bajtw (w @ile) i znakw duszych ni
# jeden bajt (w %ile):
while (<>)
{
print TEMP $_ unless $test;
chomp;
my $i = 0;
foreach my $znak (split //)
{
$ile[ord $znak]++;
foreach my $znak (@{$dlugie[ord $znak]})
{
$ile{$znak}++ if substr ($_, $i, length $znak) eq $znak;
}
} continue {$i++}
}
# Wspczynnikiem zgodnoci dla danego zestawu znakw jest suma iloczynw
# zaobserwowanych liczb wystpie i rednich czstoci dla danego jzyka
# odczytanej z pliku z opisem jzyka:
$najlepiej = 0;
$najlepszy = "-";
foreach (@zestawy)
{
my $pasuje = 0;
@znaki = @{$$_{ZNAKI}};
foreach (@czestosci)
{
$znak = shift @znaki;
$pasuje += (length $znak > 1 ? $ile{$znak} : $ile[ord $znak]) * $_
if $znak ne "-";
}
if ($test == 2) {$$_{PASUJE} = $pasuje}
if ($pasuje > $najlepiej)
{
$najlepiej = $pasuje;
$najlepszy = $$_{ZESTAW};
}
}
# Jeli to by test, to tylko wypisujemy informacj:
if ($test == 1)
{
print "$najlepszy\n";
exit;
}
elsif ($test == 2)
{
foreach (sort {$$b{PASUJE} <=> $$a{PASUJE}} @zestawy)
{
printf "%10d: %s\n", $$_{PASUJE}, $$_{ZESTAW} if $$_{PASUJE};
}
exit;
}
seek TEMP, 0, 0;
# Jeli z adnego zestawu nie pasowa aden znak, to przepuszczamy plik bez
# zmian:
if ($najlepiej == 0) {print while <TEMP>; close TEMP; exit;}
($najlepszy = "|$najlepszy-UTF8") =~ s/\|/|$katalog\//g;
open WYNIK, $najlepszy;
while (<TEMP>) {print WYNIK $_}
close TEMP;
close WYNIK;
|
