view release on metacpan or  search on metacpan

lib/Compress/Bzip2.pm  view on Meta::CPAN

  if ( !S_ISREG( $statsnap->[2] ) ) {
    bz_seterror( &BZ_IO_ERROR, "file $filename is not a normal file" );
    return 0;
  }

  if ( !$force && S_ISLNK( $statsnap->[2] ) ) {
    bz_seterror( &BZ_IO_ERROR, "file $filename is a symlink" );
    return 0;
  }

  if ( !$force && $statsnap->[3] > 1 ) {
    bz_seterror( &BZ_IO_ERROR, "file $filename has too many hard links" );
    return 0;
  }

  return 1;
}

sub _set_stat_from_snapshot ( $$ ) {
  my ( $filename, $statsnap ) = @_;

  if ( !chmod( S_IMODE( $statsnap->[2] ), $filename ) ) {
    bz_seterror( &BZ_IO_ERROR, "chmod ".sprintf('%03o', S_IMODE( $statsnap->[2] ))." $filename failed: $!" );
    return undef;
  }

  if ( !utime @$statsnap[8,9], $filename ) {
    bz_seterror( &BZ_IO_ERROR,
		 "utime " . join(' ',map { strftime('%Y-%m-%d %H:%M:%S', localtime $_) } @$statsnap[8,9] ) .
		 " $filename failed: $!" );
    return undef;
  }

  if ( !chown @$statsnap[4,5], $filename ) {
    bz_seterror( &BZ_IO_ERROR,
		 "chown " . join(':', ( getpwuid($statsnap->[4]) )[0], ( getgrgid($statsnap->[5]) )[0]) .
		 " $filename failed: $!" );
    return 0;
  }

  return 1;
}

sub bzip2 ( @ ) {
  return _process_files( 'bzip2', 'cfvks123456789', @_ );
}

sub bunzip2 ( @ ) {
  return _process_files( 'bunzip2', 'cdzfks123456789', @_ );
}

sub bzcat ( @ ) {
  return _process_files( 'bzcat', 'cdzfks123456789', @_ );
}

sub _process_files ( @ ) {
  my $command = shift;
  my $opts = shift;

  local @ARGV = @_;

  my %opts;
  return undef if !getopt( $opts, \%opts );
  # c compress or decompress to stdout
  # d decompress
  # z compress
  # f force
  # v verbose
  # k keep
  # s small
  # 123456789

  $opts{c} = 1 if $command eq 'bzcat';
  $opts{d} = 1 if $command eq 'bunzip2' || $command eq 'bzcat';
  $opts{z} = 1 if $command eq 'bzip2';

  my $read_from_stdin;
  my ( $in, $bzin );
  my ( $out, $bzout );

  if ( !@ARGV ) {
    $read_from_stdin = 1;
    $opts{c} = 1;
    if ( !open( $in, "<&STDIN" ) ) {
      die "Error: failed to input from STDIN: '$!'\n";
    }

    $bzin = bzopen( $in, "r" );
  }

  if ( $opts{c} ) {
    if ( !open( $out, ">&STDOUT" ) ) {
      die "Error: failed to output to STDOUT: '$!'\n";
    }

    $bzout = bzopen( $out, "w" );
  }

  if ( !$opts{d} && !$opts{z} ) {
    die "Error: neither compress nor decompress was indicated.\n";
  }

  my $doneflag = 0;
  while ( !$doneflag ) {
    my $infile;
    my $outfile;
    my @statbuf;

    if ( !$read_from_stdin ) {
      $infile = shift @ARGV;
      if ( ! -r $infile ) {
	print STDERR "Error: file $infile is not readable\n";
	next;
      }

      @statbuf = stat _;
      if ( !@statbuf ) {
	print STDERR "Error: failed to stat $infile: '$!'\n";
	next;
      }