view release on metacpan or  search on metacpan

lib/Archive/Rar/Passthrough.pm  view on Meta::CPAN

      $path =~ s/\\/\//g;
      $cmd = File::Spec->catfile($path, 'rar.exe');
      return $cmd if -e $cmd;
    }

    # or then via the uninstaller
    $path = $RegHash{'HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\WinRAR archiver\\UninstallString'};
    if (defined $path and not ref($path)) {
      $path =~ s/\\/\//g;
      $path =~ s/\/uninstall.exe$//i;
      $cmd = File::Spec->catfile($path, 'rar.exe');
      return $cmd if -e $cmd;
    }

    # try the normal path
    # yuck!
    $cmd = 'c:/program files/winrar/rar.exe';
    return $cmd if -e $cmd;

    # direct execution
    # Update: Don't try. _module_install_can_run does this better.
    #$cmd = 'rar';
    #return $cmd if $self->TestExe($cmd);

    # last resort
    return _module_install_can_run('rar32');
  }

  return();
}


# lifted and modified from Module::Install::Can ((c) Brian Ingerson, Audrey Tang, Adam Kennedy, et al)
sub _module_install_can_run {
  my $cmd = shift;
  my $_cmd = $cmd;
  
  return $_cmd
    if -x $_cmd or $_cmd = MM->maybe_command($_cmd);

  for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
    my $abs = File::Spec->catfile($dir, $cmd);
    return $abs
      if -x $abs or $abs = MM->maybe_command($abs);
  }

  return;
}




{
  my %Errors = (
   255 => 'User stopped the process',
   9   => 'Create file error',
   8   => 'Not enough memory for operation',
   7   => 'Command line option error',
   6   => 'Open file error',
   5   => 'Write to disk error',
   4   => 'Attempt to modify an archive previously locked by the \'k\' command',
   3   => 'A CRC error occurred when unpacking',
   2   => 'A fatal error occurred',
   1   => 'Non-fatal error(s) occurred',
  );

  sub explain_error {
    my $self = shift;
    my $error = shift;
    return 'Unknown error' if not $error and not exists($Errors{$error});
    return $Errors{$error};
  }
}


sub run {
  my $self = shift;

  my %args = @_;

  my $rar = $self->get_binary();
  
  my $cmd = $args{command};
  croak("You need to specify a rar *command* as argument to " . __PACKAGE__ . "->run()")
    if not defined $cmd;

  my $archive  = $args{archive};
  croak("You need to specify a rar *archive* as argument to " . __PACKAGE__ . "->run()")
    if not defined $archive;

  my $switches = $args{switches} || ['-y'];
  croak("The 'switches' argument to " . __PACKAGE__ . "->run() must be an array reference")
    if not ref($switches) eq 'ARRAY';
  
  my $files = $args{files} || [];
  croak("The 'files' argument to " . __PACKAGE__ . "->run() must be an array reference")
    if not ref($files) eq 'ARRAY';

  my $filelist_files = $args{filelist_files} || [];
  croak("The 'files' argument to " . __PACKAGE__ . "->run() must be an array reference")
    if not ref($filelist_files) eq 'ARRAY';

  #Usage:     rar <command> -<switch 1> -<switch N> <archive> <files...>
  #             <@listfiles...> <path_to_extract\>
  my $command = [
    $rar, $cmd, @$switches, $archive, @$files,
    @$filelist_files, (defined($args{path}) ? $args{path}: ())
  ];

  my ($ok, $errorcode, undef, $out_buffer, $err_buffer) = IPC::Cmd::run(command => $command);
  $self->{stdout} = join "\n", @{$out_buffer || []};
  $self->{stderr} = join "\n", @{$err_buffer || []};

  return($ok ? 0 : $errorcode);
}


1;

__END__

lib/Archive/Rar/Passthrough.pm  view on Meta::CPAN

Mandatory arguments:

  command: string indicating the command (example 'e' for extraction)
  archive: string indicating the RAR archive file to operate on

Optional arguments:

  switches: array reference to array of command line options.
            Defaults to ['-y'].
  files: list of files to add/whatever. Array reference
  filelist_files: list of files to use as file list input.
                  Array reference
  path: path to extract to

Please note that by default, the C<-y> switch is passed to C<rar>. That means all
interactive questions from C<rar> are answered with I<yes> as there is no way to
for the user to communicate with C<rar>. However, this also means that files will
be overwritten by default!

=head2 explain_error

Given an error code / number as return by the C<run()> method, this
method will return an explanation of the error. It's the same text as
that in the L<RAR RETURN CODES> section below.

=head2 get_binary

Returns the path of the rar binary that's being used.

=head2 set_binary

Set the path of the rar binary to use.

=head2 get_stdout

Returns the output (STDOUT) of the previous invocation of C<rar>.

=head2 get_stderr

Returns the error output (STDERR) of the previous invocation of C<rar>.

=head2 clear_buffers

Clears the STDOUT and STDERR buffers of the object.
You really only need to call this if you're paranoid about memery usage.

=head1 RAR RETURN CODES

The C<run()> method returns a numerical code indicating the success or failure type
of the command. Quoting the documentation of RAR 3.70 beta 1:

 RAR exits with a zero code (0) in case of successful operation. The exit
 code of non-zero means the operation was cancelled due to an error:
 
 255   USER BREAK       User stopped the process
   9   CREATE ERROR     Create file error
   8   MEMORY ERROR     Not enough memory for operation
   7   USER ERROR       Command line option error
   6   OPEN ERROR       Open file error
   5   WRITE ERROR      Write to disk error
   4   LOCKED ARCHIVE   Attempt to modify an archive previously locked
                        by the 'k' command
   3   CRC ERROR        A CRC error occurred when unpacking
   2   FATAL ERROR      A fatal error occurred
   1   WARNING          Non fatal error(s) occurred
   0   SUCCESS          Successful operation

There may be other codes in future versions of 'rar'. Error C<9> - I<CREATE ERROR>, for example,
was not present in version 2.80.

The explanations above can be accessed by your code through the C<explain_error($errno)> method.

=head1 AUTHORS

Steffen Mueller E<lt>smueller@cpan.orgE<gt>

The code for finding a rar instance in the Windows registry stems from
Archive::Rar, written by jean-marc boulade E<lt>jmbperl@hotmail.comE<gt>.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2008 Steffen Mueller.

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

The code for testing an executable is from Module::Install::Can.
It is carries: Copyright 2002, 2003, 2004, 2005, 2006 by Brian Ingerson, Audrey Tang, Adam Kennedy.

The code for determination of the rar binary from the Windows registry
is copyright (c) 2002-2006 jean-marc boulade.

Both of these contributions carry the same license that is stated above.

=head1 RAR DOCUMENTATION

This is the help message of the rar command as found on my computer.
Your milage may vary!

  RAR 3.70 beta 1   Copyright (c) 1993-2007 Alexander Roshal   8 Jan 2007
  Shareware version         Type RAR -? for help

  Usage:     rar <command> -<switch 1> -<switch N> <archive> <files...>
                 <@listfiles...> <path_to_extract\>

  <Commands>
    a             Add files to archive
    c             Add archive comment
    cf            Add files comment
    ch            Change archive parameters
    cw            Write archive comment to file
    d             Delete files from archive
    e             Extract files to current directory
    f             Freshen files in archive
    i[par]=<str>  Find string in archives
    k             Lock archive
    l[t,b]        List archive [technical, bare]
    m[f]          Move to archive [files only]
    p             Print file to stdout
    r             Repair archive
    rc            Reconstruct missing volumes