pristine-tar 1.42 / usr / share / perl5 / Pristine / Tar.pm

This file is indexed.

/usr/share/perl5/Pristine/Tar.pm is in pristine-tar 1.42.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
#!/usr/bin/perl
# pristine-tar utility library

package Pristine::Tar;

use warnings;
use strict;
use File::Temp;
use Getopt::Long;
use IPC::Open2;
use Exporter q{import};

our @EXPORT = qw(error message debug vprint doit try_doit doit_redir
  tempdir dispatch comparefiles version_from_env
  $verbose $debug $keep $help);

our $verbose = 0;
our $debug   = 0;
our $keep    = 0;
our $help    = 0;

sub progname {
  my $name = $0;
  $name =~ s!^.*/(.+)$!$1!;
  return $name;
}

sub error {
  die progname() . ": @_\n";
}

sub message {
  print STDERR progname() . ": @_\n";
}

sub debug {
  message(@_) if $debug;
}

sub vprint {
  message(@_) if $verbose;
}

sub doit {
  if (try_doit(@_) != 0) {
    error "command failed: @_";
  }
}

sub try_doit {
  vprint(@_);
  return system(@_);
}

sub doit_redir {
  no warnings 'once';
  my ($in, $out, @args) = @_;
  vprint(@args, "<", $in, ">", $out);
  open INFILE,  "<", $in  or die("Could not open '$in' for reading: $!\n");
  open OUTFILE, ">", $out or die("Could not open '$out' for reading: $!\n");
  my $pid = open2(">&OUTFILE", "<&INFILE", @args);
  waitpid $pid, 0;
  if ($? != 0) {
    error "command failed: @args";
  }
}

sub tempdir {
  return File::Temp::tempdir(
    "pristine-tar.XXXXXXXXXX",
    TMPDIR  => 1,
    CLEANUP => !$keep
  );
}

# Workaround for bug #479317 in perl 5.10.
sub END {
  chdir("/");
}

sub dispatch {
  my %params = @_;

  my %commands = %{ $params{commands} };
  my %options = %{ $params{options} } if exists $params{options};

  my $command;
  Getopt::Long::Configure("bundling");
  if (
    !GetOptions(
      %options,
      "v|verbose!" => \$verbose,
      "d|debug!"   => \$debug,
      "k|keep!"    => \$keep,
      "h|help!"    => \$help,
    )
    || !@ARGV
    )
  {
    $command = "usage";
  } else {
    $command = shift @ARGV;
    $help = 1 if ($command eq "usage");
  }

  my $i = $commands{$command};
  if (!defined $i) {
    error "Unknown subcommand \"$command\"";
  }

  # Check that the right number of args were passed by user.
  if (defined $i->[1] && @ARGV != $i->[1]) {
    $command = "usage";
    $i       = $commands{$command};
  }

  if ($help || $command eq "usage") {
    $commands{"usage"}->[0]->(0);
    exit($help ? 0 : 1);
  }

  $i->[0]->(@ARGV);
}

sub comparefiles {
  my ($old, $new) = (shift, shift);
  system('cmp', '-s', $old, $new);

  if ($? == -1 || $? & 127) {
    die("Failed to execute cmp: $!\n");
  }

  return $? >> 8;
}

sub version_from_env {
  my ($version, %xdeltas) = @_;
  if (exists $ENV{PRISTINE_ALL_XDELTA}) {
    my $xdelta = $ENV{PRISTINE_ALL_XDELTA};
    if (exists $xdeltas{$xdelta}) {
      $version = $xdeltas{$xdelta};
    } else {
      die "Unknown delta program: $xdelta";
    }
  }
  return $version;
}

1

APT Browse - Built by Thomas Orozco.