summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPDB.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm30
1 files changed, 21 insertions, 9 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index f8da3fea605..c4d4ab313ce 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -134,10 +134,13 @@ sub new {
root => $params{'root'},
tlps => $params{'tlps'}
};
+ my $verify = defined($params{'verify'}) ? $params{'verify'} : 0;
+ ddebug("TLPDB new: args: @_ ; verify = $verify\n");
$_listdir = $params{'listdir'} if defined($params{'listdir'});
bless $self, $class;
if (defined($params{'tlpdbfile'})) {
- my $nr_packages_read = $self->from_file($params{'tlpdbfile'}, '-from-file');
+ my $nr_packages_read = $self->from_file($params{'tlpdbfile'},
+ 'from-file' => 1, 'verify' => $verify);
if ($nr_packages_read == 0) {
# that is bad, we didn't read anything, so return undef.
return undef;
@@ -146,7 +149,8 @@ sub new {
}
if (defined($self->{'root'})) {
my $nr_packages_read
- = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+ = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName",
+ 'verify' => $verify);
if ($nr_packages_read == 0) {
# that is bad, we didn't read anything, so return undef.
return undef;
@@ -239,7 +243,7 @@ sub remove_tlpobj {
=pod
-=item C<< $tlpdb->from_file($filename) >>
+=item C<< $tlpdb->from_file($filename, @args) >>
The C<from_file> function initializes the C<TLPDB> if the root was not
given at generation time. See L<TLPDB::new> for more information.
@@ -249,7 +253,8 @@ It returns the actual number of packages (TLPOBJs) read from C<$filename>.
=cut
sub from_file {
- my ($self, $path, $arg) = @_;
+ my ($self, $path, @args) = @_;
+ my %params = @args;
if ($self->is_virtual) {
tlwarn("TLPDB: cannot initialize a virtual tlpdb from_file\n");
return 0;
@@ -260,8 +265,7 @@ sub from_file {
my $root_from_path = dirname(dirname($path));
if (defined($self->{'root'})) {
if ($self->{'root'} ne $root_from_path) {
- # only warn if we are not given $arg = "-from-file"
- if (!defined($arg) || ($arg ne "-from-file")) {
+ if (!$params{'from-file'}) {
tlwarn("TLPDB: initialization from different location than original;\n");
tlwarn("TLPDB: hope you are sure!\n");
tlwarn("TLPDB: root=$self->{'root'}, root_from_path=$root_from_path\n");
@@ -362,12 +366,20 @@ sub from_file {
# cases the result, i.e., the unpackaged tlpdb, is in $tlpdbfile
#
# before we open and proceed, verify the downloaded file
- my ($r, $m) = TeXLive::TLUtils::verify_checksum($tlpdbfile, "$path.$TeXLive::TLConfig::ChecksumExtension");
- if ($r != 0) {
- tldie("$0: verification of $tlpdbfile from $path failed ($r): $m\n");
+ if ($params{'verify'}) {
+ my ($r, $m) = TeXLive::TLUtils::verify_checksum($tlpdbfile, "$path.$TeXLive::TLConfig::ChecksumExtension");
+ if ($r != 0) {
+ tldie("$0: verification of $tlpdbfile from $path failed ($r): $m\n");
+ }
}
open($retfh, "<$tlpdbfile") || die "$0: open($tlpdbfile) failed: $!";
} else {
+ if ($params{'verify'}) {
+ my ($r, $m) = TeXLive::TLUtils::verify_checksum($path, "$path.$TeXLive::TLConfig::ChecksumExtension");
+ if ($r != 0) {
+ tldie("$0: verification of $path failed ($r): $m\n");
+ }
+ }
open(TMP, "<$path") || die "$0: open($path) failed: $!";
$retfh = \*TMP;
}