Rose-HTML-Objects

 view release on metacpan or  search on metacpan

lib/Rose/HTML/Object/Message/Localizer.pm  view on Meta::CPAN

  {
    if(@_ == 1)
    {
      return $hash->{$_[0]};
    }
    elsif(@_ % 2 == 0)
    {
      for(my $i = 0; $i < @_; $i += 2)
      {
        $hash->{$_[$i]} = $_[$i + 1];
      }
    }
    else { croak "Odd number of arguments passed to locale_cascade()" }
  }

  return wantarray ? %$hash : $hash;
}

sub init_locale
{
  my($self) = shift;
  my $class = ref($self) || $self;
  return $class->default_locale;
}

sub init_messages_class { 'Rose::HTML::Object::Messages' }
sub init_message_class  { 'Rose::HTML::Object::Message::Localized' }
sub init_errors_class   { 'Rose::HTML::Object::Errors' }
sub init_error_class    { 'Rose::HTML::Object::Error' }

sub clone { Clone::PP::clone(shift) }

sub parent
{
  my($self) = shift; 
  return Scalar::Util::weaken($self->{'parent'} = shift)  if(@_);
  return $self->{'parent'};
}

sub localize_message
{
  my($self, %args) = @_;

  my $message = $args{'message'};

  return $message  unless($message->can('text') && $message->can('id'));  
  return $message->text  if($message->is_custom);

  my $parent = $message;

  if($parent->can('parent'))
  {
    $parent = $parent->parent;
  }

  if($parent && $parent->isa('Rose::HTML::Object::Error'))
  {
    $parent = $parent->parent;
  }

  my $calling_class = $parent ? ref($parent) : $args{'caller'} || (caller)[0];

  my $first_parent = $parent;

  my $args   = $args{'args'}   || $message->args;
  my $locale = $args{'locale'} || $message->locale || $self->locale;

  my $id = $message->id;

  my $variant = $args{'variant'} ||=
    $self->select_variant_for_message(id     => $id,
                                      args   => $args,
                                      locale => $locale);

  my $locale_cascade = $self->locale_cascade($locale) ||
                       $self->locale_cascade('default') || [];

  foreach my $try_locale ($locale, @$locale_cascade)
  {
    my $variant_cascade = 
      $self->variant_cascade(locale  => $try_locale,
                             variant => $variant,
                             message => $message,
                             args    => $args) || [];

    foreach my $try_variant ($variant, @$variant_cascade)
    {
      my $text =
        $self->get_localized_message_text(
          id         => $id, 
          locale     => $try_locale,
          variant    => $try_variant,
          from_class => $calling_class);

      $parent = $first_parent;

      # Look for messages in parents
      while(!defined $text && $parent)
      {
        $parent = $parent->can('parent_field') ? $parent->parent_field :
                  $parent->can('parent_form')  ? $parent->parent_form  :
                  $parent->can('parent')       ? $parent->parent       : 
                  undef;

        if($parent)
        {
          $text = 
            $self->get_localized_message_text(
              id         => $id,
              locale     => $try_locale,
              variant    => $try_variant,
              from_class => ref($parent));
        }
      }

      return $self->process_placeholders($text, $args)  if(defined $text);
    }
  }

  return undef;
}

lib/Rose/HTML/Object/Message/Localizer.pm  view on Meta::CPAN

  }

  unless(ref $text eq 'HASH')
  {
    $text = { $locale => $text };
  }

  my $msgs = $self->localized_messages_hash;

  while(my($l, $t) = each(%$text))
  {
    $Debug && warn qq($self - Adding text $name), 
                   ($variant ? "($variant)" : ''), 
                   qq( [$l] - "$t"\n);

    if($variant)
    {
      if(ref $msgs->{$name}{$l})
      {
        $msgs->{$name}{$l}{$variant} = "$t"; # force stringification
      }
      else
      {
        my $existing = $msgs->{$name}{$l};

        if(defined $existing)
        {
          $msgs->{$name}{$l} = {};
          $msgs->{$name}{$l}{DEFAULT_VARIANT()} = $existing;
        }

        $msgs->{$name}{$l}{$variant} = "$t"; # force stringification
      }
    }
    else
    {
      if(ref ref $msgs->{$name}{$l})
      {
        $msgs->{$name}{$l}{DEFAULT_VARIANT()} = "$t"; # force stringification
      }
      else
      {
        $msgs->{$name}{$l} = "$t"; # force stringification
      }
    }
  }

  return $id;
}

sub import_message_ids
{
  my($self) = shift;

  if($Rose::HTML::Object::Exporter::Target_Class)
  {
    $self->messages_class->import(@_);
  }
  else
  {
    local $Rose::HTML::Object::Exporter::Target_Class = (caller)[0];
    $self->messages_class->import(@_);
  }
}

