summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPDB.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2015-01-12 23:18:24 +0000
committerKarl Berry <karl@freefriends.org>2015-01-12 23:18:24 +0000
commitdfceae4bc24ca1298d5db7d99cd8c14f801b1112 (patch)
tree2cedafe80d38dac9f4faef98d7bd0cfc5bb9f9d3 /Master/tlpkg/TeXLive/TLPDB.pm
parentbd074a3cb017b7513267c1a7de5d665b2aa21da8 (diff)
more systematically use TLPDB prefix on warnings
git-svn-id: svn://tug.org/texlive/trunk@36041 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm96
1 files changed, 51 insertions, 45 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index a3d04b025eb..04d6b7b9971 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -1,6 +1,6 @@
# $Id$
# TeXLive::TLPDB.pm - module for using tlpdb files
-# Copyright 2007-2014 Norbert Preining
+# Copyright 2007-2015 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -175,7 +175,7 @@ The C<add_tlpobj> adds an object of the type TLPOBJ to the TLPDB.
sub add_tlpobj {
my ($self,$tlp) = @_;
if ($self->is_virtual) {
- tlwarn("cannot add tlpobj to a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot add tlpobj to a virtual tlpdb\n");
return 0;
}
$self->{'tlps'}{$tlp->name} = $tlp;
@@ -227,7 +227,7 @@ package is not present
sub remove_tlpobj {
my ($self,$pkg) = @_;
if ($self->is_virtual) {
- tlwarn("cannot remove tlpobj from a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot remove tlpobj from a virtual tlpdb\n");
return 0;
}
if (defined($self->{'tlps'}{$pkg})) {
@@ -251,7 +251,7 @@ It returns the actual number of packages (TLPOBJs) read from C<$filename>.
sub from_file {
my ($self, $path, $arg) = @_;
if ($self->is_virtual) {
- tlwarn("cannot initialize from file a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot initialize a virtual tlpdb from_file\n");
return 0;
}
if (@_ < 2) {
@@ -260,11 +260,12 @@ 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")) {
- tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n");
- tlwarn("Initialization from different location as originally given.\nHope you are sure!\n");
- }
+ # only warn if we are not given $arg = "-from-file"
+ if (!defined($arg) || ($arg ne "-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");
+ }
}
} else {
$self->root($root_from_path);
@@ -395,7 +396,7 @@ the file handle given as argument.
sub writeout {
my $self = shift;
if ($self->is_virtual) {
- tlwarn("cannot write out a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot writeout a virtual tlpdb\n");
return 0;
}
my $fd = (@_ ? $_[0] : STDOUT);
@@ -418,7 +419,7 @@ as location. If the location is undefined, die.
sub save {
my $self = shift;
if ($self->is_virtual) {
- tlwarn("cannot save a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot save a virtual tlpdb\n");
return 0;
}
my $path = $self->location;
@@ -501,7 +502,7 @@ adds new dependencies they are not necessarily fulfilled.
sub add_tlpcontainer {
my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
if ($self->is_virtual) {
- tlwarn("cannot add tlp container to a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot add_tlpcontainer to a virtual tlpdb\n");
return 0;
}
my @archs;
@@ -545,7 +546,7 @@ sub _add_tlpcontainer {
} else {
die "$0: No package $container (.zip or .xz) in $ziplocation";
}
- tlwarn("Huuu, this needs testing and error checking!\n");
+ tlwarn("TLPDB: Hmmm, this needs testing and error checking!\n");
tlwarn("Should we use -a -- adapt line endings etc?\n");
`$unpackprog $args`;
# we only create/add tlpobj for arch eq "all"
@@ -617,7 +618,7 @@ sub media_of_package {
if (defined($self->{'tlpdbs'}{$tag})) {
return $self->{'tlpdbs'}{$tag}->media;
} else {
- tlwarn ("tag $tag is not known.\n");
+ tlwarn("TLPDB::media_of_package: tag not known: $tag\n");
return;
}
} else {
@@ -666,7 +667,7 @@ sub list_packages {
if (defined($self->{'tlpdbs'}{$tag})) {
return $self->{'tlpdbs'}{$tag}->list_packages;
} else {
- tlwarn("TLPDB:list_packages: tag not defined: $tag\n");
+ tlwarn("TLPDB::list_packages: tag not defined: $tag\n");
return 0;
}
}
@@ -967,7 +968,7 @@ sub _generate_listfile {
foreach my $p (@lop) {
my $subtlp = $self->get_package($p);
if (!defined($subtlp)) {
- tlwarn("TLPDB: $listname references $p, but it is not in tlpdb\n");
+ tlwarn("TLPDB: $listname references $p, but this is not in tlpdb\n");
}
$s += $subtlp->total_size;
}
@@ -1046,7 +1047,7 @@ installation.
sub root {
my $self = shift;
if ($self->is_virtual) {
- tlwarn("cannot set/edit root of a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot set/edit root of a virtual tlpdb\n");
return 0;
}
if (@_) { $self->{'root'} = shift }
@@ -1069,7 +1070,7 @@ special value C<__MASTER>.
sub location {
my $self = shift;
if ($self->is_virtual) {
- tlwarn("cannot get location of a virtual tlpdb\n");
+ tlwarn("TLPDB: cannot get location of a virtual tlpdb\n");
return 0;
}
return "$self->{'root'}/$InfraLocation/$DatabaseName";
@@ -1467,16 +1468,19 @@ sub install_package {
if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
return $self->{'tlpdbs'}{$tag}->install_package($pkg, $totlpdb);
} else {
- tlwarn("package $pkg not found in repository $tag\n");
+ tlwarn("TLPDB::install_package: package $pkg not found"
+ . " in repository $tag\n");
return;
}
} else {
- my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg);
+ my ($maxtag, $maxrev, $maxtlp, $maxtlpdb)
+ = $self->virtual_candidate($pkg);
return $maxtlpdb->install_package($pkg, $totlpdb);
}
} else {
if (defined($tag)) {
- tlwarn("not a virtual database, ignoring tag $tag on installation of $pkg\n");
+ tlwarn("TLPDB: not a virtual tlpdb, ignoring tag $tag"
+ . " on installation of $pkg\n");
}
return $self->not_virtual_install_package($pkg, $totlpdb);
}
@@ -1487,10 +1491,12 @@ sub not_virtual_install_package {
my ($self, $pkg, $totlpdb) = @_;
my $fromtlpdb = $self;
my $ret;
- die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
+ die("TLPDB not initialized, cannot find tlpdb!")
+ unless (defined($fromtlpdb));
+
my $tlpobj = $fromtlpdb->get_package($pkg);
if (!defined($tlpobj)) {
- tlwarn("$0: Cannot find package $pkg\n");
+ tlwarn("TLPDB::not_virtual_install_package: cannot find package: $pkg\n");
return 0;
} else {
my $container_src_split = $fromtlpdb->config_src_container;
@@ -1535,7 +1541,7 @@ sub not_virtual_install_package {
} elsif (-r "$root/$Archive/$pkg.tar.xz") {
$container = "$root/$Archive/$pkg.tar.xz";
} else {
- tlwarn("Cannot find a package $pkg (.zip or .xz) in $root/$Archive\n");
+ tlwarn("TLPDB: cannot find package $pkg (.zip or .xz) in $root/$Archive\n");
next;
}
} elsif (&media eq 'NET') {
@@ -1653,7 +1659,7 @@ sub _install_package {
my $wget = $::progs{'wget'};
my $xzdec = TeXLive::TLUtils::quotify_path_with_spaces($::progs{'xzdec'});
if (!defined($wget) || !defined($xzdec)) {
- tlwarn("_install_package: programs not set up properly, strange.\n");
+ tlwarn("TLPDB::_install_package: programs not set up properly; hmm.\n");
return(0);
}
@@ -1700,7 +1706,7 @@ sub _install_package {
if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
return(1);
} else {
- tlwarn("_install_package: Don't know how to install $what\n");
+ tlwarn("TLPDB::_install_package: don't know how to install $what\n");
return(0);
}
}
@@ -1722,7 +1728,7 @@ sub remove_package {
my $tlp = $localtlpdb->get_package($pkg);
my $usertree = $localtlpdb->setting("usertree");
if (!defined($tlp)) {
- tlwarn ("$pkg: package not present, cannot remove\n");
+ tlwarn ("TLPDB: package not present, cannot remove: $pkg\n");
} else {
my $currentarch = $self->platform();
if ($pkg eq "texlive.infra" || $pkg eq "texlive.infra.$currentarch") {
@@ -1799,8 +1805,8 @@ sub remove_package {
}
if ($#badfiles >= 0) {
# warn the user
- tlwarn("The following files should be removed due to the removal of $pkg,\n");
- tlwarn("but are part of another package, too.\n");
+ tlwarn("TLPDB: These files would have been removed due to removal of\n");
+ tlwarn("TLPDB: $pkg, but are part of another package:\n");
for my $f (@badfiles) {
tlwarn(" $f - $allfiles{$f}\n");
}
@@ -1968,7 +1974,7 @@ sub _get_value_pkg {
}
return;
}
- tlwarn("$pkg not found, cannot read option $key.\n");
+ tlwarn("TLPDB: $pkg not found, cannot read option $key.\n");
return;
}
@@ -2013,7 +2019,7 @@ sub setting_pkg {
if (defined $ret) {
@ret = split(" ", $ret);
} else {
- tlwarn "TLPDB::setting_pkg: no $key, returning empty list ...\n";
+ tlwarn "TLPDB::setting_pkg: no $key, returning empty list\n";
@ret = ();
}
return @ret;
@@ -2042,7 +2048,7 @@ sub setting {
if (defined $ret) {
@ret = split(" ", $ret);
} else {
- tlwarn "TLPDB::setting: no $key, returning empty list ...\n";
+ tlwarn("TLPDB::setting: no $key, returning empty list\n");
@ret = ();
}
return @ret;
@@ -2091,7 +2097,7 @@ sub _keyshash {
if (member($1, @allowed)) {
$ret{$1} = $2;
} else {
- tlwarn("Unsupported option/setting $d\n");
+ tlwarn("TLPDB::_keyshash: Unsupported option/setting $d\n");
}
}
}
@@ -2262,7 +2268,7 @@ sub make_virtual {
my $self = shift;
if (!$self->is_virtual) {
if ($self->list_packages) {
- tlwarn("Cannot convert a initialized tlpdb to virtual for now!\n");
+ tlwarn("TLPDB: cannot convert initialized tlpdb to virtual\n");
return 0;
}
$self->{'virtual'} = 1;
@@ -2273,11 +2279,11 @@ sub make_virtual {
sub virtual_get_tlpdb {
my ($self, $tag) = @_;
if (!$self->is_virtual) {
- tlwarn("Cannot remove tlpdb from a non-virtual tlpdb!\n");
+ tlwarn("TLPDB: cannot remove tlpdb from a non-virtual tlpdb!\n");
return 0;
}
if (!defined($self->{'tlpdbs'}{$tag})) {
- tlwarn("TLPDB virtual_get_tlpdb: unknown tag $tag\n");
+ tlwarn("TLPDB::virtual_get_tlpdb: unknown tag: $tag\n");
return 0;
}
return $self->{'tlpdbs'}{$tag};
@@ -2286,7 +2292,7 @@ sub virtual_get_tlpdb {
sub virtual_add_tlpdb {
my ($self, $tlpdb, $tag) = @_;
if (!$self->is_virtual) {
- tlwarn("Cannot add tlpdb to a non-virtual tlpdb!\n");
+ tlwarn("TLPDB: cannot virtual_add_tlpdb to a non-virtual tlpdb!\n");
return 0;
}
$self->{'tlpdbs'}{$tag} = $tlpdb;
@@ -2302,11 +2308,11 @@ sub virtual_add_tlpdb {
sub virtual_remove_tlpdb {
my ($self, $tag) = @_;
if (!$self->is_virtual) {
- tlwarn("Cannot remove tlpdb from a non-virtual tlpdb!\n");
+ tlwarn("TLPDB: Cannot remove tlpdb from a non-virtual tlpdb!\n");
return 0;
}
if (!defined($self->{'tlpdbs'}{$tag})) {
- tlwarn("TLPDB virtual_remove_tlpdb: unknown tag $tag\n");
+ tlwarn("TLPDB: virtual_remove_tlpdb: unknown tag $tag\n");
return 0;
}
for my $p ($self->{'tlpdbs'}{$tag}->list_packages) {
@@ -2322,7 +2328,7 @@ sub virtual_get_package {
if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
} else {
- tlwarn("pkg $pkg not found in tag $tag\n");
+ tlwarn("TLPDB: virtual pkg $pkg not found in tag $tag\n");
return;
}
}
@@ -2427,7 +2433,7 @@ sub virtual_pindata {
sub virtual_update_pins {
my $self = shift;
if (!$self->is_virtual) {
- tlwarn("Not-virtual databases cannot have pinning data.\n");
+ tlwarn("TLPDB::virtual_update_pins: Non-virtual tlpdb can't have pins.\n");
return 0;
}
my $pincf = $self->{'pinfile'};
@@ -2437,7 +2443,7 @@ sub virtual_update_pins {
# we recompose the values into lines again, as we *might* have
# options later, i.e., lines of the format
# repo:pkg:opt
- push @pins, $self->make_pin_data_from_line("$k:$v");
+ push (@pins, $self->make_pin_data_from_line("$k:$v"));
}
}
$self->{'pindata'} = \@pins;
@@ -2447,7 +2453,7 @@ sub virtual_update_pins {
sub virtual_pinning {
my ($self, $pincf) = @_;
if (!$self->is_virtual) {
- tlwarn("Not-virtual databases cannot have pinning data.\n");
+ tlwarn("TLPDB::virtual_pinning: Non-virtual tlpdb can't have pins.\n");
return 0;
}
if (!defined($pincf)) {
@@ -2534,8 +2540,8 @@ sub check_evaluate_pinning {
# check that all pinning lines where hit
for my $p (@pins) {
next if defined($p->{'hit'});
- tlwarn("tlmgr: pinning warning: the package pattern ", $p->{'glob'},
- " on the line:\n ", $p->{'line'},
+ tlwarn("tlmgr (TLPDB): pinning warning: the package pattern ",
+ $p->{'glob'}, " on the line:\n ", $p->{'line'},
"\n does not match any package\n");
}
}