diff options
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r-- | Master/tlpkg/TeXLive/TLMedia.pm | 20 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 32 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 17 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPSRC.pm | 4 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLTREE.pm | 12 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 121 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 26 |
7 files changed, 111 insertions, 121 deletions
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm index f1eb9062e45..4b83b2db674 100644 --- a/Master/tlpkg/TeXLive/TLMedia.pm +++ b/Master/tlpkg/TeXLive/TLMedia.pm @@ -10,7 +10,7 @@ package TeXLive::TLMedia; use TeXLive::TLConfig; use TeXLive::TLPostActions; -use TeXLive::TLUtils qw(tllog copy win32 dirname mkdirhier conv_to_win_path basename download_file merge_into); +use TeXLive::TLUtils qw(copy win32 dirname mkdirhier conv_to_win_path basename download_file merge_into); use TeXLive::TLPDB; use Cwd qw/abs_path/; @@ -38,7 +38,7 @@ sub new return; } } - tllog($::LOG_DEBUG, "Loading $location/$InfraLocation/$DatabaseName ...\n"); + debug("Loading $location/$InfraLocation/$DatabaseName ...\n"); my $tlpdb = TeXLive::TLPDB->new(root => "$location"); my (@all_c, @std_c, @lang_c, @lang_doc_c); my (@schemes); @@ -90,14 +90,14 @@ sub install_package { if (!defined($tlpobj)) { if (defined($fallbackmedia)) { if ($ret = $fallbackmedia->install_package($pkg,$totlpdb)) { - tllog($::LOG_DEBUG, "installed $pkg from fallback"); + debug("installed $pkg from fallback"); return $ret; } else { - tllog($::LOG_NORMAL, "couldn't find $pkg"); + tlwarn("couldn't find $pkg"); return 0; } } else { - tllog($::LOG_NORMAL, "couldn't find $pkg"); + tlwarn("couldn't find $pkg"); return 0; } } else { @@ -112,7 +112,7 @@ sub install_package { # even if opt_doc is false $real_opt_doc = 1; } - tllog($::LOG_NORMAL, "install: $pkg\n"); + info("install: $pkg\n"); foreach my $h (@::install_packages_hook) { &$h("install: $package"); } @@ -149,7 +149,7 @@ sub install_package { $container = "$location/$DiskArchive/$pkg.tar.lzma"; } else { # for now only warn and return, should (?) be die!? - warn "Cannot find a package $pkg (.zip or .lzma) in $location/$DiskArchive\n"; + tlwarn "Cannot find a package $pkg (.zip or .lzma) in $location/$DiskArchive\n"; next; } } elsif (&media eq 'NET') { @@ -229,7 +229,7 @@ sub install_package { if (!$nopostinstall) { # do the postinstallation actions if (defined($PostInstall{$pkg})) { - tllog($::LOG_NORMAL, "running post install action for $pkg\n"); + info("running post install action for $pkg\n"); &{$PostInstall{$pkg}}($totlpdb->root); } } @@ -295,12 +295,12 @@ sub _install_package { # copy it to temp copy($what, "$target/temp"); } - tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n"); + debug("Un-lzmaing $lzmafile to $tarfile\n"); system("$lzmadec < $lzmafile_quote > $tarfile_quote"); if (! -f $tarfile) { die "Unpacking $lzmafile did not succeed, please retry!"; } - tllog($::LOG_DEBUG, "Unpacking $tarfile\n"); + debug("Unpacking $tarfile\n"); system($tar,"-x","-C",$target,"-f",$tarfile); unlink($tarfile, $lzmafile); } else { diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index ab34e246858..690f8d24463 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -54,7 +54,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation $DatabaseName $MetaCategoriesRegexp); -use TeXLive::TLUtils qw(dirname mkdirhier tllog member win32); +use TeXLive::TLUtils qw(dirname mkdirhier member win32 info debug ddebug); use TeXLive::TLPOBJ; my $_listdir; @@ -152,7 +152,7 @@ sub remove_package { if (defined($self->{'tlps'}{$pkg})) { delete $self->{'tlps'}{$pkg}; } else { - warn "Cannot find package $pkg for removal in tlpdb!"; + tlwarn("Cannot find package $pkg for removal in tlpdb!"); } } @@ -183,7 +183,7 @@ sub from_file { } my $retfh; if ($path =~ /^(http|ftp):\/\//) { - tllog($::LOG_DDDEBUG, "TLPDB.pm: trying to initialize from $path\n"); + debug("TLPDB.pm: trying to initialize from $path\n"); # if we have lzmadec available we try the lzma file if (defined($::progs{'lzmadec'})) { # we first try the lzma compressed file @@ -199,23 +199,23 @@ sub from_file { } $lzmafile_quote = "\"$lzmafile\""; $tlpdbfile_quite = "\"$tlpdbfile\""; - tllog($::LOG_DEBUG, "trying to download $path.lzma to $lzmafile\n"); + debug("trying to download $path.lzma to $lzmafile\n"); my $ret = TeXLive::TLUtils::download_file("$path.lzma", "$lzmafile"); # better to check both, the return value AND the existence of the file if ($ret && (-r "$lzmafile")) { # ok, let the fun begin - tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tlpdbfile\n"); + debug("Un-lzmaing $lzmafile to $tlpdbfile\n"); system("$::progs{'lzmadec'} < $lzmafile_quote > $tlpdbfile_quote"); if (! -r $tlpdbfile) { - tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile did not succeed, try normally\n"); + debug("Un-lzmaing $lzmafile did not succeed, try normally\n"); } else { unlink($lzmafile); open $retfh, "<$tlpdbfile" or die"Cannot open $tlpdbfile!"; - tllog($::LOG_DEBUG, "Ok, found the uncompressed lzma file!\n"); + debug("Ok, found the uncompressed lzma file!\n"); } } } else { - tllog($::LOG_DEBUG, "no lzmadec defined, not trying tlpdb.lzma ...\n"); + debug("no lzmadec defined, not trying tlpdb.lzma ...\n"); } if (!defined($retfh)) { # lzma did not succeed, so try the normal file @@ -231,7 +231,7 @@ sub from_file { my $found = 0; do { my $tlp = TeXLive::TLPOBJ->new; - tllog($::LOG_DDDEBUG, "creating tlp from $path...\n"); + ddebug("creating tlp from $path...\n"); $found = $tlp->from_fh($retfh,1); if ($found) { $self->add_tlpobj($tlp); @@ -254,8 +254,8 @@ sub writeout { my $self = shift; my $fd = (@_ ? $_[0] : STDOUT); foreach (sort keys %{$self->{'tlps'}}) { - tllog($::LOG_DDDEBUG, "tlpname = $_\n"); - tllog($::LOG_DDDEBUG, "foo: ", $self->{'tlps'}{$_}->name, "\n"); + ddebug("tlpname = $_\n"); + ddebug("foo: ", $self->{'tlps'}{$_}->name, "\n"); $self->{'tlps'}{$_}->writeout($fd); print $fd "\n"; } @@ -360,8 +360,8 @@ sub _add_tlpcontainer { } else { die "Cannot find a package $container (.zip or .lzma) in $ziplocation\n"; } - warn "Huuu, this needs testing and error checking!\n"; - warn "Should we use -a -- adapt line endings etc?\n"; + tlwarn("Huuu, 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" if ($arch eq "all") { @@ -546,7 +546,7 @@ sub _generate_listfile { } else { # speudo dependencies on $Package.ARCH can be ignored if ($d !~ m/\.ARCH$/) { - warn "Strange: $tlp->name depends on $d, but this package does not exists!\n"; + tlwarn("Strange: $tlp->name depends on $d, but this package does not exists!\n"); } } } @@ -565,7 +565,7 @@ sub _generate_listfile { foreach my $p (@lop) { my $subtlp = $self->get_package($p); if (!defined($subtlp)) { - warn "Strange: $listname references $p, but it is not in tlpdb"; + tlwarn("Strange: $listname references $p, but it is not in tlpdb"); } $s += $subtlp->total_size; } @@ -594,7 +594,7 @@ sub _generate_listfile { TeXLive::TLUtils::push_uniq(\@collpkg,$d); } } else { - warn "Strange: $coll->name depends on $d, but this does not exists!\n"; + tlwarn("Strange: $coll->name depends on $d, but this does not exists!\n"); } } } diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index f9fa7942b3c..83fbf80962d 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -7,7 +7,7 @@ package TeXLive::TLPOBJ; use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation); -use TeXLive::TLUtils qw/win32 tllog/; +use TeXLive::TLUtils; #use File::Path; use TeXLive::TLTREE; #use FileHandle; # format_name in writeout, no idea how to rewrite @@ -77,10 +77,7 @@ sub from_fh { chomp($line); # we call tllog only when something will be logged, to speed things up. # this is the inner loop bounding the time to read tlpdb. - if ($::LOGLEVELTERMINAL >= $::LOG_DDDEBUG || - $::LOGLEVELFILE >= $::LOG_DDDEBUG) { - tllog($::LOG_DDDEBUG, "reading line: >>>$line<<<\n"); - } + ddebug("reading line: >>>$line<<<\n"); $line =~ /^\s*#/ && next; # skip comment lines if ($line =~ /^\s*$/o) { if (!$started) { next; } @@ -537,11 +534,11 @@ sub make_container { my $tar = $::progs{'tar'}; my $lzma = $::progs{'lzma'}; if (!defined($tar)) { - tllog($::LOG_NORMAL, "Programs have not been set up, trying with \"tar\"!\n"); + tlwarn("Programs have not been set up, trying with \"tar\"!\n"); $tar = "tar"; } if (!defined($lzma)) { - tllog($::LOG_NORMAL, "Programs have not been set up, trying with \"lzma\"!\n"); + tlwarn("Programs have not been set up, trying with \"lzma\"!\n"); $lzma = "lzma"; } my @cmdline = ($tar, "-c", "-f", "$destdir/$tarname", "--files-from=-"); @@ -565,13 +562,13 @@ sub make_container { if (-r "$destdir/$tarname") { system($lzma, "--force", "-z", "$destdir/$tarname"); } else { - warn("Couldn't find $destdir/$tarname"); + tlwarn("Couldn't find $destdir/$tarname"); } # cleaning up unlink("$tlpobjdir/$self->{'name'}.tlpobj"); rmdir("$tlpobjdir") if $removetlpobjdir; chdir($cwd); - tllog($::LOG_DDDEBUG, "Done $containername\n"); + ddebug("Done $containername\n"); } @@ -816,7 +813,7 @@ sub make_return_hash_from_executes { } elsif ($e =~ m/^BuildLanguageDat\s+([^\s]+)\s*$/) { push @dats, $1; } else { - warn("Unknown execute $e in ", $self->name); + tlwarn("Unknown execute $e in ", $self->name); } } $ret{'map'} = [ @maps ] if (@maps); diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm index b0272bb68ea..6bbb37a1ad4 100644 --- a/Master/tlpkg/TeXLive/TLPSRC.pm +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -12,7 +12,7 @@ package TeXLive::TLPSRC; use FileHandle; use TeXLive::TLConfig qw($CategoriesRegexp); -use TeXLive::TLUtils qw(tllog); +use TeXLive::TLUtils; use TeXLive::TLPOBJ; use TeXLive::TLTREE; @@ -119,7 +119,7 @@ sub from_file push @depends, "$1" if ("$1" ne ""); next; } else { - tllog($::LOG_NORMAL,"$srcfile: unknown tlpsrc directive, please fix: $line\n"); + tlwarn("$srcfile: unknown tlpsrc directive, please fix: $line\n"); } } } diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm index 9e009616b54..e32b3a91e13 100644 --- a/Master/tlpkg/TeXLive/TLTREE.pm +++ b/Master/tlpkg/TeXLive/TLTREE.pm @@ -76,7 +76,7 @@ sub _initialize_lines { add_path_to_tree($self->{'_dirtree'}, split("[/\\\\]", $dn)); push @{$self->{'_filesofdir'}{$dn}}, $fn; } else { - warn("Ignoring svn status output line:\n $l\n"); + tlwarn("Ignoring svn status output line:\n $l\n"); #die("Cannot read svn status output line:\n $l\n"); } } @@ -220,7 +220,7 @@ sub _get_matching_files { } else { die "Unknown pattern $p"; } - tllog($::LOG_DDDEBUG, "p=$p; matchfiles=@matchfiles\n"); + ddebug("p=$p; matchfiles=@matchfiles\n"); return @matchfiles; } @@ -246,9 +246,9 @@ sub _get_files_matching_glob_pattern { return unless (defined($self->{'_filesofdir'}{$dirpart})); my @candfiles = @{$self->{'_filesofdir'}{$dirpart}}; foreach my $f (@candfiles) { - tllog($::LOG_DDDEBUG, "matching $f in $dirpart via glob $globline\n"); + ddebug("matching $f in $dirpart via glob $globline\n"); if ($f =~ /^$basepart$/) { - tllog($::LOG_DDDEBUG, "hit: globline=$globline, $dirpart/$f\n"); + ddebug("hit: globline=$globline, $dirpart/$f\n"); if ("$dirpart" eq ".") { push @returnfiles, "$f"; } else { @@ -259,9 +259,9 @@ sub _get_files_matching_glob_pattern { if ($dirpart =~ m@^bin/win32@) { # for arch=win32 under bin we also want to match .dll, .bat, .exe files foreach my $f (@candfiles) { - tllog($::LOG_DDDEBUG, "matching $f in $dirpart via glob $globline.{bat/exe/texlua}\n"); + ddebug("matching $f in $dirpart via glob $globline.{bat/exe/texlua}\n"); if ($f =~ /^$basepart\.(bat|exe|dll|texlua)$/) { - tllog($::LOG_DDDEBUG, "hit: globline=$globline, $dirpart/$f\n"); + ddebug("hit: globline=$globline, $dirpart/$f\n"); if ("$dirpart" eq ".") { push @returnfiles, "$f"; } else { diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 4a495ff6784..082591c89bf 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -59,7 +59,6 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::sort_uniq(@list); TeXLive::TLUtils::push_uniq(\@list, @items); TeXLive::TLUtils::member($item, @list); - TeXLive::TLUtils::tllog($level, $string); TeXLive::TLUtils::merge_into(\%to, \%from); TeXLive::TLUtils::texdir_check($texdir); TeXLive::TLUtils::kpsewhich; @@ -107,12 +106,14 @@ BEGIN { &setup_programs &download_file &merge_into + &process_logging_options ); - @EXPORT = qw(tllog setup_programs download_file); + @EXPORT = qw(setup_programs download_file info debug ddebug tlwarn process_logging_options win32); } use TeXLive::TLConfig; +use Getopt::Long; =pod @@ -522,7 +523,7 @@ sub install_packages { my $container_src_split = $fromtlpdb->config_src_container; my $container_doc_split = $fromtlpdb->config_doc_container; foreach my $package (@$what) { - tllog($::LOG_NORMAL, "Installing: $package\n"); + info("Installing: $package\n"); foreach my $h (@::install_packages_hook) { &$h("Installing: $package"); } @@ -552,7 +553,7 @@ sub install_packages { $container = "$::installerdir/$DiskArchive/$package.tar.lzma"; } else { # for now only warn and return, should (?) be die!? - warn "Cannot find a package $package (.zip or .lzma) in $::installerdir/$DiskArchive\n"; + tlwarn("Cannot find a package $package (.zip or .lzma) in $::installerdir/$DiskArchive\n"); next; } } elsif (&media eq 'NET') { @@ -678,12 +679,12 @@ sub install_package { # copy it to temp copy($what, "$target/temp"); } - tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n"); + debug("Un-lzmaing $lzmafile to $tarfile\n"); system("$lzmadec < $lzmafile_quote > $tarfile_quote"); if (! -f $tarfile) { die "Unpacking $lzmafile did not succeed, please retry!"; } - tllog($::LOG_DEBUG, "Unpacking $tarfile\n"); + debug("Unpacking $tarfile\n"); system($tar,"-x","-C",$target,"-f",$tarfile); unlink($tarfile, $lzmafile); } else { @@ -755,7 +756,7 @@ sub download_file { } elsif (defined($::progs{'wget'})) { $wget = $::progs{'wget'}; } else { - warn ("Programs have not been set up, trying simply wget"); + tlwarn ("Programs have not been set up, trying simply wget"); $wget = "wget"; } my $url; @@ -792,7 +793,7 @@ sub _download_file { my $wgetargs = $ENV{"TL_DOWNLOAD_ARGS"} || "-q -O"; - tllog($::LOG_DEBUG, "Trying to download $url\n"); + debug("Trying to download $url\n"); my $ret; if ($dest eq "|") { open(RETFH, "$wget $wgetargs - $url|") or @@ -808,7 +809,7 @@ sub _download_file { } # return false/undef in case the download did not succeed. return ($ret) unless $ret; - tllog($::LOG_DEBUG, "Download $url did succeed\n"); + debug("Download $url did succeed\n"); if ($dest eq "|") { return \*RETFH; } else { @@ -846,7 +847,7 @@ sub install_package_old { } } elsif (&media eq 'CD') { my $package="$::installerdir/$DiskArchive/$what[0]"; - open IN, "$package", or warn "Can't open '$package': $!\n" + open IN, "$package" or die "Can't open '$package': $!\n"; binmode IN; @@ -1183,71 +1184,63 @@ sub texdir_check { return 0; } -=pod - -=item C<tllog($type, $rest, ...)> - -Debugging output is controlled by 2 global variables: $::LOGLEVELTERMINAL -for the output to the terminal, and $::LOGLEVELFILE for the output to -the log file (whose filehandle should be saved in $::LOGFILE). - -If the first argument of C<tllog> is less or equal to the respective -threshold the message is issued to STDERR and log file, respectively. - -If $::LOGFILE is not defined logging to a log file is completely disabled. - -Predefined levels of debugging are: $::LOG_NORMAL, $::LOG_DEBUG, $::LOG_DDEBUG, -and $::LOG_DDDEBUG with increasing level of detailedness. -Note that all TeXLive modules to logging with $::LOG_DDDEBUG! -By default the threshold for logging to the log file is $::LOG_DEBUG, and -the one for the terminal $::LOG_NORMAL. - -If you want to disable logging set the respective thershold to $::LOG_ZERO. +sub logit { + my ($out, $level, @rest) = @_; + _logit($out, $level, @rest) unless $::opt_quiet; + _logit('file', $level, @rest); +} -=cut +sub _logit { + my ($out, $level, @rest) = @_; + if ($::opt_verbosity >= $level) { + # if $out is a ref/glob to STDOUT or STDERR, print it there + if (ref($out) eq "GLOB") { + print $out @rest; + } else { + # we should log it into the logfile, but that might be not initialized + # so either print it to the filehandle $::LOGFILE, or push it onto + # the to be printed log lines @::LOGLINES + if (defined($::LOGFILE)) { + print $::LOGFILE @rest; + } else { + push @::LOGLINES, "@rest"; + } + } + } +} -$::LOG_ZERO = -1; -$::LOG_NORMAL = 0; -$::LOG_DEBUG = 1; -$::LOG_DDEBUG = 2; -$::LOG_DDDEBUG = 3; -if (!defined($::LOGLEVELFILE)) { - $::LOGLEVELFILE = $::LOG_DEBUG; +sub info { + logit(\*STDOUT, 0, @_); } -if (!defined($::LOGLEVELTERMINAL)) { - $::LOGLEVELTERMINAL = $::LOG_NORMAL; + +sub debug { + logit(\*STDOUT, 1, @_); } -sub tllog { - my ($imp, @rest) = @_; - if (defined($::LOGFILE)) { - _tllog($::LOGLEVELFILE,$::LOGFILE,$imp,@rest); - } else { - _tllog($::LOGLEVELFILE,\@::LOGLINES,$imp,@rest); - } - my $out; - if ($imp == $::LOG_NORMAL) { - $out = \*STDOUT; - } else { - $out = \*STDERR; - } - _tllog($::LOGLEVELTERMINAL,$out,$imp,@rest); +sub ddebug { + logit(\*STDOUT, 2, @_); } -sub _tllog { - my ($threshold,$output,$imp, @rest) = @_; - if ($imp <= $threshold) { - if (ref($output) eq "GLOB") { - # we are writing to a file handle - print $output "@rest"; - } else { - push @{$output}, "@rest"; - } - } +sub tlwarn { + # warning should always done to stderr and the log file, + # independently from the verbosity level + my $savequiet = $::opt_quiet; + $::opt_quiet = 0; + logit(\*STDERR, -100, @_); + $::opt_quiet = $savequiet; } +sub process_logging_options { + $::opt_verbosity = 0; + $::opt_quiet = 0; + # check all the command line options for occurrences of -q and -v + # do not report errors + my $oldconfig = Getopt::Long::Configure(qw(pass_through)); + GetOptions("v+" => \$::opt_verbosity, "q" => \$::opt_quiet); + Getopt::Long::Configure($oldconfig); +} =pod diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index c4e07001c3b..513c5c0724e 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -261,7 +261,7 @@ sub reg_country { $value = substr $value, -4; my $lm = $Registry -> Open("HKEY_CLASSES_ROOT/MIME/Database/Rfc1766/", {Access => KEY_READ()})->{"/$value"}; - tllog($::LOG_DEBUG, "found lang codes value = $value, lm = $lm...\n"); + debug("found lang codes value = $value, lm = $lm...\n"); if ($lm) { return(substr $lm, 0, 2); } @@ -537,7 +537,7 @@ sub add_texbindir_to_path { $wg_error = 1; $wg_error_message = "Warning: possibly conflicting [pdf]TeX program found at $d_exp\n"; - tllog($::LOG_DEBUG, $wg_error_message); + debug($wg_error_message); } } } @@ -623,7 +623,7 @@ sub remove_texbindirs_from_path { sub reg_delete_recurse { my $parent = shift; my $childname = shift; - tllog ($::LOG_DDDEBUG, "Deleting $childname regkey\n"); + ddebug("Deleting $childname regkey\n"); if ($childname !~ '^/') { # subkey my $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()}); return unless $child; @@ -660,7 +660,7 @@ sub register_script_type { $extension = uc($extension); my $command = shift; $command =~s/\//\\/g; - tllog ($::LOG_DDEBUG, "Linking $extension to $command\n"); + debug("Linking $extension to $command\n"); my $user_env = get_user_env(); my $system_env = get_system_env(); my ($classes_key, $k); @@ -708,12 +708,12 @@ sub unregister_script_type { my $extension = shift; $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot $extension = uc($extension); - tllog ($::LOG_DDEBUG, "unregistering $extension\n"); + debug("unregistering $extension\n"); #my $user_env = get_user_env(); #my $system_env = get_system_env(); # file type - tllog ($::LOG_DDEBUG, "Deleting texlua filetype\n"); + debug("Deleting texlua filetype\n"); $extension = lc($extension); my $classes_key = $Registry -> Open("CUser/Software/Classes/", {Access => KEY_ALL_ACCESS()}); @@ -721,7 +721,7 @@ sub unregister_script_type { reg_delete_recurse ($classes_key, $extension."/"); reg_delete_recurse ($classes_key, "script".$extension."/"); } else { - tllog ($::LOG_DDEBUG, "Cannot open HKCU classes for write\n"); + debug("Cannot open HKCU classes for write\n"); } if ($is_admin) { $classes_key = $Registry -> Open("LMachine/Software/Classes/", @@ -730,7 +730,7 @@ sub unregister_script_type { reg_delete_recurse ($classes_key, $extension."/"); reg_delete_recurse ($classes_key, "script".$extension."/"); } else { - tllog ($::LOG_DDEBUG, "Cannot open HKLM classes for write\n"); + debug("Cannot open HKLM classes for write\n"); } reg_delete_recurse ($classes_key, "script$extension"); } @@ -758,11 +758,11 @@ sub broadcast_env() { my $result = ""; my $SendMessage; $wg_error = 0; - tllog($::LOG_DDEBUG, "Broadcasting \"Enviroment settings changed\" message...\n"); + debug("Broadcasting \"Enviroment settings changed\" message...\n"); $SendMessage = new Win32::API('user32', 'SendMessage', 'LLPP', 'L'); $result = $SendMessage->Call(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 'Environment') if $SendMessage; - tllog ($::LOG_DDEBUG, "Broadcast complete; result: $result.\n"); + debug("Broadcast complete; result: $result.\n"); } =pod @@ -778,11 +778,11 @@ sub update_assocs() { use constant SHCNF_IDLIST => 0; my $update_fu = new Win32::API('shell32', 'SHChangeNotify', 'LIPP', 'V'); if ($update_fu) { - tllog ($::LOG_DDEBUG, "Notifying changes in filetypes...\n"); + debug("Notifying changes in filetypes...\n"); $update_fu->Call (SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0); - tllog ($::LOG_DDEBUG, "Done notifying\n"); + debug("Done notifying\n"); } else { - tllog ($::LOG_DDEBUG, "No update_fu\n"); + debug("No update_fu\n"); } } |