implicit debugging newlines, avoid -w arnings for patterns like "ignore" without a /

git-svn-id: svn://tug.org/texlive/trunk@5044 c570f23f-e606-0410-a88d-b1316a301751

6 files changed, 45 insertions, 26 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 3c16d540402..b6924be6ad5 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -116,7 +116,7 @@ sub from_file {
   my $found = 0;
   do {
     my $tlp = TeXLive::TLPOBJ->new;
-    &TeXLive::TLUtils::debug("creating tlp ...\n");
+    &TeXLive::TLUtils::debug("creating tlp from $_[0]...");
     $found = $tlp->from_fh(\*TMP,1);
     if ($found) {
       $self->add_tlpobj($tlp);
@@ -139,8 +139,8 @@ sub writeout {
   my $self = shift;
   my $fd = (@_ ? $_[0] : STDOUT);
   foreach (sort keys %{$self->{'tlps'}}) {
-    &TeXLive::TLUtils::debug("tlpname = $_\n");
-    &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name . "\n");
+    &TeXLive::TLUtils::debug("tlpname = $_");
+    &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name);
     $self->{'tlps'}{$_}->writeout($fd);
     print $fd "\n";
   }
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 40f4e5f2d27..a1422c98681 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -64,7 +64,7 @@ sub from_fh {
   my $size;
 
   while (my $line = $fh->getline) {
-    &TeXLive::TLUtils::debug("reading line: >>>$line<<<\n");
+    &TeXLive::TLUtils::debug("reading line: >>>$line<<<");
     $line =~ /^\s*#/ && next;          # skip comment lines
     if ($line =~ /^\s*$/) {
       if (!$started) { next; }
@@ -367,7 +367,7 @@ sub make_zip {
   # now the $pkg.$arch.zip
   if ($self->is_arch_dependent) {
     foreach my $t (keys %{$self->{'binfiles'}}) {
-      &TeXLive::TLUtils::debug("arch=$t\n");
+      &TeXLive::TLUtils::debug("arch=$t");
       if ($zipname =~ /^(.*)\.zip$/) {
         $zipn = "$1.$t.zip";
       } else {
@@ -405,7 +405,7 @@ sub _make_zip {
   }
   @files = TeXLive::TLUtils::sort_uniq(@files);
   if (!@files) {
-    &TeXLive::TLUtils::debug("Not creating empty zip file $zipname\n");
+    &TeXLive::TLUtils::debug("Not creating empty zip file $zipname");
     return;
   }
   my $cwd = &getcwd;
diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm
index 41d1dc2928f..01c56cdfa25 100644
--- a/Master/tlpkg/TeXLive/TLTREE.pm
+++ b/Master/tlpkg/TeXLive/TLTREE.pm
@@ -197,7 +197,6 @@ sub _get_matching_files {
   my ($self, $type, $p) = @_;
   my ($pattype,$patdata,@rest) = split ' ',$p;
   my @matchfiles;
-  &TeXLive::TLUtils::debug("check on $pattype,$patdata,@rest\n");
   if ($pattype eq "t") {
     @matchfiles = $self->_get_files_matching_dir_pattern($type,$patdata,@rest);
   } elsif ($pattype eq "f") {
@@ -209,7 +208,7 @@ sub _get_matching_files {
   } else {
     die "Unknown pattern $p";
   }
-  TeXLive::TLUtils::debug("DEBUG: p=$p, matchfiles=@matchfiles\n");
+  TeXLive::TLUtils::debug("p=$p; matchfiles=@matchfiles");
   return @matchfiles;
 }
 
@@ -235,18 +234,18 @@ sub _get_files_matching_glob_pattern {
   return unless (defined($self->{'_filesofdir'}{$dirpart}));
   my @candfiles = @{$self->{'_filesofdir'}{$dirpart}};
   foreach my $f (@candfiles) {
-    &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline\n");
+    &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline");
     if ($f =~ /^$basepart$/) {
-      &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f\n");
+      &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f");
       push @returnfiles, "$dirpart/$f";
     }
   }
   if ($dirpart =~ m@^bin/win32@) {
     # for arch=win32 under bin we also want to match .dll, .bat, .exe files
     foreach my $f (@candfiles) {
-      &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline.{bat/exe}\n");
+      &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline.{bat/exe}");
       if ($f =~ /^$basepart\.(bat|exe|dll)$/) {
-        &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f\n");
+        &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f");
         push @returnfiles, "$dirpart/$f";
       }
     }
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index eb2e87e934e..87f9e9d7615 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -336,10 +336,15 @@ Return C<$path> with its trailing C</component> removed.
 =cut
 
 sub dirname {
-   $_[0]=~/(.*)\/.*/;
-   return "$1";
+  if ($_[0] =~ m!/!) {  # dirname("foo/bar/baz") -> "foo/bar"
+    $_[0] =~ m!(.*)/.*!;
+    return $1;
+  } else {              # dirname("ignore") -> "."
+    return ".";
+  }
 }
 
+
 =item C<basename($path)>
 
 Return C<$path> with any leading directory components removed.
@@ -347,15 +352,20 @@ Return C<$path> with any leading directory components removed.
 =cut
 
 sub basename {
-  $_[0]=~/.*\/(.*)/;
-  return "$1";
+  if ($_[0] =~ m!/!) {  # basename("foo/bar") -> "bar"
+    $_[0] =~ m!.*/(.*)!;
+    return $1;
+  } else {              # basename("ignore") -> "ignore"
+    return $_[0];
+  }
 }
 
+
 =item C<dirname_and_basename($path)>
 
-Return C<dirname> and C<basename>.  Example:
+Return both C<dirname> and C<basename>.  Example:
 
-  ($dir, $file)=dirname_and_basename($path);
+  ($dirpart,$filepart) = dirname_and_basename ($path);
 
 =cut
 
@@ -697,15 +707,15 @@ sub member {
 
 =pod
 
-=item C<debug($string)>
+=item C<debug($string, ...)>
 
-The C<debug> function echos the argument string to STDERR in case that
-the global varialbe C<opt_debug> is set.
+The C<debug> function echos the argument strings to STDERR if
+the global variable C<opt_debug> is set.
 
 =cut
 
 sub debug {
-  print STDERR @_ if ($::opt_debug);
+  print STDERR "tldbg: @_\n" if $::opt_debug;
 }
 
 =pod
diff --git a/Master/tlpkg/bin/tlpdb-update b/Master/tlpkg/bin/tlpdb-update
index b6a79cfc891..4950237b4ac 100755
--- a/Master/tlpkg/bin/tlpdb-update
+++ b/Master/tlpkg/bin/tlpdb-update
@@ -10,7 +10,17 @@
 unset CDPATH
 cd `dirname $0`/../.. || exit 1
 
-perl tlpkg/bin/tlpsrc2tlpdb tlpkg/tlpsrc/*.tlpsrc >texlive.tlpdb.new
-mv texlive.tlpdb ${TMPDIR-/tmp}/texlive.tlpdb.saved
-mv texlive.tlpdb.new texlive.tlpdb
+if test "x$1" = x-n; then
+  chicken=true
+  shift
+else
+  chicken=false
+fi
 
+perl tlpkg/bin/tlpsrc2tlpdb "$@" tlpkg/tlpsrc/*.tlpsrc >texlive.tlpdb.new
+if $chicken; then
+  echo "$0: skipping update, see `pwd`/texlive.tlpdb.new."
+else
+  mv texlive.tlpdb ${TMPDIR-/tmp}/texlive.tlpdb.saved
+  mv texlive.tlpdb.new texlive.tlpdb
+fi
diff --git a/Master/tlpkg/bin/tlpsrc2tlpdb b/Master/tlpkg/bin/tlpsrc2tlpdb
index 451872591c4..a8fadc5bc43 100755
--- a/Master/tlpkg/bin/tlpsrc2tlpdb
+++ b/Master/tlpkg/bin/tlpsrc2tlpdb
@@ -62,7 +62,7 @@ foreach my $f (@ARGV) {
   $tlsrc->from_file($f);
   my $tlp = $tlsrc->make_tlpobj($tltree);
   # now merge the TeX Catalogue Information, currently only license
-  my $tlcname = defined($tlp->catalogue) ? $tlp->catalogue : $tlp->name;
+  #xx set in struct somehow? my $tlcname = defined($tlp->catalogue) ? $tlp->catalogue : $tlp->name;
   if ($tlc) {
     $tlp->update_from_catalogue($tlc);
   }