view release on metacpan or  search on metacpan

t/60_encoding.t  view on Meta::CPAN

  my $member_name = $_[0] // DEFAULT_MEMBER_NAME;

  my $zip = $$self;

  my $member = $zip->memberNamed($member_name)
    // confess "No such member ",visq($member_name);

  decode_xml( $member->contents(), $member_name )
}

sub replace_content {  # $obj->set_content($chars, encoding => "...")
  my $self = shift;
  my ($chars, %opts) = @_;
  my $member_name = $opts{member_name} // DEFAULT_MEMBER_NAME;
  my $encoding = $opts{encoding};
  confess "encoding must be specified" unless $encoding;

  my $octets = encode_xml($chars, $encoding, "new content");

  my $zip = $$self;
  my $member = $zip->memberNamed($member_name)
    // confess "No such member ",visq($member_name);
  $zip->removeMember($member_name);
  my $new_member = $zip->addString($octets, $member_name);
  $new_member->desiredCompressionMethod( COMPRESSION_DEFLATED );
}

sub store {
  my ($self, $dest_path) = @_;
  confess "Destination path missing" unless $dest_path;
  my $zip = $$self;
  note "> Writing ",qsh($dest_path)," at ",(caller(0))[2] if $main::debug;
  $zip->writeToFileNamed($dest_path) == AZ_OK
    or confess "Write error ($!)";
}

#-----------------------------------------------------
package main;

my $teststring = "AAA 低重心 BBB";
my $testoctets_re = qr/(AAA .* BBB)/s;

my $orig_path = "$tmpdir/original.odt";
{ my $doc = odf_new_document('text');
  my $body = $doc->get_body;
  my $para = odf_create_paragraph( text => $teststring );
  $body->append_element($para);
  $doc->save(target => $orig_path);
  $doc->forget;
}

my $orig_xmltext;
{ my $obj = MyXML->new($orig_path);
  ($orig_xmltext, my $enc) = $obj->get_content();
  ok($enc eq "UTF-8", "Default odf encoding is UTF-8");
  $orig_xmltext =~ qr/\Q$teststring\E/ or die "'$teststring' NOT FOUND!";
}

# N.B. All these encodings still map 0-127 to ASCII, so it is possible
# to parse the xml header when re-reading.  This is not the case, for example,
# with UTF-16 (which depends on BOM detection).
for my $alt_enc (qw/UTF-8 big5 euc-kr x-sjis-cp932/) {
  note "--- ",visq($alt_enc)," ---";
  my $new_path = "$tmpdir/using_${alt_enc}.odt";
  {
    # Encode content.xml differently
    my $alt_xmloctets = eval { MyXML::encode_xml($orig_xmltext, $alt_enc) };
    if ($@) { diag "$alt_enc does not work"; next }
    oops "not encoded??" if $alt_xmloctets =~ /\Q$teststring\E/;
    $alt_xmloctets =~ /$testoctets_re/
      or oops "can not find encoded octets";
    note "Octets in $alt_enc are ",vis($1);

    # Parse the alternatively-encoded xml with XML::Twig's parse()
    my $twig = XML::Twig->new();
    $twig->parse($alt_xmloctets);  # expects binary octets as input
    { my $found;
      foreach my $para ($twig->descendants('text:p')) {
        foreach ($para->descendants()) {
          # but returns Perl *characters* from the text() method
          $found++ if ($_->text()//"") eq $teststring
        }
      }
      ok($found, "XML::Twig parse()'d $alt_enc, text() returned chars");
    }
    # Create an alternate ODF file and read it via ODF::lpOD
    my $obj = MyXML->new($orig_path);
    $obj->replace_content($orig_xmltext, encoding => $alt_enc);
    $obj->store($new_path);
    $obj = undef;
    $obj = MyXML->new($new_path);
    my ($xml, $enc) = $obj->get_content();
    bug unless $enc eq $alt_enc;

    note "> Opening ",qsh($new_path)," as ODF doc..." if $debug;
    my $doc = odf_get_document($new_path);
    my $body = $doc->get_body;
    { my $found;
      foreach my $para ($body->get_paragraphs) {
        my $text = $para->get_text // next;
        $found=1 if $text =~ /\Q${teststring}\E/;
      }
      ok($found, "Re-read ODF doc with content.xml encoded with $alt_enc");
    }
  }
}

done_testing();