view release on metacpan or  search on metacpan

I18n/I18n.pm  view on Meta::CPAN

             or ($style eq "auto"
                 and $msgid =~ /[_]_"(?:[^"\\]+|\\.)+"/s)) {
            scan_str "$prefix:$row $msgid", $msgid, $lang;
         } else {
            scan_add $lang, $msgid, "$prefix:$row";
         }
      }
   }
}

=item scan_end

=cut

sub scan_end {
   local $PApp::SQL::DBH = PApp::Config::DBH;
   my $st0 = $PApp::SQL::DBH->prepare ("select nr from msgid where id = ? and domain = ? and lang = ?");
   my $st1 = $PApp::SQL::DBH->prepare ("update msgid set context = ? where nr = ?");
   while (my ($lang, $v) = each %scan_msg) {
      while (my ($msg, $context) = each %$v) {
         $context = join "\n", @$context;
         utf8::encode $msg; utf8::encode $lang; utf8::encode $context;
         $st0->execute ($msg, $scan_app, $lang);
         my $nr = $st0->fetchrow_arrayref;
         if ($nr) {
            $st1->execute ($context, $nr->[0]); $st1->finish;
         } else {
            $nr = sql_insertid
                     sql_exec "insert into msgid (id, domain, lang, context) values (?, ?, ?, ?)",
                              $msg, $scan_app, $lang, $context;

            # now enter existing, similar, translations
            my $trans = fuzzy_translation $msg, $scan_app;
            while (my ($lang, $str) = each %$trans) {
               sql_exec "insert into msgstr (nr, lang, flags, msg) values (?, ?, 'fuzzy', ?)",
                        $nr, $lang, $str;
            }
         }
      }
   }

   my $st = sql_exec \my($nr), "select nr from msgid where domain = ? and context = ''", $scan_app;
   while ($st->fetch) {
      sql_exec "update msgstr set flags = flags | 4 where nr = ?", $nr;
   }

   ($scan_app, $scan_lang, %scan_msg) = ();
}

=item export_dpo $domain, $path, [$userid, $groupid, $attr]

Export translation domain C<$domain> in binary hash format to directory
C<$path>, creating it if necessary.

=cut

sub export_dpo($$;$$) {
   my ($domain, $path, $uid, $gid, $attr) = @_;
   local $PApp::SQL::DBH = PApp::Config::DBH;
   mkdir $path, defined $attr ? $attr | 0111 : 0755;
   chown $uid, $gid, $path if defined $uid;
   unlink for glob "$path/*.dpo";
   for my $lang (sql_fetchall "select distinct s.lang
                               from msgid i, msgstr s
                               where i.domain = ? and i.nr = s.nr",
                              $domain) {
      my $pofile = "$path/$lang.dpo";
      my $st = sql_exec \my($id, $msg),
                        "select id, msg
                         from msgid i, msgstr s
                         where i.domain = ? and i.nr = s.nr and s.lang = ?
                               and s.flags & 1 and msg != ''
                         order by 2",
                        $domain, $lang;
      my $rows = $st->rows;
      if ($rows) {
         my $prime = int ($rows * 4 / 3) | 1;
         {
            use integer;

            outer:
            for (;; $prime += 2) {
               my $max = int sqrt $prime;
               for (my $i = 3; $i <= $max; $i += 2) {
                  next outer unless $prime % $i;
               }
               last;
            }
         }
         my $dpo = new PApp::I18n::DPO_Writer "$pofile~", $prime;
         while ($st->fetch) {
            $dpo->add(utf8_on $id,utf8_on $msg) if $id ne $msg;
         }
         undef $dpo;
         chown $uid, $gid, "$pofile~" if defined $uid;
         chmod $attr, "$pofile~" if defined $attr;
         rename "$pofile~", $pofile;
         push @files, $pofile;
      } else {
         unlink $pofile;
      }
   }
}

package PApp::I18n::PO_Reader;

use Carp;

=back

=head2 PO Reading and Writing

CLASS PApp::I18n::PO_Reader

This class can be used to read serially through a .po file. (where "po
file" is about the same thing as a standard "Portable Object" file from
the NLS standard developed by Uniforum).

=over 4

=item $po = new PApp::I18n::PO_Reader $pathname

Opens the given file for reading.

=cut

sub new {
   my ($class, $path) = @_;
   my $self;

   $self->{path} = $path;
   open $self->{fh}, "<", $path or croak "unable to open '$path' for reading: $!";

   bless $self, $class;
}

=item ($msgid, $msgstr, @comments) = $po->next;

Read the next entry. Returns nothing on end-of-file.

=cut

sub peek {
   my $self = shift;
   unless ($self->{line}) {
      do {
         chomp ($self->{line} = $self->{fh}->getline);
         Convert::Scalar::utf8_on $self->{line};
      } while defined $self->{line} && $self->{line} =~ /^\s*$/;
   }
   $self->{line};
}

sub line {
   my $self = shift;