diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 30 |
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; } |