#!/usr/bin/env perl
# umenu - demo de ordenación e impresión de comida Unicode
#
# (obligatorio y, cada vez más largo, preámbulo)
#
use utf8;
use v5.14; # para la ordenación según la configuración regional y unicode_strings
use strict;
use warnings;
use warnings qw(FATAL utf8); # hace fatales los fallos de codificación
use open qw(:std :utf8); # los flujos estándar de E/S, en UTF-8
use charnames qw(:full :short); # innecesario en v5.16
# módulos estándar
use Unicode::Normalize; # estándar en la distribución perl v5.8
use List::Util qw(max); # estándar en la distribución perl v5.10
use Unicode::Collate::Locale; # estándar en la distribución perl v5.14
# módulos cpan
use Unicode::GCString; # desde CPAN
# declaraciones previas
sub relleno($$$);
sub anchocol(_);
sub titula(_);
my %precio = (
"γύρος" => 6.50, # gyros, Griego
"pears" => 2.00, # like um, pears
"linguiça" => 7.00, # spicy sausage, Portuguese
"xoriço" => 3.00, # chorizo sausage, Catalan
"hamburger" => 6.00, # burgermeister meisterburger
"éclair" => 1.60, # dessert, French
"smørbrød" => 5.75, # sandwiches, Norwegian
"spätzle" => 5.50, # Bayerisch noodles, little sparrows
"包子" => 7.50, # bao1 zi5, steamed pork buns, Mandarin
"jamón serrano" => 4.45, # country ham, Spanish
"pêches" => 2.25, # peaches, French
"シュークリーム" => 1.85, # cream-filled pastry like éclair, Japanese
"막걸리" => 4.00, # makgeolli, Korean rice wine
"寿司" => 9.99, # sushi, Japanese
"おもち" => 2.65, # omochi, rice cakes, Japanese
"crème brûlée" => 2.00, # tasty broiled cream, French
"fideuà" => 4.20, # more noodles, Valencian (Catalan=fideuada)
"pâté" => 4.15, # gooseliver paste, French
"お好み焼き" => 8.00, # okonomiyaki, Japanese
);
# busca el mayor ancho permitido para la columna del nombre
my $ancho = 5 + max map { anchocol } keys %precio;
# So the Asian stuff comes out in an order that someone
# who reads those scripts won't freak out over; the
# CJK stuff will be in JIS X 0208 order that way.
my $cotejo = Unicode::Collate::Locale->new( locale => "ja" );
for my $item ($cotejo->sort(keys %precio)) {
print relleno(titula($item), $ancho, ".");
printf " €%.2f\n", $precio{$item};
}
sub relleno($$$) {
my($cadena, $ancho, $rellenocar) = @_;
return $cadena . ($rellenocar x ($ancho - anchocol($cadena)));
}
sub anchocol(_) {
my($cadena) = @_;
return Unicode::GCString->new($cadena)->columns;
}
sub titula(_) {
my($cadena) = @_;
$cadena =~ s{ (?=\pL)(\S) (\S*) }
{ ucfirst($1) . lc($2) }xge;
return $cadena;
}
