perlunicook - Daring di Awan

PROGRAM:

NAMA

perlunicook - contoh buku masak penanganan Unicode di Perl

DESKRIPSI

Halaman manual ini berisi resep singkat yang menunjukkan cara menangani operasi Unicode umum
di Perl, ditambah satu program lengkap di akhir. Variabel apa pun yang tidak dideklarasikan dalam individu
resep diasumsikan memiliki nilai yang sesuai sebelumnya di dalamnya.

CONTOH

X 0: Standar pembukaan
Kecuali dinyatakan lain, semua contoh di bawah ini memerlukan pembukaan standar ini untuk berfungsi
dengan benar, dengan tanda "#!" disesuaikan untuk bekerja pada sistem Anda:

#!/usr/bin/env perl

gunakan utf8; # jadi literal dan pengenal bisa di UTF-8
gunakan v5.12; # atau lebih baru untuk mendapatkan fitur "unicode_strings"
gunakan ketat; # kutipan string, mendeklarasikan variabel
gunakan peringatan; # aktif secara default
gunakan peringatan qw(FATAL utf8); # fatalisasi gangguan penyandian
gunakan buka qw(:std :utf8); # aliran tidak dideklarasikan di UTF-8
gunakan charnames qw(:full :short); # tidak dibutuhkan di v5.16

Kredensial mikro tidak jadikan pemrogram Unix "binmode" aliran biner Anda, atau buka dengan
":raw", tapi itulah satu-satunya cara untuk mendapatkannya secara portabel.

PERINGATAN: "use autodie" (pre 2.26) dan "use open" tidak cocok satu sama lain.

X 1: Umum Memahami Unicode menyaring
Selalu terurai saat masuk, lalu komposisi ulang saat keluar.

gunakan Unicode::Normalkan;

sementara (<>) {
$_ = NFD($_); # terurai + susun ulang secara kanonik
...
} melanjutkan {
cetak NFC($_); # menyusun ulang (jika memungkinkan) + menyusun ulang secara kanonik
}

X 2: Mencari setelan Unicode peringatan
Mulai v5.14, Perl membedakan tiga subkelas peringatan UTFX8.

gunakan v5.14; # subperingatan tidak tersedia lebih awal
tidak ada peringatan "nonchar"; # 66 non-karakter terlarang
tidak ada peringatan "pengganti"; # UTF-16/CESU-8 omong kosong
tidak ada peringatan "non_unicode"; # untuk titik kode lebih dari 0x10_FFFF

X 3: Menyatakan sumber in utf8 untuk pengidentifikasi dan literal
Tanpa deklarasi "gunakan utf8" yang sangat kritis, masukkan UTFX8 ke literal Anda dan
pengidentifikasi tidak akan berfungsi dengan benar. Jika Anda menggunakan pembukaan standar yang baru saja diberikan di atas, ini
sudah terjadi. Jika Anda melakukannya, Anda dapat melakukan hal-hal seperti ini:

gunakan utf8;

$ukuran saya = "Aangstroem";
@Xsoft saya = qw( cp852 cp1251 cp1252 );
@XXXXXXXXX saya = qw( XXXX XXXXX );
saya @X = qw( koi8-f koi8-u koi8-r );
$moto saya = "XXX"; # KELUARGA, HATI TUMBUH, UNTA DROMEDARI

Jika Anda lupa "gunakan utf8", byte tinggi akan disalahpahami sebagai karakter terpisah, dan
tidak ada yang akan bekerja dengan benar.

X 4: Karakter dan mereka nomor
Fungsi "ord" dan "chr" bekerja secara transparan di semua titik kode, tidak hanya di ASCII
sendiri X juga tidak, bahkan tidak hanya di Unicode saja.

# karakter ASCII
orde("A")
chr(65)

# karakter dari Basic Multilingual Plane
orde("X")
chr(0x3A3)

# di luar BMP
ord("X") # MATEMATIKA ITALIC KECIL N
chr(0x1D45B)

# di luar Unicode! (hingga MAXINT)
ord("\x{20_0000}")
chr(0x20_0000)

X 5: Unicode literal by karakter jumlah
Dalam literal yang diinterpolasi, apakah string yang dikutip ganda atau regex, Anda dapat menentukan a
karakter dengan nomornya menggunakan "\x{HHHHH}" melarikan diri.

