File-Gettext

 view release on metacpan or  search on metacpan

lib/File/Gettext/Storage.pm  view on Meta::CPAN

   return grep { not m{ \A _ }msx
                 and $_ ne 'id' and $_ ne 'name'
                 and $condition->( $_ ) } @{ $source->attributes || [] };
};

# Private methods
my $_extn = sub {
   my ($self, $path) = @_; $path //= NUL;

   my $extn = (split m{ \. }mx, ("${path}" // NUL))[ -1 ];

   return $extn ? ".${extn}" : $self->extn;
};

my $_gettext = sub {
   my ($self, $path) = @_; $path or throw Unspecified, [ 'path name' ];

   my $gettext = $self->gettext; my $extn = $self->$_extn( $path );

   $gettext->set_path( $self->language, basename( "${path}", $extn ) );

lib/File/Gettext/Storage.pm  view on Meta::CPAN

my $_load_gettext = sub {
   my ($self, $data, $path) = @_;

   my $gettext = $self->$_gettext( $path ); $gettext->path->is_file or return;

   my $gettext_data = $gettext->load->{ $gettext->source_name };

   for my $key (keys %{ $gettext_data }) {
      my ($msgctxt, $msgid)     = $gettext->storage->decompose_key( $key );
      my ($element, $attr_name) = split m{ [\.] }msx, $msgctxt, 2;

      ($element and $attr_name and $msgid) or next;

      $data->{ $element }->{ $msgid }->{ $attr_name }
         = $gettext_data->{ $key }->{msgstr}->[ 0 ];
   }

   return $gettext->path->stat->{mtime};
};

lib/File/Gettext/Storage/MO.pm  view on Meta::CPAN

      my $orig_length  = $orig_tab[ $count ];
      my $orig_offset  = $orig_tab[ $count + 1 ];
      my $trans_length = $trans_tab[ $count ];
      my $trans_offset = $trans_tab[ $count + 1 ];

      $orig_offset  + $orig_length  > $size
         and throw 'Path [_1] bad key length', [ $path ];
      $trans_offset + $trans_length > $size
         and throw 'Path [_1] bad text length', [ $path ];

      my @origs = split m{ $sep }mx, substr $raw, $orig_offset,  $orig_length;
      my @trans = split m{ $sep }mx, substr $raw, $trans_offset, $trans_length;
      my $msgs  = { msgstr => [ @trans ] };

      # The singular is the origs 0, the plural is origs 1
      $messages->{ $origs[ 0 ] || NUL } = $msgs;
      $origs[ 1 ] and $messages->{ $origs[ 1 ] } = $msgs;
   }

   my $header = {}; my $null_entry;

   # Try to find po header information.
   if ($null_entry = $messages->{ NUL() }->{msgstr}->[ 0 ]) {
      for my $line (split m{ [\n] }msx, $null_entry) {
         my ($k, $v) = split m{ [:] }msx, $line, 2;

         $k =~ s{ [-] }{_}gmsx; $v =~ s{ \A \s+ }{}msx;
         $header->{ lc $k } = $v;
      }
   }

   if (exists $header->{content_type}) {
      my $content_type = $header->{content_type};

      $content_type =~ s{ .* = }{}msx and $header->{charset} = $content_type;

lib/File/Gettext/Storage/PO.pm  view on Meta::CPAN

   return $out;
};

my $_header_inflate = sub {
   my $data = shift; my $header = (delete $data->{ NUL() }) || { msgstr => [] };

   my $null_entry = $header->{msgstr}->[ 0 ]; $header->{msgstr} = {};

   $null_entry or return $header;

   for my $line (split m{ [\n] }msx, $null_entry) {
      my ($k, $v) = split m{ [:] }msx, $line, 2;

      $k =~ s{ [-] }{_}gmsx; $v =~ s{ \A \s+ }{}msx;
      $header->{msgstr}->{ lc $k } = $v;
   }

   return $header;
};

my $_original_order = sub {
   my ($hash, $lhs, $rhs) = @_;

lib/File/Gettext/Storage/PO.pm  view on Meta::CPAN

   return '"'.$text.'\n"';
};

my $_store_comment = sub {
   my ($rec, $line, $attr) = @_;

   my $value = length $line > 1 ? substr $line, 2 : NUL;

   if ($attr eq q(flags)) {
      push @{ $rec->{ $attr } }, map    { s{ \s+ }{}msx; $_ }
                                 split m{ [,]      }msx, $value;
   }
   else { $rec->{ $attr } .= $rec->{ $attr } ? "\n${value}" : $value }

   return;
};

my $_time2str = sub {
   my ($format, $time) = @_;

   defined $format or $format = '%Y-%m-%d %H:%M:%S';

lib/File/Gettext/Storage/PO.pm  view on Meta::CPAN

      $data->{ $id } = $_decode_hash->( $charset, $rec );
   }

   return { po => $data, po_header => $_decode_hash->( $charset, $po_header ) };
};

my $_store_record = sub {
   my ($self, $data, $rec, $order_ref) = @_; exists $rec->{msgid} or return;

   my @ctxt = split m{ [\.] }msx, ($rec->{msgctxt} || NUL), 2;

   $ctxt[ 0 ] = $ctxt[ 0 ] ? $ctxt[ 0 ].SPC : 'messages ';
   $ctxt[ 1 ] = $ctxt[ 1 ] ? SPC.$ctxt[ 1 ] : NUL;
   $rec->{labels} = $ctxt[ 0 ].$rec->{msgid}.$ctxt[ 1 ];
   $rec->{_order} = ${ $order_ref }++;
   $data->{ $self->make_key( $rec ) } = $rec;
   return;
};

my $_read_filter = sub {

lib/File/Gettext/Storage/PO.pm  view on Meta::CPAN

         'plural_forms'              => 'nplurals=2; plural=(n != 1);', }, };
};

