TER1 (Statement): 98.53%
TER2 (Branch): 87.50%
TER3 (LCSAJ): 83.3% (5/6)
Approximate LCSAJ segments: 41
● Covered — this LCSAJ path was executed during testing.
● Not covered — this LCSAJ path was never executed. These are the paths to focus on.
Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:
start → end → jump
Uncovered paths show [NOT COVERED] in the tooltip.
1: package App::Access2CSV::I18N; 2: 3: use strict; 4: use warnings; 5: use autodie qw(:all); 6: 7: # Sub::Private must be switched to enforce mode before it is loaded, 8: # otherwise it falls back to namespace mode, which breaks OO dispatch 9: BEGIN { $Sub::Private::config{mode} = 'enforce' } 10: 11: use Carp qw(carp confess croak); 12: use Config; 13: use Params::Get qw(get_params); 14: use Params::Validate::Strict qw(validate_strict); 15: use Readonly; 16: use Return::Set qw(set_return); 17: use Sub::Private; 18: use Sub::Protected; 19: 20: our $VERSION = '0.001.0'; 21: 22: # The wrappers installed by Sub::Private/Sub::Protected add stack frames; 23: # listing them here stops Carp from blaming the wrapper for our errors 24: our @CARP_NOT = qw(Sub::Private Sub::Protected); 25: 26: # Catalog used when no better match for the user's locale exists 27: Readonly::Scalar my $DEFAULT_LANGUAGE => 'en'; 28: 29: # Locale values that mean "no preference" rather than a real language 30: Readonly::Hash my %NEUTRAL_LOCALES => (C => 1, POSIX => 1); 31: 32: # Environment variables consulted, most specific first (GNU gettext order) 33: Readonly::Array my @LOCALE_VARIABLES => qw(LANGUAGE LC_ALL LC_MESSAGES LANG); 34: 35: # Characters that a terminal or log viewer would act on rather than show: 36: # C0 controls except tab (ESC starts escape sequences, CR overwrites the 37: # line, LF forges new log lines, BEL rings), DEL, and the invisible 38: # text-direction controls. C1 controls are matched as characters in 39: # Perl character strings and as their UTF-8 bytes in byte strings. 40: # 41: # One character class (faster than alternatives), made of these ranges: 42: # \x00-\x08 \x0A-\x1F C0 controls, except tab (\x09) 43: # \x7F DEL 44: # \x{80}-\x{9F} C1 controls (U+009B works like ESC [) 45: # \x{200E}\x{200F} left-to-right and right-to-left marks 46: # \x{202A}-\x{202E} embeddings and overrides (U+202E is RLO) 47: # \x{2066}-\x{2069} isolates 48: # (No spaces or comments inside the brackets: /x does not apply there.) 49: Readonly::Scalar my $UNPRINTABLE_RE => 50: qr/[\x00-\x08\x0A-\x1F\x7F\x{80}-\x{9F}\x{200E}\x{200F}\x{202A}-\x{202E}\x{2066}-\x{2069}]/; 51: Readonly::Scalar my $UNPRINTABLE_BYTES_RE => qr/ 52: [\x00-\x08\x0A-\x1F\x7F] # C0 controls except tab, and DEL 53: | \xC2 [\x80-\x9F] # C1 controls, UTF-8 encoded 54: | \xE2 \x80 [\x8E\x8F\xAA-\xAE] # LRM, RLM, embeddings, overrides 55: | \xE2 \x81 [\xA6-\xA9] # isolates 56: /x; 57: 58: # Coverage: Devel::Cover finds code through the symbol table, but in 59: # enforce mode Sub::Private and Sub::Protected replace every private and 60: # protected sub there with a wrapper (at CHECK time), so the real subs 61: # would never appear in coverage reports. Only when Devel::Cover is 62: # loaded, give each sub of this distribution a second name, in a package 63: # nothing calls, before the wrapping happens. CHECK blocks run 64: # last-defined first, so this one runs before the attribute handlers'. 65: Readonly::Array my @OWN_PACKAGES => qw(App::Access2CSV App::Access2CSV::Exporter App::Access2CSV::I18N); 66: Readonly::Scalar my $UNWRAPPED => 'App::Access2CSV::_Unwrapped'; 67: 68: CHECK { ●[NOT COVERED] 69 → 69 → 0 69: if($INC{'Devel/Cover.pm'}) {70: require B; 71: no strict 'refs'; 72: foreach my $package (@OWN_PACKAGES) { 73: foreach my $name (keys %{"${package}::"}) { 74: my $code = *{"${package}::$name"}{CODE} or next; 75: # Only subs written in this package, not imported ones 76: next unless B::svref_2object($code)->GV->STASH->NAME eq $package; 77: *{"${UNWRAPPED}::${package}::$name"} = $code; 78: } 79: } 80: } 81: } 82: 83: # Signals that mean "stop now": Ctrl-C is INT, Ctrl-\ is QUIT; TERM and 84: # HUP come from kill, service managers and closed terminals 85: Readonly::Array my @INTERRUPT_SIGNALS => qw(INT QUIT TERM HUP); 86: 87: # Plural category used when a language has no rule of its own 88: Readonly::Scalar my $PLURAL_OTHER => 'other'; 89: 90: # CLDR-style plural rules. Each returns the category name for a count. 91: # Only languages whose rule differs from English need an entry here. 92: Readonly::Hash my %PLURAL_RULES => ( 93: en => sub { $_[0] == 1 ? 'one' : 'other' },Mutants (Total: 1, Killed: 0, Survived: 1)
- COND_INV_69_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomesMutants (Total: 1, Killed: 1, Survived: 0)
94: de => sub { $_[0] == 1 ? 'one' : 'other' },
Mutants (Total: 1, Killed: 1, Survived: 0)
95: fr => sub { ($_[0] == 0 || $_[0] == 1) ? 'one' : 'other' },
Mutants (Total: 1, Killed: 1, Survived: 0)
96: ja => sub { 'other' }, 97: ko => sub { 'other' }, 98: zh => sub { 'other' }, 99: ); 100: 101: # Message catalog: language => key => template. 102: # A template is either a sprintf() format, or a hashref whose keys are 103: # contexts (for example 'male'/'female') and/or plural categories 104: # ('zero', 'one', 'two', 'few', 'many', 'other'). 105: # It is a package variable, not Readonly, so that applications and 106: # Object::Configure style configuration can add languages or override text. 107: our %MESSAGES = ( 108: en => { 109: column_output => 'OUTPUT FILE', 110: column_rows => 'ROWS', 111: column_table => 'TABLE', 112: count_unreadable => 'mdb-count printed no number: "%s"', 113: count_failed => 'Cannot count the rows of %s: %s', 114: database_not_file => 'Database %s is not a regular file', 115: database_not_found => 'Cannot read database %s: %s', 116: database_unreadable => 'Database %s is not readable', 117: dry_run_title => 'DRY RUN', 118: export_failed => 'FAILED: %s: %s', 119: exported => 'Exported %s => %s', 120: exported_rows => { 121: one => 'Exported %s => %s (%d row)', 122: other => 'Exported %s => %s (%d rows)', 123: }, 124: fatal => 'access2csv: %s', 125: invalid_name => 'the name contains a NUL byte', 126: interrupted_reading => 'Interrupted by SIG%s while reading the database from standard input', 127: interrupted => 'Interrupted by SIG%s: stopped, and the table being exported was discarded', 128: invalid_setting => 'Invalid setting: %s', 129: invalid_utf8 => 'Table %s, line %d: output of mdb-export is not valid UTF-8', 130: log_failed => 'Cannot write to the log: %s', 131: log_is_symlink => 'it is a symbolic link', 132: log_open_failed => 'Cannot open log file %s: %s', 133: logger_unavailable => 'no logger was created', 134: missing_database => 'Missing database filename', 135: needs_object => 'run() must be called on an object created by new()', 136: mkdir_failed => 'Cannot create output directory %s: %s', 137: no_row_counter => 'mdb-count not found in PATH; row counts are unavailable', 138: output_exists => 'Output file already exists: %s (use --overwrite to replace it)', 139: program_failed => '%s failed with exit status %d: %s', 140: program_found => 'Found %s at %s', 141: program_missing => 'Required program not found in PATH: %s', 142: program_not_run => '%s could not be run: %s', 143: program_signalled => '%s was killed by signal %d', 144: progress => '[%d/%d] %s', 145: summary => { 146: one => 'Processed %d table, %d failed', 147: other => 'Processed %d tables, %d failed', 148: }, 149: stdin_empty => 'Standard input is empty: no database was piped in', 150: stdin_is_terminal => 'Standard input is a terminal: pipe the database in, or give its file name', 151: stdin_read_failed => 'Cannot read standard input: %s', 152: version => 'access2csv version %s', 153: unknown_message => 'Unknown message key: %s', 154: unknown_tables => { 155: one => 'Table not found in database: %s', 156: other => 'Tables not found in database: %s', 157: }, 158: unmappable => 'Table %s, line %d: cannot be represented in %s', 159: write_failed => 'Cannot write %s: %s', 160: }, 161: ); 162: 163: =encoding utf8 164: 165: =head1 NAME 166: 167: App::Access2CSV::I18N - Message catalog and translated error messages for App::Access2CSV 168: 169: =head1 VERSION 170: 171: Version 0.001.0 172: 173: =head1 SYNOPSIS 174: 175: use App::Access2CSV::I18N; 176: 177: # 1. Get a message as text 178: my $text = App::Access2CSV::I18N->i18n('missing_database'); 179: # "Missing database filename" 180: 181: # 2. Fill in values (the message has %s and %d placeholders) 182: print App::Access2CSV::I18N->i18n('progress', { params => [1, 3, 'Customers'] }), "\n"; 183: # "[1/3] Customers" 184: 185: # 3. Let the count choose between singular and plural 186: print App::Access2CSV::I18N->i18n('summary', { params => [$n, 0], count => $n }), "\n"; 187: # $n == 1: "Processed 1 table, 0 failed" 188: # $n == 4: "Processed 4 tables, 0 failed" 189: 190: # 4. Add a translation. Keys you do not translate stay in English. 191: $App::Access2CSV::I18N::MESSAGES{de}{missing_database} = 192: 'Name der Datenbankdatei fehlt'; 193: $ENV{LANG} = 'de_DE.UTF-8'; 194: 195: # 5. Use it as a base class, to get i18n() and the error helpers 196: package My::Tool; 197: use parent 'App::Access2CSV::I18N'; 198: 199: sub check { 200: my ($self, $file) = @_; 201: $self->_croak_i18n('database_not_file', { params => [$file] }) unless -f $file; 202: return $self; 203: } 204: 205: =head1 DESCRIPTION 206: 207: Every message that App::Access2CSV prints, logs or throws is looked up 208: here, by a short name called a I<key> (for example C<output_exists>). 209: This keeps all the text in one place, so the program can be translated. 210: 211: The text for each key is a I<template>. A template is usually a 212: C<sprintf> format: C<%s> is replaced by a text value and C<%d> by a whole 213: number, in order. A template can also have different forms: 214: 215: =over 4 216: 217: =item * B<Plural forms>, chosen by a count: C<one> for one item, 218: C<other> for any other number. Some languages use more forms 219: (C<zero>, C<two>, C<few>, C<many>). 220: 221: =item * B<Context forms>, chosen by a word you give, such as C<male> or 222: C<female>. A context form can itself contain plural forms. 223: 224: =back 225: 226: The templates live in the hash C<%App::Access2CSV::I18N::MESSAGES>: 227: 228: %MESSAGES = ( 229: en => { 230: missing_database => 'Missing database filename', 231: summary => { 232: one => 'Processed %d table, %d failed', 233: other => 'Processed %d tables, %d failed', 234: }, 235: ... 236: }, 237: ); 238: 239: Only English (C<en>) is included. 240: 241: =head2 Which language is used 242: 243: =over 4 244: 245: =item 1. The C<language> field of the object, if you call C<i18n> on an 246: object that has one (for example 247: C<< App::Access2CSV::Exporter->new(language => 'en') >>). 248: 249: =item 2. Otherwise the first of these environment variables that is set 250: and is not C<C> or C<POSIX>: C<LANGUAGE>, C<LC_ALL>, C<LC_MESSAGES>, 251: C<LANG>. Only the language part is used: C<de_DE.UTF-8> means C<de>. 252: Upper or lower case does not matter. C<LANGUAGE> can hold a list such as 253: C<fr:de>; only the first entry is used. An empty value, or an empty 254: first entry (C<:de>), counts as "not set", so the next variable is tried. 255: 256: =item 3. If there is no catalog for that language, English is used. 257: 258: =back 259: 260: Inside a language, a key that has no translation falls back to the 261: English text, one key at a time. 262: 263: =head2 Helpers for subclasses 264: 265: Subclasses get two protected methods. They can be called only from this 266: class and its subclasses: 267: 268: =over 4 269: 270: =item * C<< $self->_croak_i18n($key, \%args) >> - throws an exception 271: (with L<Carp/croak>) with the translated message. It never returns. 272: 273: =item * C<< $self->_carp_i18n($key, \%args) >> - warns (with 274: L<Carp/carp>) with the translated message, with control characters 275: escaped. It returns C<$self>. 276: 277: =item * C<< $self->_printable($text) >> - returns C<$text> with control 278: characters (C0 except tab, DEL, C1, and text-direction controls) shown 279: as escapes such as C<\x1B>, so that text from an untrusted database is 280: safe to print or log. 281: 282: =back 283: 284: =head1 ENCODING 285: 286: =over 4 287: 288: =item * B<The English catalog> is plain ASCII. 289: 290: =item * B<Values in params> are copied into the message as they are. 291: Byte strings (such as UTF-8 file names from the command line) stay byte 292: strings, so non-ASCII text and emoji come out unchanged when printed. 293: 294: =item * B<Translations with non-ASCII text> (for example German C<ue> 295: written as one letter, or Japanese) must be Perl character strings: write 296: them in a source file with C<use utf8;>. Do not mix them with UTF-8 297: I<byte> strings in C<params>, or the bytes will be encoded a second time. 298: When you print such messages, give the output handle an encoding, for 299: example C<binmode(STDERR, ':encoding(UTF-8)')>, or Perl warns 300: "Wide character in print". 301: 302: =back 303: 304: =head1 COMMON PITFALLS 305: 306: =over 4 307: 308: =item * B<Percent signs.> A template with no C<params> is returned 309: exactly as written, so C<100%> is safe. But when you give C<params>, the 310: template goes through C<sprintf>, so a literal percent sign must be 311: written C<%%>. 312: 313: =item * B<Number of values.> Give exactly as many C<params> as the 314: template has placeholders. Too few gives a Perl "Missing argument" 315: warning; C<undef> in C<params> gives a "Use of uninitialized value" 316: warning. 317: 318: =item * B<No count means plural.> If you do not give C<count>, the 319: C<other> form is used, even if the number in C<params> is 1. 320: 321: =item * B<Replacing a key replaces all of its forms.> 322: C<%MESSAGES> is not merged in depth. If you set 323: C<< $MESSAGES{en}{summary} = 'Done' >>, the C<one> and C<other> forms of 324: C<summary> are gone. If a translation gives a plural hash, it should have 325: an C<other> form: when no form fits, the English text for that key is 326: used instead. 327: 328: =item * B<Unknown context.> A C<context> that the template does not have 329: is ignored; the plural forms (or the plain text) are used instead. 330: 331: =item * B<Unknown keys are fatal.> A key that is not in the English 332: catalog is a programming error: C<i18n> calls C<confess>, which stops the 333: program and prints a stack trace. 334: 335: =item * B<undef arguments.> C<undef> for C<args>, or for a field inside 336: the hashref form, is treated as "not given". C<undef> as the key is 337: reported as a missing key. 338: 339: =item * B<Load with use, not require.> The protection of C<_croak_i18n> 340: and C<_carp_i18n> is set up at compile time. After a run-time 341: C<require> it is missing, and Perl prints "Too late to run CHECK block". 342: 343: =back 344: 345: =head1 METHODS 346: 347: =head2 i18n 348: 349: =head3 Purpose 350: 351: Turn a message key into text in the user's language. Choose the right 352: context and plural form, then fill in the values. 353: 354: =head3 Arguments 355: 356: You can call C<i18n> on the class or on an object. There are two ways 357: to give the arguments: 358: 359: $obj->i18n($key, \%args); 360: $obj->i18n({ key => $key, args => \%args }); 361: 362: =over 4 363: 364: =item C<key> (string, required) 365: 366: The message key, for example C<'output_exists'>. 367: 368: =item C<args> (hash reference, optional) 369: 370: =over 4 371: 372: =item C<params> - an array reference of the values for the placeholders, 373: in order. 374: 375: =item C<count> - a whole number, 0 or more, that chooses the plural form. 376: 377: =item C<context> - a word that chooses a context form, for example 378: C<'female'>. 379: 380: =back 381: 382: =back 383: 384: =head3 Returns 385: 386: The message as a string, without a newline at the end. 387: 388: =head3 Side Effects 389: 390: None. It only reads C<%MESSAGES> and C<%ENV>. Your C<$@>, C<$!> and 391: C<$_> are left as they were. 392: 393: =head3 Usage 394: 395: my $text = $self->i18n('summary', { params => [3, 0], count => 3 }); 396: 397: =head3 EXAMPLE 398: 399: # "Output file already exists: out/Orders.csv (use --overwrite to replace it)" 400: my $msg = App::Access2CSV::I18N->i18n('output_exists', { params => ['out/Orders.csv'] }); 401: 402: # A message with context and plural forms 403: $App::Access2CSV::I18N::MESSAGES{en}{greeting} = { 404: female => { one => 'She sent %d letter', other => 'She sent %d letters' }, 405: other => 'They sent %d letters', 406: }; 407: print App::Access2CSV::I18N->i18n('greeting', 408: { params => [2], count => 2, context => 'female' }), "\n"; 409: # "She sent 2 letters" 410: 411: =head3 API SPECIFICATION 412: 413: =head4 Input 414: 415: { 416: key => { 417: type => 'string', 418: min => 1, 419: optional => 0, 420: }, 421: args => { 422: type => 'hashref', 423: optional => 1, 424: schema => { 425: params => { type => 'arrayref', optional => 1 }, 426: count => { type => 'integer', optional => 1, min => 0 }, 427: context => { type => 'string', optional => 1 }, 428: }, 429: }, 430: } 431: 432: Valid and invalid values (tested in F<t/domain.t>): 433: 434: key valid: a key in the English catalog 435: invalid: "" (1 character is the minimum), undef, a 436: reference, an unknown key (fatal: "Unknown message 437: key"), a known key with extra characters 438: count valid: whole numbers from 0 up (0 is the minimum; 2**53 439: works); undef means "no count" 440: invalid: -1 and below, fractions (1.5), words 441: edges: English and German: 1 is singular, 0 and 2 plural. 442: French: 0 and 1 singular. Japanese, Korean, 443: Chinese: always the "other" form 444: params any number of values, including none; each value is 445: copied into the text exactly, whether it is a Perl 446: character string or UTF-8 bytes (non-ASCII letters, 447: emoji, joined emoji, combining marks, right-to-left text) 448: context any string; one the template does not have (including "") 449: is ignored; a reference is invalid 450: language (from the environment) the first 2 or 3 letters, in any 451: case; 1 letter, non-ASCII letters, C and POSIX all mean 452: "no language" 453: 454: =head4 Output 455: 456: { 457: type => 'string', 458: } 459: 460: =head3 MESSAGES 461: 462: +-----------------------------+-------------------------------+---------------------------------+ 463: | Message | Meaning | What to do | 464: +-----------------------------+-------------------------------+---------------------------------+ 465: | Unknown message key: KEY | KEY is not in the English | Programming error: add KEY to | 466: | (fatal, with stack trace) | catalog | $MESSAGES{en} | 467: | Required parameter 'key' is | No key was given | Give a key | 468: | missing (fatal) | | | 469: | Unknown parameter 'X' | args has a field that is not | Use only params, count and | 470: | (fatal) | params, count or context | context | 471: | Parameter 'count' (X) must | count is negative or not a | Give a whole number, 0 or more | 472: | be ... (fatal) | whole number | | 473: | Parameter 'params' must be | params is not an array | Give an array reference | 474: | an arrayref (fatal) | reference | | 475: +-----------------------------+-------------------------------+---------------------------------+ 476: 477: =head3 PSEUDOCODE 478: 479: check key and args 480: lang := the object's language, or the language from the environment, 481: or English if there is no catalog for it 482: for try in (lang, then en if lang is not en): # at most 2 tries, no recursion 483: entry := catalog[try][key], or else catalog[en][key] 484: if entry has forms and one matches args.context: 485: entry := that form 486: if entry still has forms: 487: entry := the form for plural_category(try, count), 488: or else the "other" form 489: stop if entry is now a plain string 490: if no try gave a plain string: confess (the catalog is broken) 491: if there are params: return sprintf(entry, params) 492: else: return entry unchanged 493: 494: =cut 495: 496: sub i18n { ●497 → 533 → 541 497: my $self = shift; 498: 499: # Validation uses eval internally; the caller's $@ must survive 500: local $@; 501: 502: # Accept both i18n('key', {...}) and i18n({ key => ..., args => {...} }) 503: # Undefined values are dropped so that validation reports them as missing 504: my $in = (ref($_[0]) eq 'HASH') ? { %{ $_[0] } } : { key => $_[0], args => $_[1] }; 505: delete @{$in}{ grep { !defined $in->{$_} } keys %{$in} }; 506: 507: my $params = validate_strict( 508: schema => { 509: key => { type => 'string', min => 1 }, 510: args => { 511: type => 'hashref', 512: optional => 1, 513: schema => { 514: params => { type => 'arrayref', optional => 1 }, 515: count => { type => 'integer', optional => 1, min => 0 }, 516: context => { type => 'string', optional => 1 }, 517: }, 518: }, 519: }, 520: input => $in, 521: ); 522: my $args = $params->{args} || {}; 523: 524: # Resolve the template in the user's language, falling back to English 525: # Try the chosen language, then English: a fixed list of at most two 526: # attempts. There is deliberately no recursion here, so no mistake in 527: # choosing the language (a bug, or a mutation of _language) can ever 528: # make this loop forever. 529: my $key = $params->{key}; 530: # An undefined language (only possible through a bug) means English 531: my $lang = $self->_language() // $DEFAULT_LANGUAGE; 532: my $entry; 533: foreach my $try ($lang eq $DEFAULT_LANGUAGE ? ($lang) : ($lang, $DEFAULT_LANGUAGE)) { 534: $entry = _narrow($self->_lookup($try, $key), $try, $args); 535: last if defined $entry; 536: } 537: 538: # Premise 1: every English template is complete. Premise 2: not even 539: # the English one gave a usable form. Conclusion: the catalog is 540: # broken, which is a programming error. 541: _unknown_key($key) unless defined $entry; 542: 543: # A literal message with no placeholders is returned untouched, which 544: # protects any '%' characters it contains from sprintf() 545: # Use the validated array reference directly rather than copying it 546: my $values = $args->{params}; 547: my $text = ($values && @{$values}) ? sprintf($entry, @{$values}) : $entry; 548: 549: return set_return($text, { type => 'string' });
Mutants (Total: 2, Killed: 2, Survived: 0)
550: } 551: 552: # _croak_i18n 553: # Purpose: Throw a localised exception from the caller's point of view. 554: # Entry Criteria: $key is a catalog key; $args is an optional i18n() hashref. 555: # Exit Status: Never returns; always croaks. 556: # Side Effects: Unwinds the stack with a Carp exception. 557: sub _croak_i18n :Protected { 558: my ($self, $key, $args) = @_; 559: 560: croak($self->i18n($key, $args)); 561: } 562: 563: # _carp_i18n 564: # Purpose: Emit a localised warning from the caller's point of view. 565: # Entry Criteria: $key is a catalog key; $args is an optional i18n() hashref. 566: # Exit Status: Returns $self for chaining. 567: # Side Effects: Writes a warning to STDERR (or $SIG{__WARN__}). 568: sub _carp_i18n :Protected { 569: my ($self, $key, $args) = @_; 570: 571: carp($self->_printable($self->i18n($key, $args))); 572: return $self;
Mutants (Total: 2, Killed: 2, Survived: 0)
573: } 574: 575: # _interrupt_signals 576: # Purpose: List the "stop now" signals that this program may take 577: # over: those that exist on this system and that nobody 578: # has set a handler for. Used by code that must clean up 579: # (delete temporary files) when stopped, since Perl's 580: # default action for these signals skips all clean-up. 581: # Entry Criteria: None. 582: # Exit Status: Returns an arrayref of signal names, e.g. ['INT', 'TERM']. 583: # The caller localises %SIG for exactly these names. 584: # Side Effects: None. 585: sub _interrupt_signals :Protected { 586: my %exists = map { $_ => 1 } split ' ', $Config{sig_name}; 587: return [ grep { $exists{$_} && ($SIG{$_} // 'DEFAULT') eq 'DEFAULT' } @INTERRUPT_SIGNALS ]; 588: } 589: 590: # _printable 591: # Purpose: Make text safe to show on a terminal or write to a log, 592: # by replacing control characters with visible escapes 593: # such as \x1B. Text may come from a hostile database 594: # (table names, mdbtools error output). 595: # Entry Criteria: $text is a string (Perl characters or UTF-8 bytes) or undef. 596: # Exit Status: Returns the escaped string ('' for undef). 597: # Side Effects: None. 598: sub _printable :Protected { ●599 → 602 → 607 599: my ($self, $text) = @_; 600: 601: $text //= ''; 602: if(utf8::is_utf8($text)) {
603: $text =~ s/($UNPRINTABLE_RE)/sprintf(ord($1) > 0xFF ? '\\x{%X}' : '\\x%02X', ord $1)/ge; 604: } else { 605: $text =~ s{($UNPRINTABLE_BYTES_RE)}{join(q{}, map { sprintf(q{\\x%02X}, ord) } split(//, $1))}ge; 606: } 607: return $text;Mutants (Total: 1, Killed: 0, Survived: 1)
- COND_INV_602_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomesMutants (Total: 2, Killed: 2, Survived: 0)
608: } 609: 610: # _language 611: # Purpose: Work out which catalog language to use. 612: # Entry Criteria: $self is a class name or an object (optionally with {language}). 613: # Exit Status: Returns a lower-case language code, e.g. 'en' or 'de'. 614: # Side Effects: None; reads %ENV only. 615: sub _language :Private { 616: my $self = shift; 617: 618: # An explicit per-object choice beats anything in the environment. 619: # Otherwise take the first meaningful locale variable; LANGUAGE may be 620: # a colon-separated preference list, so only its first entry counts. 621: # Empty values and C/POSIX mean "no preference", so they are skipped. 622: my $wanted = ref($self) && $self->{language}; 623: ($wanted) = grep { length && !$NEUTRAL_LOCALES{$_} } 624: map { (split /:/, $ENV{$_} // '')[0] // '' } @LOCALE_VARIABLES 625: unless $wanted; 626: 627: # "de_DE.UTF-8@euro" -> "de"; anything unparseable means English 628: my ($code) = ($wanted // '') =~ /\A([A-Za-z]{2,3})(?:[_\-.@]|\z)/; 629: return (defined($code) && exists($MESSAGES{lc $code})) ? lc($code) : $DEFAULT_LANGUAGE;
Mutants (Total: 2, Killed: 2, Survived: 0)
630: } 631: 632: # _lookup 633: # Purpose: Fetch the raw template for $key in $lang. 634: # Entry Criteria: $lang is a catalog language; $key is a non-empty string. 635: # Exit Status: Returns a string or hashref template. 636: # Side Effects: confess()es if $key is missing from the default catalog, 637: # because that can only be a programming error. 638: sub _lookup :Private { ●639 → 642 → 646 639: my ($self, $lang, $key) = @_; 640: 641: # A partial translation silently falls back to English per key 642: foreach my $catalog ($MESSAGES{$lang}, $MESSAGES{$DEFAULT_LANGUAGE}) { 643: return $catalog->{$key} if $catalog && exists($catalog->{$key});
Mutants (Total: 2, Killed: 2, Survived: 0)
644: } 645: 646: return _unknown_key($key);
647: } 648: 649: # _narrow 650: # Purpose: Reduce a template to one sprintf() format: first the 651: # form for the context (if the template has one), then 652: # the plural form for the count, falling back to "other". 653: # Entry Criteria: $entry is a string or hashref template; $lang is the 654: # language whose plural rule applies; $args is the 655: # validated i18n() args hashref. 656: # Exit Status: Returns a plain string, or undef if the template has no 657: # usable form (a gap in a translation). 658: # Side Effects: None. A plain function, not a method. 659: sub _narrow :Private { ●660 → 662 → 665 660: my ($entry, $lang, $args) = @_; 661: 662: if(ref($entry) eq 'HASH' && defined($args->{context}) && exists($entry->{$args->{context}})) {Mutants (Total: 2, Killed: 0, Survived: 2)
- BOOL_NEGATE_646_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes🧪 Suggested Test# Boolean branch test suggestion ok( !func(INPUT), 'Verify boolean branch behaviour' );- RETURN_UNDEF_646_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor🧪 Suggested Test# Return value assertion is( func(INPUT), EXPECTED, 'Verify correct return value' );Mutants (Total: 1, Killed: 1, Survived: 0)
663: $entry = $entry->{$args->{context}}; 664: } ●665 → 665 → 669 665: if(ref($entry) eq 'HASH') {
Mutants (Total: 1, Killed: 1, Survived: 0)
666: my $category = _plural_category($lang, $args->{count}); 667: $entry = exists($entry->{$category}) ? $entry->{$category} : $entry->{$PLURAL_OTHER}; 668: } 669: return (defined($entry) && !ref($entry)) ? $entry : undef;
Mutants (Total: 2, Killed: 2, Survived: 0)
670: } 671: 672: # _unknown_key 673: # Purpose: Report a message key that the English catalog lacks. 674: # Entry Criteria: $key is the key that could not be resolved. 675: # Exit Status: Never returns; always confesses (a stack trace helps, 676: # because this can only be a programming error). 677: # Side Effects: Unwinds the stack. 678: # The text is built directly from the catalog, not through i18n(), which 679: # could recurse forever if 'unknown_message' itself were missing. 680: sub _unknown_key :Private { 681: my $key = shift; 682: 683: confess(sprintf($MESSAGES{$DEFAULT_LANGUAGE}{unknown_message} || 'Unknown message key: %s', $key)); 684: } 685: 686: # _plural_category 687: # Purpose: Map a count to a CLDR plural category for a language. 688: # Entry Criteria: $lang is a language code; $count is a non-negative 689: # integer or undef (undef means "no plural choice"). 690: # Exit Status: Returns a category name such as 'one' or 'other'. 691: # Side Effects: None. A plain function, not a method. 692: sub _plural_category :Private { 693: my ($lang, $count) = @_; 694: 695: my $rule = $PLURAL_RULES{$lang} || $PLURAL_RULES{$DEFAULT_LANGUAGE}; 696: return defined($count) ? $rule->($count) : $PLURAL_OTHER;
Mutants (Total: 2, Killed: 2, Survived: 0)
697: } 698: 699: 1; 700: 701: __END__ 702: 703: =head1 LIMITATIONS 704: 705: =over 4 706: 707: =item * Only an English catalog is included. Other languages fall back 708: to English, one key at a time. 709: 710: =item * Plural rules exist only for a few languages (C<en>, C<de>, C<fr>, 711: C<ja>, C<ko>, C<zh>). Other languages use the English rule. 712: 713: =item * Messages from other modules (for example 714: L<Params::Validate::Strict> and L<autodie>) are not translated. 715: 716: =item * L<Sub::Private> and L<Sub::Protected> set up their protection at 717: C<CHECK> time. If this module is first loaded at run time (with 718: C<require> after the program has been compiled), Perl warns 719: "Too late to run CHECK block" and the private and protected helpers are 720: B<not> protected. 721: 722: =back 723: 724: =head1 SEE ALSO 725: 726: L<App::Access2CSV>, L<App::Access2CSV::Exporter> 727: 728: =head1 AUTHOR 729: 730: Nigel Horne, C<< <njh at nigelhorne.com> >> 731: 732: =head1 LICENSE AND COPYRIGHT 733: 734: Copyright 2026 Nigel Horne. 735: 736: Usage is subject to the GPL2 licence terms. 737: If you use it, 738: please let me know. 739: 740: =head1 FORMAL SPECIFICATION 741: 742: These schemas use the Z notation. C<?> marks an input and C<!> an 743: output. You do not need to read this section to use the module. 744: 745: [KEY, LANG, CTX, VALUE] 746: CATEGORY ::= zero | one | two | few | many | other 747: TEMPLATE ::= text⟨⟨seq CHAR⟩⟩ 748: | forms⟨⟨(CTX ∪ CATEGORY) ⇸ TEMPLATE⟩⟩ 749: 750: ┌─ Catalog ────────────────────────────────────────────────── 751: │ MESSAGES : LANG ⇸ (KEY ⇸ TEMPLATE) 752: │ plural : LANG × â„• → CATEGORY 753: ├──────────────────────────────────────────────────────────── 754: │ en ∈ dom MESSAGES 755: └──────────────────────────────────────────────────────────── 756: 757: =head2 i18n 758: 759: ┌─ I18n ───────────────────────────────────────────────────── 760: │ ΞCatalog 761: │ key? : KEY ; params? : seq VALUE ; count? : â„• ; context? : CTX 762: │ userLang : LANG ; lang : LANG ; msg! : seq CHAR 763: ├──────────────────────────────────────────────────────────── 764: │ key? ∈ dom MESSAGES(en) 765: │ lang = (if userLang ∈ dom MESSAGES then userLang else en) 766: │ tâ‚€ = (if key? ∈ dom MESSAGES(lang) 767: │ then MESSAGES(lang)(key?) else MESSAGES(en)(key?)) 768: │ tâ‚ = (if tâ‚€ = forms(f) ∧ context? ∈ dom f then f(context?) else tâ‚€) 769: │ tâ‚‚ = (if tâ‚ = forms(g) 770: │ then (if plural(lang, count?) ∈ dom g 771: │ then g(plural(lang, count?)) else g(other)) 772: │ else tâ‚) 773: │ msg! = (if params? = ⟨⟩ then tâ‚‚ else sprintf(tâ‚‚, params?)) 774: └──────────────────────────────────────────────────────────── 775: 776: ┌─ I18nUnknownKey ─────────────────────────────────────────── 777: │ ΞCatalog 778: │ key? : KEY ; error! : seq CHAR 779: ├──────────────────────────────────────────────────────────── 780: │ key? ∉ dom MESSAGES(en) 781: │ error! = "Unknown message key: " †key? 782: └──────────────────────────────────────────────────────────── 783: 784: =head1 STATE DIAGRAM 785: 786: This module keeps no state between calls: C<i18n> only reads 787: C<%MESSAGES> and C<%ENV>. The diagram shows the steps of one call. 788: Each box is a step. Each arrow shows what decides the next step. 789: 790: i18n($key, \%args) 791: | 792: v 793: +------------------+ key missing, or args 794: | VALIDATING | has a bad field 795: +------------------+-----------------------------+ 796: | OK | 797: v | 798: +------------------+ | 799: | CHOOSING LANGUAGE| object language, else | 800: | | LANGUAGE/LC_ALL/ | 801: | | LC_MESSAGES/LANG, else en | 802: +------------------+ | 803: | | 804: v v 805: +------------------+ key not in +------------------+ 806: | LOOKING UP KEY | English either | FATAL | 807: | (language, then |------------------>| croak / confess | 808: | English) | +------------------+ 809: +------------------+ 810: | template found 811: v 812: +------------------+ plain text 813: | NARROWING FORMS |-----------------------+ 814: | 1. context form | | 815: | 2. plural form | | 816: | (else other) | | 817: +------------------+ | 818: | one plain template left | 819: v v 820: +------------------+ no params +------------------+ 821: | FORMATTING |-------------->| return text | 822: | sprintf(params) |-------------->| unchanged / | 823: +------------------+ params | formatted | 824: +------------------+ 825: 826: =cut