sub import_error_ids
{
  my($self) = shift;

  @_ = (':all')  unless(@_);

  if($Rose::HTML::Object::Exporter::Target_Class)
  {
    $self->errors_class->import(@_);
  }
  else
  {
    local $Rose::HTML::Object::Exporter::Target_Class = (caller)[0];
    $self->errors_class->import(@_);
  }
}

sub add_localized_message
{
  my($self, %args) = @_;

  my $id     = $args{'id'} || $self->generate_message_id;
  my $name   = $args{'name'} || croak "Missing name for new localized message";
  my $locale = $args{'locale'} || $self->locale;
  my $text   = $args{'text'};

  croak "Missing new localized message text"  unless(defined $text);

  if($name =~ /[^A-Z0-9_]/)
  {
    croak "Message names must be uppercase and may contain only ",
          "letters, numbers, and underscores";
  }

  unless(ref $text eq 'HASH')
  {
    $text = { $locale => $text };
  }

  my $msgs = $self->localized_messages_hash;
  my $msgs_class = $self->messages_class;

  my $const = "${msgs_class}::$name";

  if(defined &$const)
  {
    croak "A constant or subroutine named $name already exists in the class $msgs_class";
  }

  $msgs_class->add_message($name, $id);

  while(my($l, $t) = each(%$text))
  {
    $Debug && warn qq($self - Adding message $name ($l) = "$t"\n);
    $msgs->{$name}{$l} = "$t"; # force stringification
  }

  return $id;
}

use constant NEW_ID_OFFSET => 100_000;

our $Last_Generated_Message_Id = NEW_ID_OFFSET;
our $Last_Generated_Error_Id   = NEW_ID_OFFSET;

sub generate_message_id
{
  my($self) = shift;

  my $messages_class = $self->messages_class;
  my $errors_class = $self->errors_class;

  my $new_id = $Last_Generated_Error_Id;
  $new_id++  while($messages_class->message_id_exists($new_id) ||
                   $errors_class->error_id_exists($new_id));

  return $Last_Generated_Message_Id = $new_id;
}

sub generate_error_id
{
  my($self) = shift;

  my $errors_class = $self->errors_class;
  my $messages_class = $self->messages_class;

  my $new_id = $Last_Generated_Error_Id;
  $new_id++  while($errors_class->error_id_exists($new_id) || 
                   $messages_class->message_id_exists($new_id));

  return $Last_Generated_Error_Id = $new_id;
}

sub add_localized_error
{
  my($self, %args) = @_;

  my $id   = $args{'id'} || $self->generate_error_id;
  my $name = $args{'name'} or croak "Missing localized error name";

  my $errors_class = $self->errors_class;

  my $const = "${errors_class}::$name";

  if(defined &$const)
  {
    croak "A constant or subroutine named $name already exists in the class $errors_class";
  }

  $errors_class->add_error($name, $id);

  return $id;
}

sub dump_messages
{
  my($self, $code) = @_;
  my $msgs = $self->localized_messages_hash;
  return $code->($msgs)  if($code);
  require Data::Dumper;
  return Data::Dumper::Dumper($msgs);
}

sub get_localized_message_text
{
  my($self, %args) = @_;

  my $id         = $args{'id'};
  my $name       = $args{'name'};
  my $locale     = $args{'locale'} || $self->locale;
  my $variant    = $args{'variant'} || DEFAULT_VARIANT;
  my $from_class = $args{'from_class'}; 

  $from_class ||= (caller)[0];

  $name ||= $self->get_message_name($id);

  my $msgs = $self->localized_messages_hash;

  # Try this twice: before and after loading messages
  foreach my $try (1, 2)
  {
    no warnings 'uninitialized';
    if(exists $msgs->{$name} && exists $msgs->{$name}{$locale})
    {
      if(ref $msgs->{$name}{$locale} && exists $msgs->{$name}{$locale}{$variant})
      {
        return $msgs->{$name}{$locale}{$variant};
      }

      return $msgs->{$name}{$locale}  if($variant eq DEFAULT_VARIANT);
    }

    last  if($try == 2);

    $self->load_localized_message($name, $locale, $variant, $from_class);
  }

  return undef;
}