String: "\x{3a3}"
Ekspresi reguler: /\x{3a3}/

String: "\x{1d45b}"
Ekspresi reguler: /\x{1d45b}/

# bahkan rentang non-BMP dalam regex berfungsi dengan baik
/[\x{1H434}-\x{1H467}]/

X 6: Dapatkan karakter nama by jumlah
gunakan charname();
$nama saya = nama panggilan::melalui kode(0x03A3);

X 7: Dapatkan karakter jumlah by nama
gunakan charname();
my $number = charnames::vianame("GREEK CAPITAL LETTER SIGMA");

X 8: Unicode bernama karakter
Gunakan "\N{nama karakter}" notasi untuk mendapatkan karakter dengan nama itu untuk digunakan dalam interpolasi
literal (string dan regex yang dikutip ganda). Di v5.16, ada implisit

gunakan charnames qw(:full :short);

Tetapi sebelum v5.16, Anda harus eksplisit tentang set charname mana yang Anda inginkan. NS
Nama ":full" adalah nama karakter Unicode resmi, alias, atau urutan, yang semuanya dibagikan
sebuah ruang nama.

gunakan charnames qw(:full :short latin greek);

"\N{MATHEMATICAL ITALIC SMALL N}" # :full
"\N{GREEK CAPITAL LETTER SIGMA}" # :penuh

Yang lainnya adalah singkatan kenyamanan khusus Perl. Tentukan satu atau lebih skrip dengan
nama jika Anda menginginkan nama pendek yang spesifik untuk skrip.

"\N{Yunani:Sigma}" # :short
"\N{ae}" # latin
"\N{epsilon}" # yunani

Rilis v5.16 juga mendukung impor ":loose" untuk pencocokan longgar nama karakter,
yang berfungsi seperti pencocokan longgar nama properti: yaitu, mengabaikan kasus,
spasi, dan menggarisbawahi:

"\N{tanda euro}" # :loose (dari v5.16)

X 9: Unicode bernama urutan
Ini terlihat seperti nama karakter tetapi mengembalikan beberapa titik kode. Perhatikan %vx
fungsi vektor-cetak di "printf".

gunakan charnames qw(:full);
my $seq = "\N{Huruf KAPITAL LATIN A DENGAN MACRON DAN KUburan}";
printf "U+%v04X\n", $seq;
U + 0100.0300

X 10: Kustom bernama karakter
Gunakan ":alias" untuk memberikan nama panggilan Anda sendiri secara leksikal ke karakter yang ada, atau bahkan
untuk memberi nama yang berguna untuk karakter penggunaan pribadi yang tidak disebutkan namanya.

gunakan charnames ":full", ":alias" => {
ecute => "Huruf KECIL LATIN E DENGAN AKUT",
"LOGO APPLE" => 0xF8FF, # karakter penggunaan pribadi
};

"\N{ecute}"
"\N{LOGO APLIKASI}"

X 11: nama of CJK titik kode
Sinogram seperti XXXX kembali dengan nama karakter "CJK UNIFIED IDEOGRAPH-6771" dan
"CJK UNIFIED IDEOGRAPH-4EAC", karena XnamesX-nya bervariasi. CPAN "Unicode::Unihan"
modul memiliki database besar untuk mendekode ini (dan lebih banyak lagi), asalkan Anda tahu
bagaimana memahami outputnya.

# cpan -i Unicode::Unihan
gunakan Unicode::Unihan;
$str saya = "XX";
my $unhan = Unicode::Unihan->new;
untuk $lang saya (qw(Mandarin Cantonese Korean JapaneseOn JapaneseKun)) {
printf "CJK $str dalam %-12s adalah ", $lang;
katakan $unhan->$lang($str);
}

cetakan:

CJK XX dalam bahasa Mandarin adalah DONG1JING1
CJK XX dalam bahasa Kanton adalah dung1ging1
CJK XX dalam bahasa Korea adalah TONGKYENG
CJK XX di JapaneseOn adalah TOUKYOU KEI KIN
CJK XX dalam bahasa JepangKun adalah HIGASHI AZUMAMIYAKO

