view release on metacpan or  search on metacpan

lib/App/Greple/msdoc.pm  view on Meta::CPAN

L<App::optex::textconv>,
L<https://github.com/kaz-utashiro/optex-textconv>

L<App::ansicolumn>,

L<https://qiita.com/kaz-utashiro/items/30594c16ed6d931324f9>
(in Japanese)

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 2018-2024 Kazumasa Utashiro.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

package App::Greple::msdoc;

our $VERSION = '1.07';

use strict;
use warnings;
use v5.14;
use Carp;
use utf8;
use Encode;

use Exporter 'import';
our @EXPORT      = ();
our %EXPORT_TAGS = ();
our @EXPORT_OK   = ();

use App::Greple::Common qw(&FILELABEL);
use Data::Dumper;

our $indent_mark = "| ";
our $opt_space = undef;
our $opt_separator = undef;
our $opt_type;
our $default_format = 'text';

sub separate_xml {
    s{ (?<=>) ([^<]*) }{ $1 ? "\n$1\n" : "\n" }gex;
}

sub indent_xml {
    my %arg = @_;
    my $file = delete $arg{&FILELABEL} or die;

    my %nonewline = do {
	map  { $_ => 1 }
	map  { @{$_->[1]} }
	grep { $file =~ $_->[0] } (
	    [ qr/\.doc[xm]$/, [ qw(w:t w:delText w:instrText wp:posOffset) ] ],
	    [ qr/\.ppt[xm]$/, [ qw(a:t) ] ],
	    [ qr/\.xls[xm]$/, [ qw(t v f formula1) ] ],
	);
    };

    my $level = 0;

    s{
	(?<mark>
	  (?<single>
	    < (?<tag>[\w:]+) [^>]* />
	  )
	  |
	  (?<open>
	    < (?<tag>[\w:]+) [^>]* (?<!/) >
	  )
	  |
	  (?<close>
	    < / (?<tag>[\w:]+) >
	  )
	)
    }{
	if (not $+{single} and $nonewline{$+{tag}}) {
	    join("", $+{open} ? $indent_mark x $level : "",
		 $+{mark},
		 $+{close} ? "\n" : "");
	}
	else {
	    $+{close} and $level--;
	    ($indent_mark x ($+{open} ? $level++ : $level)) . $+{mark} . "\n";
	}
    }gex;
}

use Archive::Zip;
use App::optex::textconv::msdoc qw(to_text get_list);

my %formatter = (
    'indent-xml'   => \&indent_xml,
    'separate-xml' => \&separate_xml,
    );

sub extract_content {
    my %arg = @_;
    my $file = $arg{&FILELABEL} or die;
    my $type = ($file =~ /\.((?:doc|xls|ppt)[xm])$/)[0] or die;
    my $pid = open(STDIN, '-|') // croak "process fork failed: $!";
    binmode STDIN, ':encoding(utf8)';
    if ($pid) {
	return $pid;
    }
    my $format = $arg{format} // $default_format;
    if ($format eq 'text') {
	print decode 'utf8', to_text($file);
	exit;
    } elsif ($format =~ /xml$/) {
	my $zip = Archive::Zip->new($file);
	my @xml;
	for my $entry (get_list($zip, $type)) {
	    my $member = $zip->memberNamed($entry) or next;
	    my $xml = $member->contents or next;
	    push @xml, $xml;