summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm73
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm168
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm350
3 files changed, 354 insertions, 237 deletions
diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index eca234e5c96..536cbc33a50 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -32,6 +32,11 @@ BEGIN {
$WindowsMainMenuName
$RelocPrefix
$RelocTree
+ %TLPDBSettingType
+ %TLPDBSettingDesc
+ %TLPDBOptionType
+ %TLPDBOptionDesc
+ %TLPDBOptionTlmgrName
);
@EXPORT = @EXPORT_OK;
}
@@ -98,8 +103,76 @@ our @AllowedConfigOptions = qw/
autobackup
/;
+#
+# definition of the option strings and their value types
+# possible types are:
+# - u: url
+# - b: boolean, saved as 0/1
+# - p: path (local path)
+# - n: naturnal number
+# it allows n:[a]..[b]
+# if a is empty start at -infty
+# if b is empty end at +infty
+# so "n:.." is equivalent to "n"
+
+# WARNING: keep these in sync!
+#
+our %TLPDBOptionTlmgrName = (
+ "location" => "location",
+ "create_formats" => "formats",
+ "desktop_integration" => "deskint",
+ "file_assocs" => "fileassocs",
+ "post_code" => "postcode",
+ "sys_bin" => "sys_bin",
+ "sys_info" => "sys_info",
+ "sys_man" => "sys_man",
+ "install_docfiles" => "docfiles",
+ "install_srcfiles" => "srcfiles",
+ "w32_multi_user" => "multiuser",
+ "autobackup" => "autobackup",
+ "backupdir" => "backupdir");
+our %TLPDBOptionType = (
+ "location" => "u",
+ "create_formats" => "b",
+ "desktop_integration" => "b",
+ "file_assocs" => "b",
+ "post_code" => "b",
+ "sys_bin" => "p",
+ "sys_info" => "p",
+ "sys_man" => "p",
+ "install_docfiles" => "b",
+ "install_srcfiles" => "b",
+ "w32_multi_user" => "b",
+ "autobackup" => "n:-1..",
+ "backupdir" => "p");
+our %TLPDBOptionDesc = (
+ "location" => "Default installation location",
+ "create_formats" => "Create formats on installation",
+ "desktop_integration" => "Create shortcuts (menu and desktop) in postinst",
+ "file_assocs" => "Change file associations in postinst",
+ "post_code" => "Run postinst code blobs",
+ "sys_bin" => "Destination for symlinks for binaries",
+ "sys_info" => "Destination for symlinks for info docs",
+ "sys_man" => "Destination for symlinks for man pages",
+ "install_docfiles" => "Install documentation files",
+ "install_srcfiles" => "Install source files",
+ "w32_multi_user" => "Install for shortcuts/menu items for all users (w32)",
+ "autobackup" => "Number of backups to keep",
+ "backupdir" => "Directory for backups");
+
+our %TLPDBSettingType = (
+ "platform" => "s",
+ "available_architectures" => "l"
+);
+our %TLPDBSettingDesc = (
+ "platform" => "Main platform for this computer",
+ "available_architectures" => "All available/installed architectures"
+);
+
+
our $WindowsMainMenuName = "TeX Live $ReleaseYear";
+
1;
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 90af2763348..6980f813959 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -11,6 +11,7 @@ use TeXLive::TLConfig;
use TeXLive::TLUtils qw(copy win32 dirname mkdirhier basename download_file
merge_into debug ddebug info tlwarn log);
use TeXLive::TLPDB;
+use TeXLive::TLWinGoo;
sub new
{
@@ -137,8 +138,8 @@ sub install_package {
my $container_src_split = $fromtlpdb->config_src_container;
my $container_doc_split = $fromtlpdb->config_doc_container;
# get options about src/doc splitting from $totlpdb
- my $opt_src = $totlpdb->option_install_srcfiles;
- my $opt_doc = $totlpdb->option_install_docfiles;
+ my $opt_src = $totlpdb->option("install_srcfiles");
+ my $opt_doc = $totlpdb->option("install_docfiles");
my $real_opt_doc = $opt_doc;
if ($tlpobj->category =~ m/documentation/i) {
# we do install documenation files for category Documentation
@@ -258,10 +259,15 @@ sub install_package {
# do the postinstallation actions
#
# Run the post installation code in the postaction tlpsrc entries
+ # in case we are on w32 and the admin did install for himself only
+ # we switch off admin mode
+ if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
+ non_admin();
+ }
&TeXLive::TLUtils::do_postaction("install", $tlpobj,
- $totlpdb->option_file_assocs,
- $totlpdb->option_desktop_integration,
- $totlpdb->option_post_code);
+ $totlpdb->option("file_assocs"),
+ $totlpdb->option("desktop_integration"),
+ $totlpdb->option("post_code"));
}
}
return 1;
@@ -454,7 +460,7 @@ sub remove_package {
&TeXLive::TLUtils::do_postaction("remove", $tlp,
0, # option_file_assocs,
0, # option_desktop_integration,
- $localtlpdb->option_post_code);
+ $localtlpdb->option("post_code"));
}
#
my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
@@ -474,17 +480,147 @@ sub remove_package {
$localtlpdb->save;
#
# Run the post installation code in the postaction tlpsrc entries
+ # in case we are on w32 and the admin did install for himself only
+ # we switch off admin mode
+ if (win32() && admin() && !$localtlpdb->option("w32_multi_user")) {
+ non_admin();
+ }
+ #
+ # Run the post installation code in the postaction tlpsrc entries
# the postaction code part cannot be evaluated now since the
# files are already removed.
if (!$nopostinstall) {
&TeXLive::TLUtils::do_postaction("remove", $tlp,
- $localtlpdb->option_file_assocs,
- $localtlpdb->option_desktop_integration,
+ $localtlpdb->option("file_assocs"),
+ $localtlpdb->option("desktop_integration"),
0);
}
}
return 1;
}
+
+
+=pod
+
+=item C<< $tlmedia->add_symlinks() >>
+=item C<< $tlmedia->remove_symlinks() >>
+
+These two functions try to create/remove symlinks for binaries, man pages,
+and info files as specified by the options saved in the respective tlpdb
+($tlpdb->option("sys_bin"), $tlpdb->option("sys_man"),
+$tlpdb->option("sys_info")).
+
+The functions return 1 on success and 0 on error.
+On Windows it returns undefined.
+
+=cut
+
+sub add_link_dir_dir {
+ my ($from, $to) = @_;
+ mkdirhier $to;
+ if (-w $to) {
+ debug("linking files from $from to $to\n");
+ chomp (@files = `ls "$from"`);
+ my $ret = 1;
+ for my $f (@files) {
+ unlink("$to/$f");
+ if (system("ln -s \"$from/$f\" \"$to\"")) {
+ tlwarn("Linking $f from $from to $to failed: $!\n");
+ $ret = 0;
+ }
+ }
+ return $ret;
+ } else {
+ tlwarn("destination $to not writable, no linking files in $from done.\n");
+ return 0;
+ }
+}
+
+sub remove_link_dir_dir {
+ my ($from, $to) = @_;
+ if ((-d "$to") && (-w "$to")) {
+ debug("removing links from $from to $to\n");
+ chomp (@files = `ls "$from"`);
+ my $ret = 1;
+ foreach my $f (@files) {
+ next if (! -r "$to/$f");
+ if ((-l "$to/$f") &&
+ (readlink("$to/$f") =~ m;^$from/;)) {
+ $ret = 0 unless unlink("$to/$f");
+ } else {
+ $ret = 0;
+ tlwarn ("not removing $to/$f, not a link or wrong destination!\n");
+ }
+ }
+ # trry to remove the destination directory, it might be empty and
+ # we might have write permissions, ignore errors
+ `rmdir "$to" 2>/dev/null`;
+ return $ret;
+ } else {
+ tlwarn ("destination $to not writable, no removal of links done!\n");
+ return 0;
+ }
+}
+
+sub add_remove_symlinks {
+ my $self = shift;
+ my $mode = shift;
+ my $errors = 0;
+ my $Master = $self->location;
+ my $arch = $self->platform();
+ my $plat_bindir = "$Master/bin/$arch";
+ return if win32();
+ $sys_bin = $self->tlpdb->option("sys_bin");
+ $sys_man = $self->tlpdb->option("sys_man");
+ $sys_info= $self->tlpdb->option("sys_info");
+ if ($mode eq "add") {
+ $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
+ if (-d "$Master/texmf/doc/info") {
+ $errors++ unless add_link_dir_dir("$Master/texmf/doc/info", $sys_info);
+ }
+ } elsif ($mode eq "remove") {
+ $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin);
+ if (-d "$Master/texmf/doc/info") {
+ $errors++ unless remove_link_dir_dir("$Master/texmf/doc/info", $sys_info);
+ }
+ } else {
+ die ("should not happen, unknown mode $mode in add_remove_symlinks!");
+ }
+ mkdirhier $sys_man if ($mode eq "add");
+ if (-w $sys_man && -d "$Master/texmf/doc/man") {
+ debug("$mode symlinks for man pages in $sys_man\n");
+ my $foo = `(cd "$Master/texmf/doc/man" && echo *)`;
+ chomp (my @mans = split (' ', $foo));
+ foreach my $m (@mans) {
+ my $mandir = "$Master/texmf/doc/man/$m";
+ next unless -d $mandir;
+ if ($mode eq "add") {
+ $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
+ } else {
+ $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
+ }
+ }
+ `rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
+ } else {
+ tlwarn("destination of man symlink $sys_man not writable, "
+ . "cannot $mode symlinks.\n");
+ $errors++;
+ }
+ # we collected errors in $ret, so return the negation of it
+ if ($errors) {
+ info("$mode of symlinks failed $errors times, please see above messages.\n");
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+sub add_symlinks {
+ return (shift->add_remove_symlinks("add", @_));
+}
+sub remove_symlinks {
+ return (shift->add_remove_symlinks("remove", @_));
+}
# member access functions
@@ -500,6 +636,22 @@ sub lang_doc_collections { my $self = shift; return @{ $self->{'lang_doc_collect
sub schemes { my $self = shift; return @{ $self->{'schemes'} }; }
sub systems { my $self = shift; return @{ $self->{'systems'} }; }
+# deduce the platform of the referenced media as follows:
+# - if the $tlpdb->setting("platform") is there it overrides the detected
+# setting
+# - if it is not there call TLUtils::platform()
+sub platform {
+ # try to deduce the platform
+ my $self = shift;
+ my $tlpdb = $self->tlpdb;
+ if (defined($tlpdb)) {
+ my $ret = $tlpdb->setting("platform");
+ return $ret if defined $ret;
+ }
+ # the platform setting wasn't found in the tlpdb, try TLUtils::platform
+ return TeXLive::TLUtils::platform();
+}
+
1;
__END__
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index b826db38e73..5c65d57f726 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -49,9 +49,10 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
$tlpdb->config_container_format;
$tlpdb->config_release;
$tlpdb->config_revision;
+ $tlpdb->options;
$tlpdb->option($key, [$value]);
- $tlpdb->add_symlinks();
- $tlpdb->remove_symlinks();
+ $tlpdb->settings;
+ $tlpdb->setting($key, [$value]);
$tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
TeXLive::TLPDB->listdir([$dir]);
@@ -62,7 +63,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
=cut
use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
- $DatabaseName $MetaCategoriesRegexp $Archive);
+ $DatabaseName $MetaCategoriesRegexp $Archive
+ %TLPDBOptionType %TLPDBSettingType);
use TeXLive::TLUtils qw(dirname mkdirhier member win32 info debug ddebug
tlwarn);
use TeXLive::TLPOBJ;
@@ -328,13 +330,13 @@ sub save {
The C<available_architectures> functions returns the list of available
architectures as set in the options section
-(i.e., using option_available_architectures)
+(i.e., using setting("available_architectures"))
=cut
sub available_architectures {
my $self = shift;
- my @archs = $self->option_available_architectures;
+ my @archs = $self->setting("available_architectures");
if (! @archs) {
# fall back to the old method checking tex\.*
my @packs = $self->list_packages;
@@ -918,123 +920,6 @@ sub config_revision {
=pod
-=item C<< $tlpdb->add_symlinks() >>
-=item C<< $tlpdb->remove_symlinks() >>
-
-These two functions try to create/remove symlinks for binaries, man pages,
-and info files as specified by the options saved in the tlpdb
-($tlpdb->option_sys_bin, $tlpdb->option_sys_man, $tlpdb->option_sys_info).
-
-The functions return 1 on success and 0 on error.
-On Windows it returns undefined.
-
-=cut
-
-sub add_link_dir_dir {
- my ($from, $to) = @_;
- mkdirhier $to;
- if (-w $to) {
- debug("linking files from $from to $to\n");
- chomp (@files = `ls "$from"`);
- my $ret = 1;
- for my $f (@files) {
- unlink("$to/$f");
- if (system("ln -s \"$from/$f\" \"$to\"")) {
- tlwarn("Linking $f from $from to $to failed: $!\n");
- $ret = 0;
- }
- }
- return $ret;
- } else {
- tlwarn("destination $to not writable, no linking files in $from done.\n");
- return 0;
- }
-}
-
-sub remove_link_dir_dir {
- my ($from, $to) = @_;
- if ((-d "$to") && (-w "$to")) {
- debug("removing links from $from to $to\n");
- chomp (@files = `ls "$from"`);
- my $ret = 1;
- foreach my $f (@files) {
- next if (! -r "$to/$f");
- if ((-l "$to/$f") &&
- (readlink("$to/$f") =~ m;^$from/;)) {
- $ret = 0 unless unlink("$to/$f");
- } else {
- $ret = 0;
- tlwarn ("not removing $to/$f, not a link or wrong destination!\n");
- }
- }
- # trry to remove the destination directory, it might be empty and
- # we might have write permissions, ignore errors
- `rmdir "$to" 2>/dev/null`;
- return $ret;
- } else {
- tlwarn ("destination $to not writable, no removal of links done!\n");
- return 0;
- }
-}
-
-sub add_remove_symlinks {
- my $self = shift;
- my $mode = shift;
- my $errors = 0;
- my $Master = $self->{'root'};
- my $arch = $self->option_platform;
- my $plat_bindir = "$Master/bin/$arch";
- return if win32();
- $sys_bin = $self->option_sys_bin;
- $sys_man = $self->option_sys_man;
- $sys_info= $self->option_sys_info;
- if ($mode eq "add") {
- $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
- $errors++ unless add_link_dir_dir("$Master/texmf/doc/info", $sys_info);
- } elsif ($mode eq "remove") {
- $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin);
- $errors++ unless remove_link_dir_dir("$Master/texmf/doc/info", $sys_info);
- } else {
- die ("should not happen, unknown mode $mode in add_remove_symlinks!");
- }
- mkdirhier $sys_man if ($mode eq "add");
- if (-w $sys_man) {
- debug("$mode symlinks for man pages in $sys_man\n");
- my $foo = `(cd "$Master/texmf/doc/man" && echo *)`;
- chomp (my @mans = split (' ', $foo));
- foreach my $m (@mans) {
- my $mandir = "$Master/texmf/doc/man/$m";
- next unless -d $mandir;
- if ($mode eq "add") {
- $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
- } else {
- $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
- }
- }
- `rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
- } else {
- tlwarn("destination of man symlink $sys_man not writable, "
- . "cannot $mode symlinks.\n");
- $errors++;
- }
- # we collected errors in $ret, so return the negation of it
- if ($errors) {
- info("$mode of symlinks failed $errors times, please see above messages.\n");
- return 0;
- } else {
- return 1;
- }
-}
-
-sub add_symlinks {
- return (shift->add_remove_symlinks("add", @_));
-}
-sub remove_symlinks {
- return (shift->add_remove_symlinks("remove", @_));
-}
-
-=pod
-
=item C<< $tlpdb->sizes_of_packages ( $opt_src, $opt_doc, [ @packs ] ) >>
This function returns a reference to a hash with package names as keys
@@ -1103,8 +988,8 @@ sub sizes_of_packages {
=pod
-=item C<< $tlpdb->option_XXXXX >ize += $tlpsizes{$p};
-
+=item C<< $tlpdb->option($key [, $val]) >>
+=item C<< $tlpdb->setting($key [, $val]) >>
Need to be documented
@@ -1112,29 +997,34 @@ Need to be documented
sub _set_option_value {
my $self = shift;
- $self->_set_option_value_pkg('00texlive.installation', @_);
+ $self->_set_value_pkg('00texlive.installation', 'opt_', @_);
+}
+sub _set_setting_value {
+ my $self = shift;
+ $self->_set_value_pkg('00texlive.installation', 'setting_', @_);
}
-sub _set_option_value_pkg {
- my ($self,$pkgname,$key,$value) = @_;
+sub _set_value_pkg {
+ my ($self,$pkgname,$pre,$key,$value) = @_;
+ my $k = "$pre$key";
my $pkg = $self->{'tlps'}{$pkgname};
my @newdeps;
if (!defined($pkg)) {
$pkg = new TeXLive::TLPOBJ;
$pkg->name($pkgname);
$pkg->category("TLCore");
- push @newdeps, "$key:$value";
+ push @newdeps, "$k:$value";
} else {
my $found = 0;
foreach my $d ($pkg->depends) {
- if ($d =~ m!^$key:!) {
+ if ($d =~ m!^$k:!) {
$found = 1;
- push @newdeps, "$key:$value";
+ push @newdeps, "$k:$value";
} else {
push @newdeps, $d;
}
}
if (!$found) {
- push @newdeps, "$key:$value";
+ push @newdeps, "$k:$value";
}
}
$pkg->depends(@newdeps);
@@ -1143,14 +1033,20 @@ sub _set_option_value_pkg {
sub _option_value {
my $self = shift;
- $self->_option_value_pkg('00texlive.installation', @_);
+ $self->_value_pkg('00texlive.installation', 'opt_', @_);
}
-sub _option_value_pkg {
- my ($self,$pkg,$key) = @_;
+sub _setting_value {
+ my $self = shift;
+ $self->_value_pkg('00texlive.installation', 'setting_', @_);
+}
+
+sub _value_pkg {
+ my ($self,$pkg,$pre,$key) = @_;
+ my $k = "$pre$key";
if (defined($self->{'tlps'}{$pkg})) {
foreach my $d ($self->{'tlps'}{$pkg}->depends) {
- if ($d =~ m!^$key:(.*)$!) {
+ if ($d =~ m!^$k:(.*)$!) {
return "$1";
}
}
@@ -1160,117 +1056,113 @@ sub _option_value_pkg {
return;
}
-sub option {
- my $self = shift;
- my $key = shift;
- if (@_) { $self->_set_option_value($key, shift); }
- return $self->_option_value($key);
-}
-
sub option_pkg {
my $self = shift;
my $pkg = shift;
my $key = shift;
- if (@_) { $self->_set_option_value_pkg($pkg, $key, shift); }
- return $self->_option_value_pkg($pkg, $key);
-}
-
-# TODO the above function should be used in the functions below as
-# far as possible ...
-
-sub option_available_architectures {
- my $self = shift;
- if (@_) { $self->_set_option_value("available_architectures","@_"); }
-
- # sadly, if the tlpdb is messed up, there may be no architectures.
- my $val = $self->_option_value("available_architectures");
- my @archs;
- if (defined $val) {
- @archs = split(" ", $val);
- } else {
- warn "no available_architectures, continuing anyway ...";
- @archs = ();
+ if (@_) { $self->_set_value_pkg($pkg, "opt_", $key, shift); }
+ my $ret = $self->_value_pkg($pkg, "opt_", $key);
+ # special case for location == __MASTER__
+ if ($ret eq "__MASTER__" && $key eq "location") {
+ return $self->root;
}
- return @archs;
-}
-sub option_create_symlinks {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_create_symlinks", shift); }
- return $self->_option_value("opt_create_symlinks");
-}
-sub option_desktop_integration {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_desktop_integration", shift); }
- return $self->_option_value("opt_desktop_integration");
-}
-sub option_file_assocs {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_file_assocs", shift); }
- return $self->_option_value("opt_file_assocs");
-}
-sub option_post_code {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_post_code", shift); }
- return $self->_option_value("opt_post_code");
-}
-sub option_path {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_path", shift); }
- return $self->_option_value("opt_path");
-}
-sub option_w32_multi_user {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_w32_multi_user", shift); }
- return $self->_option_value("opt_w32_multi_user");
-}
-sub option_install_docfiles {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_install_docfiles", shift); }
- return $self->_option_value("opt_install_docfiles");
+ return $ret;
}
-sub option_install_srcfiles {
+sub option {
my $self = shift;
- if (@_) { $self->_set_option_value("opt_install_srcfiles", shift); }
- return $self->_option_value("opt_install_srcfiles");
-}
-sub option_create_formats {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_create_formats", shift); }
- return $self->_option_value("opt_create_formats");
-}
-sub option_paper {
- my $self = shift;
- if (@_) { $self->_set_option_value("opt_paper", shift); }
- return $self->_option_value("opt_paper");
-}
-sub option_location {
- my $self = shift;
- if (@_) { $self->_set_option_value("location", shift); }
- my $loc = $self->_option_value("location");
- if ($loc eq "__MASTER__") {
+ my $key = shift;
+ if (@_) { $self->_set_option_value($key, shift); }
+ my $ret = $self->_option_value($key);
+ # special case for location == __MASTER__
+ if (defined($ret) && $ret eq "__MASTER__" && $key eq "location") {
return $self->root;
}
- return $self->_option_value("location");
+ return $ret;
}
-sub option_sys_bin {
+sub setting_pkg {
my $self = shift;
- if (@_) { $self->_set_option_value("opt_sys_bin", shift); }
- return $self->_option_value("opt_sys_bin");
+ my $pkg = shift;
+ my $key = shift;
+ if (@_) {
+ if ($TLPDBSettingType{$key} eq "l") {
+ $self->_set_value_pkg($pkg, "setting_", $key, "@_");
+ } else {
+ $self->_set_value_pkg($pkg, "setting_", $key, shift);
+ }
+ }
+ my $ret = $self->_value_pkg($pkg, "setting_", $key);
+ # check the types of the settings, and if it is a "l" return a list
+ if ($TLPDBSettingType{$key} eq "l") {
+ my @ret;
+ if (defined $ret) {
+ @ret = split(" ", $ret);
+ } else {
+ tlwarn "TLPDB::setting: no $key, returning empty list ...\n";
+ @ret = ();
+ }
+ return @ret;
+ }
+ return $ret;
}
-sub option_sys_man {
+sub setting {
my $self = shift;
- if (@_) { $self->_set_option_value("opt_sys_man", shift); }
- return $self->_option_value("opt_sys_man");
+ my $key = shift;
+ if (@_) {
+ if ($TLPDBSettingType{$key} eq "l") {
+ $self->_set_setting_value($key, "@_");
+ } else {
+ $self->_set_setting_value($key, shift);
+ }
+ }
+ my $ret = $self->_setting_value($key);
+ # check the types of the settings, and if it is a "l" return a list
+ if ($TLPDBSettingType{$key} eq "l") {
+ my @ret;
+ if (defined $ret) {
+ @ret = split(" ", $ret);
+ } else {
+ tlwarn "TLPDB::setting: no $key, returning empty list ...\n";
+ @ret = ();
+ }
+ return @ret;
+ }
+ return $ret;
+}
+
+=pod
+
+=item C<< $tlpdb->options >>
+
+Returns a reference to a hash with option names.
+
+=cut
+
+sub _keyshash {
+ my ($self, $pre, $hr) = @_;
+ my @allowed = keys %$hr;
+ my %ret;
+ my $pkg = $self->{'tlps'}{'00texlive.installation'};
+ if (defined($pkg)) {
+ foreach my $d ($pkg->depends) {
+ if ($d =~ m!^$pre([^:]*):(.*)!) {
+ if (member($1, @allowed)) {
+ $ret{$1} = $2;
+ } else {
+ tlwarn("Unsupported option/setting $d\n");
+ }
+ }
+ }
+ }
+ return \%ret;
}
-sub option_sys_info {
+
+sub options {
my $self = shift;
- if (@_) { $self->_set_option_value("opt_sys_info", shift); }
- return $self->_option_value("opt_sys_info");
+ return ($self->_keyshash('opt_', \%TLPDBOptionType));
}
-sub option_platform {
+sub settings {
my $self = shift;
- if (@_) { $self->_set_option_value("platform", shift); }
- return $self->_option_value("platform");
+ return ($self->_keyshash('setting_', \%TLPDBSettingType));
}
=pod