Jika Anda memiliki skema romanisasi tertentu, gunakan modul spesifik:

# cpan -i Lingua::JA::Romanize::Jepang
gunakan Lingua::JA::Romanize::Jepang;
my $k2r = Lingua::JA::Romanize::Japanese->new;
$str saya = "XX";
say "Bahasa Jepang untuk $str adalah ", $k2r->chars($str);

cetakan

Bahasa Jepang untuk XX adalah toukyou

X 12: Eksplisit enkode/dekode
Pada kesempatan yang jarang terjadi, seperti pembacaan basis data, Anda mungkin diberikan teks yang disandikan yang Anda perlukan
membaca sandi.

gunakan Encode qw(encode decode);

my $chars = decode("shiftjis", $bytes, 1);
# ATAU
my $bytes = encode("MIME-Header-ISO_2022_JP", $chars, 1);

Untuk semua aliran dalam penyandian yang sama, jangan gunakan enkode/dekode; alih-alih atur file
penyandian saat Anda membuka file atau segera setelahnya dengan "binmode" seperti yang dijelaskan nanti
di bawah.

X 13: Membaca sandi program argumen as utf8
$perl-CA...
or
$ ekspor PERL_UNICODE=A
or
gunakan Enkode qw(decode_utf8);
@ARGV = peta { decode_utf8($_, 1) } @ARGV;

X 14: Membaca sandi program argumen as Lokal encoding
# cpan -i Encode::Lokal
gunakan Enkode qw(lokal);
gunakan Encode::Lokal;

# gunakan "locale" sebagai argumen untuk menyandikan/mendekode
@ARGV = peta { decode(locale => $_, 1) } @ARGV;

X 15: Menyatakan STD{Masuk,Keluar,ERR} untuk be utf8
Gunakan opsi baris perintah, variabel lingkungan, atau panggil "binmode" secara eksplisit:

$perl-CS...
or
$ ekspor PERL_UNICODE=S
or
gunakan buka qw(:std :utf8);
or
binmode(STDIN, ":utf8");
binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");

X 16: Menyatakan STD{Masuk,Keluar,ERR} untuk be in Lokal encoding
# cpan -i Encode::Lokal
gunakan Enkode;
gunakan Encode::Lokal;

# atau sebagai aliran untuk binmode atau buka
binmode STDIN, ":encoding(console_in)" jika -t STDIN;
binmode STDOUT, ":encoding(console_out)" jika -t STDOUT;
binmode STDERR, ":encoding(console_out)" jika -t STDERR;

X 17: Membuat fillet I / O kegagalan untuk utf8
File yang dibuka tanpa argumen encoding akan berada di UTF-8:

$perl-CD...
or
$ ekspor PERL_UNICODE=D
or
gunakan buka qw(:utf8);

X 18: Membuat semua I / O dan args kegagalan untuk utf8
$perl-CSDA...
or
$ ekspor PERL_UNICODE=SDA
or
gunakan buka qw(:std :utf8);
gunakan Enkode qw(decode_utf8);
@ARGV = peta { decode_utf8($_, 1) } @ARGV;

X 19: Open fillet dengan tertentu encoding
Tentukan encoding streaming. Ini adalah cara normal untuk menangani teks yang disandikan, bukan dengan menelepon
fungsi tingkat rendah.

# masukan file
open($in_file saya, "< :encoding(UTF-16)", "wintext");
OR
open($in_file saya, "<", "wintext");
binmode($in_file, ":encoding(UTF-16)");
DULU
$baris saya = <$in_file>;

# berkas keluaran
open($out_file, "> :encoding(cp1252)", "wintext");
OR
buka($out_file saya, ">", "wintext");
binmode($out_file, ":encoding(cp1252)");
DULU
print $out_file "beberapa teks\n";

Lebih banyak lapisan daripada hanya pengkodean dapat ditentukan di sini. Misalnya, mantra
":raw :encoding(UTF-16LE) :crlf" termasuk penanganan CRLF implisit.

X 20: Unicode selubung
Casing Unicode sangat berbeda dengan casing ASCII.

uc("henry X") # "HENRY X"
uc("tschuess") # pemberitahuan "TSCHUESS" ss => SS

