File Coverage

blib/lib/App/Zip/X.pm

Criterion	Covered	Total	%
statement	42	56	75.0
branch	8	24	33.3
condition	6	23	26.0
subroutine	10	11	90.9
pod	0	3	0.0
total	66	117	56.4

package App::Zip::X;
use 5.10.0;
use strict;
use warnings;

use Getopt::Long    qw(GetOptionsFromArray);
use Archive::Zip    qw(AZ_OK);
use XML::LibXML;

our $VERSION = '1.01';


# constant integers to specify indentation modes -- see L
use constant XML_NO_INDENT     => 0;
use constant XML_SIMPLE_INDENT => 1;


sub run { # no new() method -- this method both creates the instance and executes the request
  my ($class, @args) = @_;

  my $self = bless {}, $class;

  GetOptionsFromArray \@args, $self,
    'unzip!',        # unzip mode (default)
    'zip!',          # zip mode
    'xml_indent!',   # handle indentation of XML extracted files (default)

    'archive=s',     # archive name (or first arg on command line)
    'member=s',      # member to extract (or second arg on command line)
  ;

  # other syntax : archive name and member name from command line without options
  $self->{archive} //= shift @args  or die "unspecified ZIP archive";
  $self->{member}  //= shift @args  or die "unspecified member to extract from $self->{zip}";
  !@args                            or die "don't undestand these args: ", join(", ", @args);

  # default flags and consistency check
  !($self->{zip} && $self->{unzip})    or die "options -zip and -unzip are mutually exclusive";
  $self->{unzip} //= 1 unless $self->{zip};

  # open ZIP archive
  $self->{zipper} = Archive::Zip->new;
  $self->{zipper}->read($self->{archive}) == AZ_OK
      or die "cannot open ZIP archive $self->{archive}";

  # decide what to do
  if    ($self->{unzip}) { $self->extract() }
  elsif ($self->{zip})   { $self->replace() }
  else                   { die "neither -zip nor -unzip .. not clear what you want to do"}

}



sub extract {
  my ($self) = @_;

  # get member contents
  my $contents = $self->{zipper}->contents($self->{member})
    or die "no member named '$self->{member}' in $self->{archive}";

  # add XML indentation if necessary
  if ($self->{xml_indent} && ($self->{member} =~ /\.xml$/i || $contents =~ /^<\?xml/)) {
    my $dom   = XML::LibXML->load_xml(string => $contents, recover => 1);
    $contents = $dom->toString(XML_SIMPLE_INDENT); # already utf8-encoded
  }

  # write on STDOUT
  binmode STDOUT, ':raw';
  print $contents;
}


sub replace {
  my ($self) = @_;

  # slurp contents from file relative to current directory
  local $/;
  open my $fh, "<:raw", $self->{member} or die "open $self->{member}: $!";
  my $contents = <$fh>;
  close $fh;

  # remove XML indentation if necessary
  if ($self->{xml_indent} && ($self->{member} =~ /\.xml$/i || $contents =~ /^<\?xml/)) {
    my $dom   = XML::LibXML->load_xml(string => $contents);
    $contents = $dom->toString(XML_NO_INDENT);
  }

  # replace member in archive and save
  my $zipper = $self->{zipper};
  $zipper->removeMember($self->{member});
  $zipper->addString($contents, $self->{member});
  $zipper->overwrite;
}


1; # End of App::Zip::X

__END__