my $_get_comment_lines = sub {
   my ($self, $attr_name, $values, $prefix) = @_; my $lines = [];

   $attr_name eq 'flags' and return [ $prefix.SPC.(join ', ', @{ $values }) ];

   $values =~ m{ [\n] \z }msx and $values .= SPC;

   for my $line (map { $prefix.$_ } split m{ [\n] }msx, $values) {
      $line =~ s{ \# \s+ \z }{\#}msx; push @{ $lines }, $line;
   }

   return $lines;
};

my $_get_po_header_key = sub {
   my ($self, $k) = @_; my $key_table = $self->schema->header_key_table;

   defined $key_table->{ $k } and return $key_table->{ $k };

   my $po_key = join q(-), map { ucfirst $_ } split m{ [_] }msx, $k;

   return [ 1 + keys %{ $key_table }, $po_key ];
};

my $_split_on_nl = sub {
   my ($self, $attr_name, $value) = @_;

   $value ||= NUL; my $last_char = substr $value, -1; chomp $value;

   my @lines = split m{ [\n] }msx, $value; my $lines = [];

   if (@lines < 2) { push @{ $lines }, "${attr_name} ".$_quote->( $value ) }
   else {
      push @{ $lines }, $attr_name.' ""';
      push @{ $lines }, map { $_quote->( $_ ) } @lines;
   }

   $last_char ne "\n" and $lines->[ -1 ] =~ s{ [\\][n][\"] \z }{\"}msx;
   return $lines;
};

lib/File/Gettext/Storage/PO.pm  view on Meta::CPAN

   $wtr->println( @{ $self->$_write_filter( $data ) } );
   return $data;
}

sub decompose_key {
   my ($self, $key) = @_; my $sep = CONTEXT_SEP;

   0 >= index $key, $sep and return (NUL, $key);

   return split m{ $sep }msx, $key, 2;
}

sub make_key {
   my ($self, $rec) = @_;

   return (exists $rec->{msgctxt}
           ? $rec->{msgctxt}.CONTEXT_SEP : NUL).$rec->{msgid};
}

1;