view release on metacpan or  search on metacpan

lib/MsOffice/Word/Surgeon.pm  view on Meta::CPAN

package MsOffice::Word::Surgeon;
use 5.24.0;
use Moose;
use MooseX::StrictConstructor;
use Moose::Util::TypeConstraints          qw(union);
use Archive::Zip                          qw(AZ_OK);
use Encode                                qw(encode_utf8 decode_utf8);
use Scalar::Util                          qw(openhandle);
use MsOffice::Word::Surgeon::Carp;
use MsOffice::Word::Surgeon::Revision;
use MsOffice::Word::Surgeon::PackagePart;

# syntactic sugar for attributes
sub has_lazy  ($@) {my $attr = shift; has($attr => @_, lazy => 1, builder => "_$attr")}
sub has_inner ($@) {my $attr = shift; has_lazy($attr => @_, init_arg => undef)}


use namespace::clean -except => 'meta';

our $VERSION = '2.11';


#======================================================================
# TYPES AND ATTRIBUTES
#======================================================================

my $DocxSource = union([qw/Str FileHandle/]);

# how to access the document
has      'docx'           => (is => 'ro', isa => $DocxSource);    # filename or filehandle, or ..
has_lazy 'zip'            => (is => 'ro', isa => 'Archive::Zip'); # .. an already opened zip archive

# syntax to show embedded fields -- used by PackagePart::replace_field
has 'show_embedded_field' => (is => 'ro', isa => 'Str', default => '{%s}');

# inner attributes lazily constructed by the module
has_inner 'parts'         => (is => 'ro', isa => 'HashRef[MsOffice::Word::Surgeon::PackagePart]',
                              traits => ['Hash'], handles => {part => 'get'});
                          
has_inner 'document'      => (is => 'ro', isa => 'MsOffice::Word::Surgeon::PackagePart',
                             handles => [qw/contents original_contents indented_contents plain_text replace/]);
  # Note: this attribute is equivalent to $self->part('document'); made into an attribute
  # for convenience and for automatic delegation of methods through the 'handles' declaration

# just a slot for internal storage
has 'next_rev_id'         => (is => 'bare', isa => 'Num', default => 1, init_arg => undef);
   # used by the revision() method for creating *::Revision objects -- each instance
   # gets a fresh value


#======================================================================
# BUILDING INSTANCES
#======================================================================


# syntactic sugar for supporting ->new($path) instead of ->new(docx => $path)
around BUILDARGS => sub {
  my $orig  = shift;
  my $class = shift;

  unshift @_, 'docx' if scalar(@_) % 2 and $DocxSource->check($_[0]);

  $class->$orig(@_);
};


# make sure that the constructor got either a 'docx' or a 'zip' attribute
sub BUILD {
  my $self = shift;

  my $class = ref $self;

  $self->{docx} || $self->{zip}
    or croak "$class->new() : need either 'docx' or 'zip' attribute";
  not ($self->{docx} && $self->{zip})
    or croak "$class->new() : can't have both 'docx' and 'zip' attributes";
}


#======================================================================
# LAZY ATTRIBUTE CONSTRUCTORS
#======================================================================

sub _zip {
  my $self = shift;

  my $docx = $self->docx;
  my ($meth, $source_name) = openhandle($docx) ? (readFromFileHandle => 'filehandle')
                                               : (read               => $docx);
  my $zip                  = Archive::Zip->new;
  my $result               = $zip->$meth($docx);
  $result == AZ_OK  or croak "cannot unzip from $source_name";

  return $zip;
}