view release on metacpan or  search on metacpan

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

package Archive::Rar;

require 5.004;

use strict;
use vars ('$VERSION');
$VERSION = '2.02';

use Data::Dumper;
use Cwd;
use File::Path;
use File::Basename;

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

# #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# #-
# Objet Archive::Rar.
# #-
# #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
#    RAR exits with a zero code (0) in case of successful operation. The exit
#    code of non-zero means the operation is cancelled due to error:
#
#     255   USER BREAK       User stopped the process
#       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 (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__;

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

        } else {
            push @ret, $p->{name};
        }
    }

    return @ret;
}

# ----------------------------------------------------------------
#
#
sub GetHelp {
    my ( $self, %args, $res );
    $self                 = shift;
    $args{'-verbose'}     = 1;
    $args{'-getoutput'}   = 1;
    $self->{current}      = \%args;
    $self->{options}      = '"-?"';
    $self->{command}      = '"?"';

    #printf STDOUT ( __LINE__ . "$self->{rar} $self->{options}\n");
    $res = $self->Execute("$self->{rar} $self->{options}");

    return join( '', @{ $self->{output} } );
}

# ----------------------------------------------------------------
#
#
sub Execute {
    my $self = shift;
    $self->{cmd} = shift if ( $#_ > -1 );
    print "$self->{cmd}\n" if ( !IsEmpty( $self->{current}->{'-verbose'} ) );
    return 0 if ( !IsEmpty( $self->{current}->{'-noexec'} ) );

    $self->{output} = undef;
    if ( !IsEmpty( $self->{current}->{'-getoutput'} ) ) {
        my @res = ();
        @res = qx/$self->{cmd}/;

        # print @res;
        $self->{output} = \@res;
        return $self->SetError( $? >> 8 );
    }
    return $self->SetError( system( $self->{cmd} ) >> 8 );
}

# ----------------------------------------------------------------
#
#
sub SetError {
    my $self = shift;
    $self->{err} = shift;

    # For the rar command.
    my %errors = (
      0 => '',
      1 => "WARNING : Non fatal error(s) occurred.",
      2 => "FATAL ERROR : A fatal error occurred.",
      3 => "CRC ERROR : A CRC error occurred when unpacking.",
      4 => "LOCKED ARCHIVE : Attempt to modify an archive previously locked by the 'k' command.",
      5 => "WRITE ERROR : Write to disk error.",
      6 => "OPEN ERROR : Open file error.",
      7 => "USER ERROR : Command line option error.",
      8 => "MEMORY ERROR : Not enough memory for operation.",
      255 => "USER BREAK : User stopped the process.",
      256 => sub {"CHDIR ERROR : '" . $_[0] . "' inaccessible : " . $! . "."},
      257 => sub {"CHDIR ERROR : '" . $_[0] . "' inaccessible : " . $! . "."},
    );
    my $error = $errors{ $self->{'err'} };
    if (not defined $error) {
      $error = sprintf( "%s : UNKNOWN ERROR %08X.", $self->{err}, $self->{err} );
    }
    elsif (not $error) {
      $error = '';
    }
    elsif (ref($error) eq 'CODE') {
      $error = $error->(@_);
    }
    else {
      $error = $self->{'err'} . " : " . $error;
    }
    $self->{errstr} = $error;

    print "$self->{errstr}\n"
      if !IsEmpty( $self->{args}->{'-verbose'} );
    return $self->{err};
}

1;

__END__

=head1 NAME

Archive::Rar - Interface with the 'rar' command

=head1 SUPPORTED PLATFORMS

=over 4

=item *
Windows

=item *
Linux

=back


=head1 SYNOPSIS

 use Archive::Rar;
 my $rar = Archive::Rar->new();
 $rar->Add(
	-size => $size_of_parts,
	-archive => $archive_filename,
	-files => \@list_of_files,
 );

To extract files from archive: