Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
DBIC	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
Dispatcher	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
Minimal	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
messages	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
Die.pm	3.92 KB	-rw-rw-rw-	2021-01-15 17:36
Die.pod	2.56 KB	-rw-rw-rw-	2021-01-15 17:36
Dispatcher.pm	9.32 KB	-rw-rw-rw-	2021-01-15 17:36
Dispatcher.pod	13.06 KB	-rw-rw-rw-	2021-01-15 17:36
Domain.pm	4.68 KB	-rw-rw-rw-	2021-01-15 17:36
Domain.pod	9.34 KB	-rw-rw-rw-	2021-01-15 17:36
Exception.pm	2.2 KB	-rw-rw-rw-	2021-01-15 17:36
Exception.pod	3.8 KB	-rw-rw-rw-	2021-01-15 17:36
Message.pm	4.73 KB	-rw-rw-rw-	2021-01-15 17:36
Message.pod	16.72 KB	-rw-rw-rw-	2021-01-15 17:36
Minimal.pm	5.83 KB	-rw-rw-rw-	2021-01-15 11:07
Minimal.pod	2.38 KB	-rw-rw-rw-	2021-01-15 11:07
Optional.pm	1.01 KB	-rw-rw-rw-	2021-01-15 11:07
Optional.pod	1.48 KB	-rw-rw-rw-	2021-01-15 11:07
Translator.pm	930 B	-rw-rw-rw-	2021-01-15 17:36
Translator.pod	1.99 KB	-rw-rw-rw-	2021-01-15 17:36
Util.pm	6.13 KB	-rw-rw-rw-	2021-01-15 11:07
Util.pod	4 KB	-rw-rw-rw-	2021-01-15 11:07

Rename

# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report. Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Log::Report::Message;
use vars '$VERSION';
$VERSION = '1.31';

use warnings;
use strict;

use Log::Report 'log-report';
use POSIX             qw/locale_h/;
use List::Util        qw/first/;
use Scalar::Util      qw/blessed/;

use Log::Report::Util qw/to_html/;

# Work-around for missing LC_MESSAGES on old Perls and Windows
{ no warnings;
  eval "&LC_MESSAGES";
  *LC_MESSAGES = sub(){5} if $@;
}

use overload
    '""'  => 'toString'
  , '&{}' => sub { my $obj = shift; sub{$obj->clone(@_)} }
  , '.'   => 'concat'
  , fallback => 1;

sub new($@)
{   my ($class, %s) = @_;

if(ref $s{_count})
    {   my $c        = $s{_count};
        $s{_count}   = ref $c eq 'ARRAY' ? @$c : keys %$c;
    }

defined $s{_join}
        or $s{_join} = $";

if($s{_msgid})
    {   $s{_append}  = defined $s{_append} ? $1.$s{_append} : $1
            if $s{_msgid} =~ s/(\s+)$//s;

$s{_prepend}.= $1
            if $s{_msgid} =~ s/^(\s+)//s;
    }
    if($s{_plural})
    {   s/\s+$//, s/^\s+// for $s{_plural};
    }

bless \%s, $class;
}

# internal use only: to simplify __*p* functions
sub _msgctxt($) {$_[0]->{_msgctxt} = $_[1]; $_[0]}

sub clone(@)
{   my $self = shift;
    (ref $self)->new(%$self, @_);
}

sub fromTemplateToolkit($$;@)
{   my ($class, $domain, $msgid) = splice @_, 0, 3;
    my $plural = $msgid =~ s/\|(.*)// ? $1 : undef;
    my $args   = @_ && ref $_[-1] eq 'HASH' ? pop : {};

my $count;
    if(defined $plural)
    {   @_==1 or $msgid .= " (ERROR: missing count for plural)";
        $count = shift || 0;
        $count = @$count if ref $count eq 'ARRAY';
    }
    else
    {   @_==0 or $msgid .= " (ERROR: only named parameters expected)";
    }

$class->new
      ( _msgid => $msgid, _plural => $plural, _count => $count
      , %$args, _expand => 1, _domain => $domain);
}

#----------------

sub prepend() {shift->{_prepend}}
sub msgid()   {shift->{_msgid}}
sub append()  {shift->{_append}}
sub domain()  {shift->{_domain}}
sub count()   {shift->{_count}}
sub context() {shift->{_context}}
sub msgctxt() {shift->{_msgctxt}}

sub classes()
{   my $class = $_[0]->{_class} || $_[0]->{_classes} || [];
    ref $class ? @$class : split(/[\s,]+/, $class);
}

sub to(;$)
{   my $self = shift;
    @_ ? $self->{_to} = shift : $self->{_to};
}

sub valueOf($) { $_[0]->{$_[1]} }

#--------------

sub inClass($)
{   my @classes = shift->classes;
       ref $_[0] eq 'Regexp'
    ? (first { $_ =~ $_[0] } @classes)
    : (first { $_ eq $_[0] } @classes);
}

sub toString(;$)
{   my ($self, $locale) = @_;
    my $count  = $self->{_count} || 0;
	$locale    = $self->{_lang} if $self->{_lang};

my $prepend = $self->{_prepend} // '';
    my $append  = $self->{_append}  // '';

if(blessed $prepend) {
        $prepend = $prepend->isa(__PACKAGE__) ? $prepend->toString($locale)
          : "$prepend";
	}
	if(blessed $append) {
        $append  = $append->isa(__PACKAGE__) ? $append->toString($locale)
          : "$append";
	}

$self->{_msgid}   # no translation, constant string
        or return "$prepend$append";

# assumed is that switching locales is expensive
    my $oldloc = setlocale(LC_MESSAGES);
    setlocale(LC_MESSAGES, $locale)
        if defined $locale && (!defined $oldloc || $locale ne $oldloc);

# translate the msgid
	my $domain = $self->{_domain};
	$domain    = textdomain $domain
        unless blessed $domain;

my $format = $domain->translate($self, $locale || $oldloc);
    defined $format or return ();

# fill-in the fields
	my $text = $self->{_expand}
      ? $domain->interpolate($format, $self)
      : "$prepend$format$append";

setlocale(LC_MESSAGES, $oldloc)
        if defined $oldloc && (!defined $locale || $oldloc ne $locale);

$text;
}

my %tohtml = qw/  > gt   < lt   " quot  & amp /;

sub toHTML(;$) { to_html($_[0]->toString($_[1])) }

sub untranslated()
{  my $self = shift;
     (defined $self->{_prepend} ? $self->{_prepend} : '')
   . (defined $self->{_msgid}   ? $self->{_msgid}   : '')
   . (defined $self->{_append}  ? $self->{_append}  : '');
}

sub concat($;$)
{   my ($self, $what, $reversed) = @_;
    if($reversed)
    {   $what .= $self->{_prepend} if defined $self->{_prepend};
        return ref($self)->new(%$self, _prepend => $what);
    }

$what = $self->{_append} . $what if defined $self->{_append};
    ref($self)->new(%$self, _append => $what);
}

#----------------