# keduanya benar:
"tschuess" =~ /TSCHUeSS/i # pemberitahuan ss => SS
"XXXXXXX" =~ /XXXXXXX/i # perhatikan X,X,X kesamaan

X 21: Unicode case-insensitive perbandingan
Juga tersedia di modul CPAN Unicode::CaseFold, fungsi XfoldcaseX "fc" baru dari
v5.16 memberikan akses ke casefolding Unicode yang sama seperti yang dimiliki oleh pengubah pola "/i"
selalu digunakan:

gunakan fitur "fc"; # fungsi fc() berasal dari v5.16

# mengurutkan peka huruf besar/kecil
saya @diurutkan = urutkan { fc($a) cmp fc($b) } @daftar;

# keduanya benar:
fc("tschuess") eq fc("TSCHueSS")
fc("XXXXXXX") eq fc("XXXXXXX")

X 22: Cocok Unicode jeda baris urutan in regex
Linebreak Unicode cocok dengan grafem CRLF dua karakter atau salah satu dari tujuh vertikal
karakter spasi putih. Baik untuk menangani file teks yang berasal dari operasi yang berbeda
sistem.

\R

s/\R/\n/g; # normalkan semua jeda baris ke \n

X 23: Dapatkan karakter kategori
Temukan kategori umum dari titik kode numerik.

gunakan Unicode::UCD qw(charinfo);
$kucingku = informasi(0x3A3)->{kategori}; # "Lu"

X 24: Menonaktifkan Kesadaran Unicode in builtin kelas karakter
Nonaktifkan "\w", "\b", "\s", "\d", dan kelas POSIX agar tidak berfungsi dengan benar di Unicode
baik dalam lingkup ini, atau hanya dalam satu ekspresi reguler.

gunakan v5.14;
gunakan re "/a";

# ATAU

saya($angka) = $str =~ /(\d+)/a;

Atau gunakan properti un-Unicode tertentu, seperti "\p{ahex}" dan "\p{POSIX_Digit"}. Properti
masih bekerja secara normal tidak peduli apa pengubah charset ("/d /u /l /a /aa") harus berpengaruh.

X 25: Cocok Unicode properties in regex dengan \P, \P
Ini semua cocok dengan satu titik kode dengan properti yang diberikan. Gunakan "\P" sebagai ganti "\p" untuk
cocokkan satu codepoint yang tidak memiliki properti itu.

\pL, \pN, \pS, \pP, \pM, \pZ, \pC
\p{Sk}, \p{Ps}, \p{Lt}
\p{alfa}, \p{atas}, \p{bawah}
\p{Latin}, \p{Yunani}
\p{script=Latin}, \p{script=Yunani}
\p{East_Asian_Width=Lebar}, \p{EA=W}
\p{Line_Break=Tanda hubung}, \p{LB=HY}
\p{Nilai_Numerik=4}, \p{NV=4}

X 26: Kustom karakter properties
Tentukan pada waktu kompilasi properti karakter kustom Anda sendiri untuk digunakan dalam regex.

# menggunakan karakter penggunaan pribadi
sub In_Tengwar { "E000\tE07F\n" }

if (/\p{Dalam_Tengwar}/) { ... }

# memadukan properti yang ada
sub Is_GraecoRoman_Title {<<'END_OF_SET'}
+utf8::ApakahLatin
+utf8::IsYunani
&utf8::IsTitle
END_OF_SET

