view release on metacpan or  search on metacpan

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

#       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 (User exit)

# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# ++ fonctions r‚cup‚r‚es dans CHKPROJECT.pm pour en ‚viter l'inclusion.
# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

# -----------------------------------------------------------------------
# --
# --
sub IsEmpty {
    return 1 if @_ == 0 or not defined $_[0] or $_[0] eq '';
    return undef;
}

# -----------------------------------------------------------------------
#
#
sub CleanDir {
    $_[0] =~ s|\\|/|g   if $IsWindows;
    $_[0] =~ s|/+|/|g;
    $_[0] =~ s|/$||g;
    $_[0] =~ s|:$|:/\.| if $IsWindows;
    $_[0];
}

# ----------------------------------------------------------------
#
#
sub new {
    my $class = shift;

    my $self = bless {}, $class;
    return undef if not defined $self->initialize(@_);
    return $self;
}

# ---------------------------------------------------------------------------
# --
# --
sub WarnOutput {
    my $self = shift;

    return if $self->{silent} or not $self->{dissert};
    my $fh = (defined $self->{stderr} ? $self->{stderr} : \*STDERR);

    print $fh "$_\n" foreach @_;
}

# ---------------------------------------------------------------------------
# --
# --
my $unique_instance;

sub self_or_default {
    return @_
      if defined($_[0]) and !ref($_[0]) and $_[0] eq __PACKAGE__;
    unless ( defined($_[0]) and ref( $_[0] ) eq __PACKAGE__ ) {
        #print caller(1); # FIXME
        $unique_instance = __PACKAGE__->new() unless defined($unique_instance);
        unshift( @_, $unique_instance );
    }
    return @_;
}

# ----------------------------------------------------------------
#
#
sub TestExe {
    my ( $self, $cmd ) = @_;
    my $redirect = '';

    # $redirect =' > NUL:' if $IsWindows;
    # print "--" . system("$cmd $redirect") . "--\n";
    my @r = qx/$cmd/;
    return 1 if $#r > 10;
    return undef;
}

# ----------------------------------------------------------------
#
#
sub SearchExe {
    my $self  = shift;
    my $cmd = 'rar';

    if ( $IsWindows ) {
        my ( $key, $type, $value );

        # we try to catch the running path through the key
        if (
            $::HKEY_LOCAL_MACHINE->Open(
                'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe', $key )
            and $key->QueryValueEx( "path", $type, $value )
          )
        {
            $value =~ s/\\/\//g;
            $cmd = $value . '/rar.exe';
            goto Good if ( -e $cmd );
        }

        # or through the uninstaller
        if (
            $::HKEY_LOCAL_MACHINE->Open(
                'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\WinRAR archiver', $key )
            and $key->QueryValueEx( "UninstallString", $type, $value )
          )
        {
            $value =~ s/\\/\//g;
            $value =~ s/\/uninstall.exe$//i;
            $cmd = $value . '/rar.exe';
            goto Good if -e $cmd;
        }

        # or the direct execution
        $cmd = 'rar';
        goto Good if $self->TestExe($cmd);

        # a last resort...