view release on metacpan or  search on metacpan

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

package Archive::Rar::Passthrough;

require 5.004;

use strict;

use vars qw/$VERSION/;
$VERSION = '2.00_02';

use ExtUtils::MakeMaker;
use Config ();
use File::Spec;
use Carp qw/croak/;
use IPC::Run ();
use IPC::Cmd ();

BEGIN {
  if (not IPC::Cmd->can_capture_buffer()) {
    die "IPC::Cmd needs to be able to capture buffers for Archive::Rar::Passthrough to work. However, it doesn't. Check the IPC::Cmd documentation for details";
  }
}

my $IsWindows = ($^O =~ /win32/i ? 1 : 0);

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my %args = @_;

  my $self = {
    rar    => 'rar',
    stdout => '',
    stderr => '',
    ( ref($proto) ? %$proto : () ),
  };
  $self->{rar} = $args{rar} if exists $args{rar}; 

  bless $self => $class;
  return() if not $self->{rar} = $self->_findbin();
  
  return $self;
}

sub get_binary { $_[0]->{rar} }
sub set_binary { $_[0]->{rar} = $_[1] if defined $_[1]; 1; }

sub get_stdout { $_[0]->{stdout} }
sub get_stderr { $_[0]->{stderr} }
sub clear_buffers { $_[0]->{stderr} = $_[0]->{stdout} = ''; 1; }

# searches the rar binary.
sub _findbin {
  my $self = shift;
  my $bin = $self->get_binary();
  
  my $cmd = _module_install_can_run($bin);
  
  return $cmd if defined $cmd;

  # From Archive::Rar, (c) Jean-Marc Boulade
  # modified by Steffen Mueller
  if ( $IsWindows ) {
    require Win32::TieRegistry;
    my %RegHash;
    Win32::TieRegistry->import( TiedHash => \%RegHash );
    
    my $path;

    # try to find the installation path
    $path = $RegHash{'HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\WinRAR.exe\\path'};
    if (defined $path and not ref($path)) {
      $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');
  }