jika (/\p{Is_GraecoRoman_Title}/ { ... }

X 27: Unicode normalisasi
Biasanya dirender menjadi NFD pada input dan NFC pada output. Menggunakan fungsi NFKC atau NFKD
meningkatkan ingatan pada pencarian, dengan asumsi Anda telah melakukan pencarian teks yang sama.
Perhatikan bahwa ini lebih dari sekadar mesin terbang kompatibilitas pra-gabungan; juga
menyusun ulang tanda menurut kelas penggabungan kanonik mereka dan menyingkirkan lajang.

gunakan Unicode::Normalkan;
$nfd saya = NFD($asal);
$nfc saya = NFC($asal);
$nfkd saya = NFKD($asal);
$nfkc saya = NFKC($asal);

X 28: mengubah non-ASCII Unicode angka
Kecuali Anda telah menggunakan "/a" atau "/aa", "\d" hanya cocok dengan lebih dari digit ASCII, tetapi PerlXs
konversi string-ke-angka implisit saat ini tidak mengenali ini. Begini caranya
mengkonversi string tersebut secara manual.

gunakan v5.14; # diperlukan untuk fungsi num()
gunakan Unicode::UCD qw(num);
my $str = "dapatkan X dan XXXX dan X dan di sini";
@angka saya = ();
while ($str =~ /(\d+|\N)/g) { # bukan hanya ASCII!
tekan @angka, angka($1);
}
katakan "@angka"; #12 4567 0.875

gunakan charnames qw(:full);
my $nv = num("\N{RUMI DIGIT SATU}\N{RUMI DIGIT DUA}");

X 29: Cocok Unicode grafem kelompok in regex
XcharactersX yang terlihat oleh pemrogram adalah titik kode yang dicocokkan dengan "/./s", tetapi terlihat oleh pengguna
XcharactersX adalah grafem yang dicocokkan dengan "/\X/".

# Temukan vokal *plus* kombinasi diakritik, garis bawah, dll.
$nfd saya = NFD($asal);
$nfd =~ / (?=[aeiou]) \X /xi

X 30: Ekstrak by grafem sebagai gantinya of by titik kode (ekspresi reguler)
# cocokkan dan ambil lima grafem pertama
my($first_five) = $str =~ /^ ( \X{5} ) /x;

X 31: Ekstrak by grafem sebagai gantinya of by titik kode (substr)
# cpan -i Unicode::GCString
gunakan Unicode::GCString;
$gcs saya = Unicode::GCString->new($str);
my $first_five = $gcs->substr(0, 5);

X 32: Membalikkan string by grafem
Membalik dengan codepoint mengacaukan diakritik, salah mengubah "creme brulee" menjadi
"eelXurb emXerc" alih-alih menjadi "eelurb emerc"; jadi terbalik dengan grapheme sebagai gantinya. Keduanya
pendekatan ini berfungsi dengan benar, apa pun normalisasi string:

$str = join("", terbalik $str =~ /\X/g);

# ATAU: cpan -i Unicode::GCString
gunakan Unicode::GCString;
$str = membalikkan Unicode::GCString->new($str);

X 33: String panjangnya in grapheme
String "brulee" memiliki enam grafem tetapi hingga delapan titik kode. Ini dihitung dengan
grapheme, bukan dengan codepoint:

$str saya = "brulee";
$hitungan saya = 0;
while ($str =~ /\X/g) { $hitung++ }

# ATAU: cpan -i Unicode::GCString
gunakan Unicode::GCString;
$gcs saya = Unicode::GCString->new($str);
$count saya = $gcs->length;

X 34: Unicode lebar kolom untuk cetak
PerlXs "printf", "sprintf", dan "format" menganggap semua codepoint mengambil 1 kolom cetak, tetapi
banyak yang mengambil 0 atau 2. Di sini untuk menunjukkan bahwa normalisasi tidak ada bedanya, kami mencetak keduanya
formulir:

gunakan Unicode::GCString;
gunakan Unicode::Normalkan;

@kata-kata saya = qw/creme brulee/;
@kata = peta { NFC($_), NFD($_) } @kata;

untuk $strku (@words) {
$gcs saya = Unicode::GCString->new($str);
my $cols = $gcs->columns;
$pad saya = " " x (10 - $kol);
katakan str, $pad, " |";
}

menghasilkan ini untuk menunjukkan bahwa itu terpasang dengan benar terlepas dari normalisasi:

krim |
creXme |
brulee |
bruXleXe |

X 35: Unicode pemeriksaan
Teks yang diurutkan berdasarkan codepoint numerik tidak mengikuti urutan abjad yang masuk akal; gunakan UCA untuk
menyortir teks.

gunakan Unicode::Collate;
my $col = Unicode::Collate->new();
@daftar saya = $col->sort(@old_list);

Lihat ucsort program dari modul Unicode::Tussle CPAN untuk baris perintah yang nyaman
antarmuka ke modul ini.

X 36: Kasus- dan tidak peka aksen Unicode jenis
Tentukan kekuatan susunan level 1 untuk mengabaikan kasus dan diakritik, hanya dengan melihat
karakter dasar.

gunakan Unicode::Collate;
my $col = Unicode::Collate->new(level => 1);
@daftar saya = $col->sort(@old_list);

X 37: Unicode Lokal pemeriksaan
Beberapa lokal memiliki aturan penyortiran khusus.

# gunakan v5.12, ATAU: cpan -i Unicode::Collate::Locale
gunakan Unicode::Collate::Locale;
my $col = Unicode::Collate::Locale->new(locale => "de__phonebook");
@daftar saya = $col->sort(@old_list);

ucsort program yang disebutkan di atas menerima parameter "--locale".

X 38: Membuat "cmp" kerja on teks sebagai gantinya of titik kode
Alih-alih ini:

@srecs = urutkan {
$b->{AGE} <=> $a->{AGE}
||
$a->{NAME} cmp $b->{NAME}
} @rek;

Gunakan ini:

$coll saya = Unicode::Collate->new();
untuk $rec saya (@recs) {
$rec->{NAME_key} = $coll->getSortKey( $rec->{NAME} );
}
@srecs = urutkan {
$b->{AGE} <=> $a->{AGE}
||
$a->{NAME_key} cmp $b->{NAME_key}
} @rek;

X 39: Kasus- dan tidak peka aksen perbandingan
Gunakan objek collator untuk membandingkan teks Unicode berdasarkan karakter, bukan berdasarkan codepoint.

gunakan Unicode::Collate;
$es saya = Unicode::Collate->new(
tingkat => 1,
normalisasi => undef
);

# sekarang keduanya benar:
$es->eq("Garcia", "GARCIA" );
$es->eq("Marquez", "MARQUEZ");

X 40: Kasus- dan tidak peka aksen Lokal perbandingan
Sama, tetapi di lokal tertentu.

$de saya = Unicode::Collate::Locale->new(
lokal => "de__buku telepon",
);

# sekarang ini benar:
$de->eq("tschuess", "TSCHUESS"); # pemberitahuan ue => UE, ss => SS

X 41: Unicode terobosan
Memecah teks menjadi beberapa baris sesuai dengan aturan Unicode.

# cpan -i Unicode::LineBreak
gunakan Unicode::LineBreak;
gunakan charnames qw(:full);

my $para = "Ini adalah string super\N{HYPHEN}panjang. " x 20;
my $fmt = Unicode::LineBreak->new;
print $fmt->break($para), "\n";

X 42: Unicode teks in DBM hash, itu membosankan cara
Menggunakan string Perl biasa sebagai kunci atau nilai untuk hash DBM akan memicu karakter lebar
pengecualian jika ada codepoint yang tidak sesuai dengan satu byte. Inilah cara mengelola secara manual
terjemahan:

gunakan DB_File;
gunakan Encode qw(encode decode);
ikat %dbhash, "DB_File", "nama jalur";

# TOKO

# asumsikan $uni_key dan $uni_value adalah string Unicode abstrak
my $enc_key = encode("UTF-8", $uni_key, 1);
my $enc_value = encode("UTF-8", $uni_value, 1);
$dbhash{$enc_key} = $enc_nilai;

# MENGAMBIL

# asumsikan $uni_key memegang string Perl normal (abstrak Unicode)
my $enc_key = encode("UTF-8", $uni_key, 1);
$enc_value saya = $dbhash{$enc_key};
my $uni_value = decode("UTF-8", $enc_value, 1);

X 43: Unicode teks in DBM hash, itu Mudah cara
Inilah cara mengelola terjemahan secara implisit; semua encoding dan decoding selesai
secara otomatis, seperti halnya aliran yang memiliki penyandian tertentu yang melekat padanya:

gunakan DB_File;
gunakan DBM_Filter;

my $dbobj = ikat %dbhash, "DB_File", "pathname";
$dbobj->Filter_Value("utf8"); # ini adalah bagian ajaibnya

# TOKO

# asumsikan $uni_key dan $uni_value adalah string Unicode abstrak
$dbhash{$uni_key} = $uni_nilai;

# MENGAMBIL

# $uni_key memegang string Perl normal (abstrak Unicode)
$uni_value saya = $dbhash{$uni_key};

X 44: PROGRAM: Demo of Unicode pemeriksaan dan cetak
Berikut adalah program lengkap yang menunjukkan cara menggunakan penyortiran peka-lokal, casing Unicode,
dan mengelola lebar cetak ketika beberapa karakter mengambil nol atau dua kolom, bukan
hanya satu kolom setiap kali. Saat dijalankan, program berikut menghasilkan ini selaras dengan baik
keluaran:

Creme Brulee ....... X2.00
Eclair.............. X1.60
Fideua.............. X4.20
Hamburger.......... X6.00
Jamon Serrano......X4.45
Linguika........... X7.00
Patah............... X4.15
Pir ............. X2.00
Persik............. X2.25
Smorbrod...........X5.75
Spaetzle............X5.50
Xorico.............X3.00
XXXXXX.............. X6.50
XXX............X4.00
XXX............X2.65
XXXXX.........X8.00
XXXXXXX..... X1.85
XX............X9.99
XX............X7.50

Ini dia programnya; diuji pada v5.14.

#!/usr/bin/env perl
# umenu - demo penyortiran dan pencetakan makanan Unicode
#
# (pembukaan wajib dan semakin panjang)
#
gunakan utf8;
gunakan v5.14; # untuk penyortiran lokal
gunakan ketat;
gunakan peringatan;
gunakan peringatan qw(FATAL utf8); # mematikan kesalahan penyandian
gunakan buka qw(:std :utf8); # aliran tidak dideklarasikan di UTF-8
gunakan charnames qw(:full :short); # tidak dibutuhkan di v5.16

# modul std
gunakan Unicode::Normalkan; # std perl distro pada v5.8
gunakan Daftar::Util qw(maks); # std perl distro pada v5.10
gunakan Unicode::Collate::Locale; # std perl distro pada v5.14

# modul cpan
gunakan Unicode::GCString; # dari CPAN

# pertahanan depan
subpad($$$);
sub lebar kolom(_);
sub judul(_);

%harga saya = (
"XXXXX" => 6.50, # gyro
"pir" => 2.00, # seperti um, pir
"linguica" => 7.00, # sosis pedas, Portugis
"xorico" => 3.00, # sosis chorizo, Katalan
"hamburger" => 6.00, # burgermeister meisterburger
"eclair" => 1.60, # makanan penutup, Prancis
"smorbrod" => 5.75, # sandwich, Norwegia
"spaetzle" => 5.50, # mie bayerisch, burung pipit kecil
"XX" => 7.50, # bao1 zi5, bakpao babi kukus, Mandarin
"jamon serrano" => 4.45, # ham pedesaan, Spanyol
"peches" => 2.25, # buah persik, Prancis
"XXXXXXX" => 1.85, # kue isi krim seperti eclair
"XXX" => 4.00, # makgeolli, anggur beras Korea
"XX" => 9.99, # sushi, Jepang
"XXX" => 2.65, # omochi, kue beras, Jepang
"creme brulee" => 2.00, # crema catalana
"fideua" => 4.20, # mie lagi, Valencian
# (Katalan=fideuada)
"pate" => 4.15, # pasta hati angsa, Prancis
"XXXXX" => 8.00, # okonomiyaki, Jepang
);

my $width = 5 + max map { colwidth } kunci %price;

# Jadi barang-barang Asia keluar dalam urutan seseorang
# siapa yang membaca skrip itu tidak akan panik; NS
# Barang CJK akan di order JIS X 0208 seperti itu.
$coll saya = Unicode::Collate::Locale->new(locale => "ja");

untuk $item ($coll->sort(keys %price)) saya {
print pad(entitle($item), $lebar, ".");
printf " X%.2f\n", $harga{$barang};
}

subpad($$$) {
my($str, $lebar, $padchar) = @_;
kembali $str . ($padchar x ($lebar - colwidth($str)));
}

sub lebar kolom(_) {
saya($str) = @_;
kembalikan Unicode::GCString->new($str)->kolom;
}

sub judul(_) {
saya($str) = @_;
$str =~ s{ (?=\pL)(\S) (\S*) }
{ ucpertama($1) . lc($2) }xge;
kembali $str;
}

Gunakan perlunicook online menggunakan layanan onworks.net