view release on metacpan or  search on metacpan

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

sub _stat_snapshot ( $ ) {
  my ( $filename ) = @_;
  return undef if !defined($filename);

  my @stats = stat $filename;
  if (!@stats) {
    warn "stat of $filename failed: $!\n" if !@stats;
    return undef;
  }

  return \@stats;
}

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

  if ( !defined($statsnap) || (ref($statsnap) eq 'ARRAY' && @$statsnap == 0) ) {
    $statsnap = _stat_snapshot( $filename );
    if ( $statsnap ) {
      if ( @_>1 ) {
	if ( !defined($_[1]) ) {
	  $_[1] = $statsnap;
	}
	elsif ( ref($_[1]) eq 'ARRAY' && @{ $_[1] } == 0 ) {
	  @{ $_[1] } = @$statsnap;
	}
      }
    }
    else {
      return undef;
    }
  }

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

  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;