* lib/Autom4te/General.pm (backname): New.

diff --git a/ChangeLog b/ChangeLog
index dfe0870b02a36f3d1da34b332276975b931ede65..45a2f7f8ede29b62778aa2cfe90446c4fd07e2ca 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2001-10-24  Akim Demaille  <akim@epita.fr>
+
+       * lib/Autom4te/General.pm (backname): New.
+
 2001-10-24  Akim Demaille  <akim@epita.fr>
 
        * m4/: Remove, merged into...

diff --git a/lib/Autom4te/General.pm b/lib/Autom4te/General.pm
index 993b1c494df67f9061abbdc4887a491e000a945e..eb6e5c3b7b78558877458e3ad0614489bd399f1f 100644 (file)
--- a/lib/Autom4te/General.pm
+++ b/lib/Autom4te/General.pm
@@ -29,7 +29,8 @@ use strict;
 use vars qw (@ISA @EXPORT);
 
 @ISA = qw (Exporter);
-@EXPORT = qw (&debug &find_configure_ac &find_file &getopt &mktmpdir &mtime
+@EXPORT = qw (&backname &debug &find_configure_ac &find_file
+              &getopt &mktmpdir &mtime
               &uniq &update_file &up_to_date_p &verbose &xsystem
              $debug $force $help $me $tmp $verbose $version);
 
@@ -66,6 +67,12 @@ $version = undef;
 
 sub verbose (@);
 
+
+## ----- ##
+## END.  ##
+## ----- ##
+
+
 # END
 # ---
 # Exit nonzero whenever closing STDOUT fails.
@@ -99,8 +106,45 @@ sub END
 }
 
 
-# debug(@MESSAGE)
-# ---------------
+## ----------- ##
+## Functions.  ##
+## ----------- ##
+
+
+# $BACKPATH
+# &backname ($REL-DIR)
+# --------------------
+# If I `cd $REL-DIR', then to come back, I should `cd $BACKPATH'.
+# For instance `src/foo' => `../..'.
+# Works with non strictly increasing paths, i.e., `src/../lib' => `..'.
+sub backname ($)
+{
+  use File::Spec;
+
+  my ($file) = @_;
+  my $underscore = $_;
+  my @res;
+
+  foreach (split (/\//, $file))
+    {
+      next if $_ eq '.' || $_ eq '';
+      if ($_ eq '..')
+       {
+         pop @res;
+       }
+      else
+       {
+         push (@res, '..');
+       }
+    }
+
+  $_ = $underscore;
+  return File::Spec->canonpath (File::Spec->catfile (@res))
+}
+
+
+# &debug(@MESSAGE)
+# ----------------
 # Messages displayed only if $DEBUG and $VERBOSE.
 sub debug (@)
 {