# ([A-Z0-9_]+) -> ([A-Z0-9_]+) (?: \( \s* (\w[-\w]*) \s* \) )?
# ([A-Z0-9_]+) -> ([A-Z0-9_]+)(?:\(\s*([-\w]+)\s*\))?
my $Locale_Declaration = qr{^\s* \[% \s* LOCALE \s* (\S+) \s* %\] \s* (?: \#.*)?$}x;
my $Start_Message = qr{^\s* \[% \s* START \s+ ([A-Z0-9_]+)(?:\(\s*([-\w]+)\s*\))? \s* %\] \s* (?: \#.*)?$}x;
my $End_Message = qr{^\s* \[% \s* END \s+ ([A-Z0-9_]+)(?:\(\s*([-\w]+)\s*\))?? \s* %\] \s* (?: \#.*)?$}x;
my $Message_Spec = qr{^ \s* ([A-Z0-9_]+)(?:\(\s*([-\w]+)\s*\))? \s* = \s* "((?:[^"\\]+|\\.)*)" \s* (?: \#.*)? $}x;
my $Comment_Or_Blank = qr{^ \s* \# | ^ \s* $}x;
my $End_Messages = qr{^=\w|^\s*__END__};

my %Data_Pos;

sub load_localized_message
{
  my($self, $name, $locale, $variant, $from_class) = @_;

  $from_class ||= $self->messages_class;

  if($self->localized_message_exists($name, $locale, $variant))
  {
    return $self->get_localized_message_text(name   => $name, 
                                            locale  => $locale, 
                                            variant => $variant);
  }

  no strict 'refs';
  my $fh = \*{"${from_class}::DATA"};

  if(fileno($fh))
  {
    local $/ = "\n";

    if($Data_Pos{$from_class})
    {

lib/Rose/HTML/Object/Message/Localizer.pm  view on Meta::CPAN


  my $class = ref($self_or_class) || $self_or_class;

  if(@_)
  {
    my $locales = (@_ == 1 && ref $_[0] eq 'ARRAY') ? [ @{$_[0]} ] : [ @_ ];
    return $class->_auto_load_locales($locales);
  }

  my $locales = $class->_auto_load_locales;
  return wantarray ? @$locales : $locales  if(defined $locales);

  if(my $locales = $ENV{'RHTMLO_LOCALES'})
  {
    $locales = [ split(/\s*,\s*/, $locales) ]  unless(ref $locales);
    $class->_auto_load_locales($locales);
    return wantarray ? @$locales : $locales;
  }

  return wantarray ? () : [];
}

sub auto_load_messages
{
  my($self_or_class) = shift;

  my $class = ref($self_or_class) || $self_or_class;

  if(@_)
  {
    return $class->_auto_load_messages(@_);
  }

  my $ret = $class->_auto_load_messages;
  return $ret  if(defined $ret);

  if(($ENV{'MOD_PERL'} && (!defined($ENV{'RHTMLO_PRIME_CACHES'}) || $ENV{'RHTMLO_PRIME_CACHES'})) ||
     $ENV{'RHTMLO_PRIME_CACHES'})
  {
    return $class->_auto_load_messages(1);
  }

  return undef;
}

sub load_all_messages
{
  my($class) = shift;

  my %args;

  if(@_ > 1)
  {
    %args = @_;
  }
  else
  {
    $args{'from_class'} = $_[0];
  }

  my $from_class = $args{'from_class'} || (caller)[0];

  no strict 'refs';
  my $fh = \*{"${from_class}::DATA"};

  if(fileno($fh))
  {
    local $/ = "\n";

    if($Data_Pos{$from_class})
    {
      # Rewind to the start of the __DATA__ section
      seek($fh, $Data_Pos{$from_class}, 0);
    }
    else
    {
      $Data_Pos{$from_class} = tell($fh);
    }

    my $locales = $class->auto_load_locales;

    $Debug && warn "$class - Loading messages from DATA section of $from_class\n";
    $class->load_messages_from_fh(fh => $fh, locales => $locales, force_utf8 => 1);
  }
}

sub load_messages_from_file
{
  my($self) = shift;

  my %args;
  if(@_ == 1)
  {
    $args{'file'} = shift;
  }
  elsif(@_ > 1)
  {
    croak "Odd number of arguments passed to load_messages_from_file()"
      if(@_ % 2 != 0);
    %args = @_;
  }

  my $file = delete $args{'file'} or croak "Missing file argument";

  open($args{'fh'}, $file) or croak "Could no open messages file '$file' - $!";
  $self->load_messages_from_fh(%args);
  close($args{'fh'});
}

sub load_messages_from_fh
{
  my($self, %args) = @_;

  my($fh, $locales, $variants, $msg_names) = @args{qw(fh locales variants names)};

  binmode($fh, ':utf8')  if($args{'force_utf8'});

  if(ref $locales eq 'ARRAY')
  {
    $locales = @$locales ? { map { $_ => 1} @$locales } : undef;
  }



( run in 0.532 second using v1.01-cache-2.11-cpan-5735350b133 )