File Coverage

blib/lib/App/Greple/msdoc.pm

Criterion	Covered	Total	%
statement	35	74	47.3
branch	0	30	0.0
condition	0	9	0.0
subroutine	12	15	80.0
pod	0	3	0.0
total	47	131	35.8

=head1 NAME

msdoc - Greple module for access MS office docx/pptx/xlsx documents

=head1 VERSION

Version 1.04

=head1 SYNOPSIS

greple -Mmsdoc

=head1 DESCRIPTION

This module makes it possible to search string in Microsoft
docx/pptx/xlsx file.

Microsoft document consists of multiple files archived in zip format.
String information is stored in "word/document.xml",
"ppt/slides/*.xml" or "xl/sharedStrings.xml".  This module extracts
these data and replaces the search target.

By default, text part from XML data is extracted.  This process is
done by very simple method and may include redundant information.

Strings are simply connected into paragraph for I<.docx> and I<.pptx>
document.  For I<.xlsx> document, single space is inserted between
them.  Use B<--separator> option to change this behavior.

After every paragraph, single newline is inserted for I<.pptx> and
I<.xlsx> file, and double newlines for I<.docx> file.  Use
B<--space> option to change.

=head1 OPTIONS

=over 7

=item B<--dump>

Simply print all converted data.  Additional pattern can be specified,
and they will be highlighted inside whole text.

    $ greple -Mmsdoc --dump -e foo -e bar buz.docx

=item B<--space>=I

Specify number of newlines inserted after every paragraph.  Any
non-negative integer is allowed including zero.

=item B<--separator>=I

Specify the separator string placed between each component strings.

=item B<--indent>

Extract indented XML document, not a plain text.

=item B<--indent-mark>=I

Set indentation string.  Default is C<| >.

=back

=head1 INSTALL

cpanm App::Greple::msdoc

=head1 SEE ALSO

L

L

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 2018-2020 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.04';

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;
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/\.docx$/, [ qw(w:t w:delText w:instrText wp:posOffset) ] ],
	    [ qr/\.pptx$/, [ qw(a:t) ] ],
	    [ qr/\.xlsx$/, [ qw(t v f formula1) ] ],
	);
    };

    my $level = 0;

    s{
	(?
	  (?
	    < (?[\w:]+) [^>]* />
	  )
	  |
	  (?
	    < (?[\w:]+) [^>]* (?
	  )
	  |
	  (?
	    < / (?[\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;
*to_text  = \&App::optex::textconv::msdoc::to_text;
*get_list = \&App::optex::textconv::msdoc::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 =~ /\.(docx|xlsx|pptx)$/)[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;
	}
	my $xml = decode 'utf8', join "\n", @xml;
	if (my $sub = $formatter{$format}) {
	    $sub->(&FILELABEL => $file) for $xml;
	}
	print $xml;
	exit;
    }
    die;
}

1;

__DATA__