Index: /trunk/gsdl/bin/script/expand_macros.pl
===================================================================
--- /trunk/gsdl/bin/script/expand_macros.pl	(revision 10510)
+++ /trunk/gsdl/bin/script/expand_macros.pl	(revision 10510)
@@ -0,0 +1,665 @@
+#! /usr/bin/perl
+
+##################################################################################
+#                                                                                #
+# expand_macros.pl -- recursively expand greenstone macros / 1080805 - 7140805   #
+#                                                                                #
+# Copyright (C) 2005 Jens Wille <j_wille at gmx.net>                             #
+#                                                                                #
+# This program is free software; you can redistribute it and/or                  #
+# modify it under the terms of the GNU General Public License                    #
+# as published by the Free Software Foundation; either version 2                 #
+# of the License, or (at your option) any later version.                         #
+#                                                                                #
+# This program is distributed in the hope that it will be useful,                #
+# but WITHOUT ANY WARRANTY; without even the implied warranty of                 #
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the                  #
+# GNU General Public License for more details.                                   #
+#                                                                                #
+# You should have received a copy of the GNU General Public License              #
+# along with this program; if not, write to the Free Software                    #
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.    #
+#                                                                                #
+##################################################################################
+
+#
+# expand_macros.pl reads in specified greenstone macro files and prints the
+# definitions of requested macros and recursively the definitions of macros
+# used within these definitions.
+#
+# it also has an "interactive browse mode" where you can select which macro
+# (and from which package) to display next.
+#
+# you can even search for macros that use certain macros ("reverse" search)
+# - recursively!
+#
+
+use strict;
+use warnings;
+
+use Getopt::Long          qw(GetOptions);
+
+use File::Basename        qw(basename);
+use File::Spec::Functions qw(catdir catfile);
+
+use IO::Handle            qw(autoflush);
+STDOUT->autoflush(1);
+
+
+### progname and version
+
+my $NAME    = basename $0;
+my $VERSION = '0.12';
+
+
+### command line arguments
+
+# variable initialisation and default values
+my ($verbose, $depth, $short, $reverse, $browse, $paged, $pager)
+ = (0,        '',     0,      0,        0,       0,      'less');
+
+my @macro_dirs = (catdir($ENV{'GSDLHOME'}, 'macros'));
+my @macros     = ();
+
+# usage information and help text
+my $USG = <<HERE_USG;
+usage:
+    $NAME [generic-options] [-d <depth>] [-s] [-r] [<package>:]<macro> ...
+    $NAME [generic-options] {-b|-i} [-p]
+    $NAME [-h|-?|--help]
+
+    generic options are: [-v] [-e <directory>,...]
+HERE_USG
+
+my $HLP = <<HERE_HLP;
+$NAME: recursively expand greenstone macros (v$VERSION)
+
+$USG
+
+generic options:
+    -h, -?, --help                 display this help and exit
+    -v,     --verbose              output some extra information/warnings
+
+    {-e|--extra} <directory>,...   paths to extra macro directories, comma-separated list (default directory: '$macro_dirs[0]')
+
+batch mode:
+    {-d|--depth} <depth>           how deep to recurse through macros (default: '$depth', meaning 'infinite')
+
+    -s,     --short                short output, i.e. only macro names, no content
+    -ss                            really short, i.e. no content, no recursion (equivalent to '-s -d 0')
+
+    -r,     --reverse              "reverse" search, outputs the macros which _use_ the specified macro(s)
+
+    all non-option arguments will be treated as macro names (without surrounding '_')
+    you can restrict your query to a certain package by prepending the macro name with '<package-name>:'
+
+interactive browse mode:
+    -b, -i, --browse               interactive browse mode, just try it ;-)
+
+    -p,     --paged                data output will be passed to a pager (default: '$pager')
+            --pager <pager>        pass paged output to specified pager instead of above named default
+HERE_HLP
+
+# allow for bundling of options
+Getopt::Long::Configure ("bundling");
+
+# parse arguments
+GetOptions( 'help|h|?'   => sub { print "$HLP\n"; exit 0 },
+            'verbose|v'  => \$verbose,
+            'extra|e=s'  => \@macro_dirs,
+            'depth|d=i'  => \$depth,
+            'short|s+'   => \$short,
+            'reverse|r'  => \$reverse,
+            'browse|b|i' => \$browse,
+            'paged|p'    => \$paged,
+            'pager=s'    => \$pager,
+            '<>'         => sub { push(@macros => @_) } )
+  or die "$USG\n";
+
+
+### some sanity checks
+
+# need one of our "actions": batch or browse
+# ("batch" requiring at least one macro name specified)
+die "$USG\n"
+  unless @macros || $browse;
+
+# need GSDLHOME for default macro directory
+# (does also allow to have the script in gsdl bin path)
+die "GSDLHOME not set! please change into the directory where greenstone has been installed and run/source the appropriate setup script.\n"
+  unless $ENV{'GSDLHOME'};
+
+# get the pager executable
+# no need to test if not in "paged" mode
+unless (! $paged || -x $pager) {
+  # get first pager executable in PATH
+  foreach my $path (split(':' => $ENV{'PATH'})) {
+    if (-x catfile($path, $pager)) {
+      $pager = catfile($path, $pager);
+      last;
+    }
+  }
+
+  # still no executable?
+  die "can't find pager '$pager'!\n"
+    unless -x $pager;
+}
+
+
+### action!
+
+# build hash of macro information
+my %db = build_db();
+die "macro db empty!\n"
+  unless %db;
+
+unless ($browse) {
+  # batch mode
+
+  my $n = 0;
+  foreach my $macro (@macros) {
+    unless ($reverse) {
+      # "normal" search
+
+      get_macro(\%db, $macro);
+    }
+    else {
+      # "reverse" search
+
+      print "*** $macro ***\n\n";
+
+      # get the macros that use the specified macro
+      my @refs = get_r_macros(\%db, $macro);
+      warn "no macro referencing '$macro'\n"
+        unless @refs;
+
+      # now recurse those macros
+      foreach my $m (@refs) {
+        get_macro(\%db, $m);
+      }
+    }
+
+    # print separator _between_ requested macros (i.e. everytime but the last time)
+    # (need to add extra newline for short display)
+    print(($short ? "\n" : ''), '-' x 80, "\n\n")
+      unless ++$n >= @macros;
+  }
+}
+else {
+  # interactive browse mode
+
+  # repeat until explicit exit
+  while (1) {
+    print "enter macro name (without package specification) [leave empty to quit]\n> ";
+    my $macro = <STDIN>;
+    die "\n"
+      unless defined $macro;  # allow for exiting by hitting <ctrl>+d
+    chomp $macro;
+
+    exit 0
+      unless length $macro;   # normal exit
+
+    # now get all packages for given macro, and begin recursion...
+    recurse_packages(\%db, $macro);
+  }
+}
+
+
+### that's it ;-)
+
+exit 0;
+
+
+### subroutines
+
+# <sub build_db>
+# build hash of macro information ("macro db")
+#
+# hash structure:
+#   macro
+#   -> package
+#      -> 'file'
+#      -> 'line'
+#      -> 'content'
+#
+# usage:
+#   %db = build_db()
+#
+#  => db: returned hash ("macro db")
+#
+sub build_db {
+  my %db = ();
+  my @dm = ();
+  my ($n, $m) = (0, 0);
+
+  # get all macro files (*.dm) from specified directories
+  foreach my $dir (@macro_dirs) {
+    opendir(DIR, "$dir")
+      or die "can't read macro directory '$dir': $!\n";
+
+    push(@dm => map { $_ = catfile($dir, $_) } grep { /\.dm$/ } readdir(DIR));
+
+    closedir DIR;
+  }
+
+  # now parse each macro file and build hash
+  foreach my $dm (sort @dm) {
+    open(DM, "< $dm")
+      or die "can't open macro file '$dm': $!\n";
+
+    my ($name, $content, $curpkg, $contd) = ('', '', '', 0);
+    while (my $line = <DM>) {
+      chomp($line);
+      next unless length $line;      # skip empty lines
+      next if     $line =~ /^\s*$/;  # skip "empty" lines
+      next if     $line =~ /^\s*#/;  # skip comments (i hope this doesn't
+                                     # affect cases we actually wanted to keep)
+
+                      # is this sufficient???
+      if    ($line =~ /^package\s+(\w+)/) {
+        # remember the current package we are in
+        $curpkg = $1;
+      }
+                      # my understanding of greenstone macro names:
+                      #   - enclosed in underscores ('_')
+                      #   - starts with a letter ([:alpha:])
+                      #   - followed by alphanumeric characters ([:alnum:])
+                      #     (consequently, it doesn't start with a number and
+                      #     particularly isn't a macro parameter, i.e. something like _1_)
+                      #   - also we need to take care of escaped underscores ('\_')
+                      #
+                      #   => does this fit???
+      elsif ($line =~ /(?<!\\)_([[:alpha:]][[:alnum:]]*)(?<!\\)_\s*\{\s*(.*)/) {
+        # start of macro definition
+        $n++;
+
+        $name    = $1;
+        $content = $2 || '';
+
+        # is the macro definition already finished?
+        $contd = ($content =~ s/\s*(?<!\\)\}.*//) ? 0 : 1;
+
+        if (exists $db{$name}->{$curpkg}) {
+          # everytime a macro definition already exists, it's simply
+          # overwritten - but we can give a warning
+          # (this might also serve debugging purposes)
+          $m++;
+
+          warn <<HERE_WARN if $verbose;
+duplicate definition of macro '$curpkg:$name' at '$dm', line $.
+(previously defined at $db{$name}->{$curpkg}->{'file'}, line $db{$name}->{$curpkg}->{'line'})
+HERE_WARN
+        }
+
+        # store the information we got so far
+        $db{$name}->{$curpkg}->{'file'}    = $dm;
+        $db{$name}->{$curpkg}->{'line'}    = $.;
+        $db{$name}->{$curpkg}->{'content'} = [$content] if length $content;
+      }
+      elsif ($contd) {
+        # continuation of macro definition
+
+        # is the macro definition already finished?
+        $contd = ($line =~ s/\s*(?<!\\)\}.*//) ? 0 : 1;
+
+        # store additional content
+        push(@{$db{$name}->{$curpkg}->{'content'}} => $line);
+      }
+      else {
+        # something else...
+
+        ($name, $content) = ('', '');
+      }
+    }
+
+    close DM;
+  }
+
+  # print some statistics
+  print "$n total macro definitions, $m duplicates\n"
+    if $verbose;
+
+  # we stored all information there is so we can return it
+  return %db;
+}
+# </sub build_db>
+
+# <sub get_macro>
+# recursively print macro information
+#
+# usage:
+#   get_macro($db, $macro[, $level])
+#
+#   db:    hash reference to macro db
+#   macro: macro name (optionally including package specification)
+#   level: recursion level (optional)
+#
+#   => VOID CONTEXT
+#
+sub get_macro {
+  my ($db, $macro, $level) = @_;
+  $level ||= 0;
+
+  # indent output according to recursion level
+  my $indent  = '    ' x $level;
+
+  # get all the packages which our macro is defined in
+  ($macro, my @packages) = get_packages($db, $macro, $indent);
+  return unless @packages;
+
+  # macro definitions may occur in several packages so we display them all
+  # (unless a certain package was explicitly specified)
+  foreach my $pkg (@packages) {
+    print "$indent* $pkg:$macro ($db->{$macro}->{$pkg}->{'file'}, line $db->{$macro}->{$pkg}->{'line'})\n";
+
+    next if $short > 1;  # really short (no content, no recursion)
+
+    my $content = '';
+    # some macros are defined, but don't have any content
+    if (defined $db->{$macro}->{$pkg}->{'content'}) {
+      # for batch display we condense the output a little bit...
+      map { s/^\s*//; s/\s*$// } @{$db->{$macro}->{$pkg}->{'content'}};
+      # ...and put it on a single line
+      $content = join(' ' => @{$db->{$macro}->{$pkg}->{'content'}});
+    }
+    print "$indent  { $content }\n\n"
+      unless $short;
+      # short display only, i.e. no content
+      # of the macro's definition
+
+    # only go (deeper) into referenced macros if we
+    # haven't reached the specified recursion level
+    if ($depth eq '' || $level < $depth) {
+      # get (referencing|referenced) macros...
+      my @refs = $reverse
+               ? get_r_macros($db, $macro)
+               : get_macros($content);
+
+      # ...and recurse above them (with increased recursion level)
+      foreach my $ref (@refs) {
+        get_macro($db, $ref, $level + 1);
+      }
+    }
+  }
+}
+# </sub get_macro>
+
+# <sub get_macros>
+# returns a list of macros extracted from a content string
+# or a boolean value if a macro name was specified
+#
+# usage:
+#   @macros  = get_macros($content)
+#   $boolean = get_macros($content, $macro)
+#
+#   content: content string
+#   macro:   macro name
+#
+#   => macros:  list of macros
+#   => boolean: boolean value (true = 1 / false = empty list)
+#
+sub get_macros {
+  my ($content, $macro) = @_;
+  my @macro_list = ();
+  my %seen       = ();
+
+  # get each macro reference in the string
+  # (for macro name considerations see above)
+  while ($content =~ /(?<!\\)_((?:[[:alpha:]]+:)?[[:alpha:]][[:alnum:]]*)(?<!\\)_/g) {
+    my $m = $1;
+
+                           # we want to skip some macros that have no content anyway (defined
+                           # from within the server) - unless we're doing a "reverse" search
+    next if $seen{$m}++ || ($m =~ /^(cgiarg.*|if|httpimg|gwcgi|(decoded)?compressedoptions)$/i
+                            && ! $reverse);
+
+    if (defined $macro) {
+      # is this the macro we wanted? then the current
+      # macro uses it => return true
+      return 1 if $m =~ /^(?:[[:alpha:]]+:)?$macro$/;
+    }
+    else {
+      # add macro to our list
+      push(@macro_list => $m);
+    }
+  }
+
+  # return the list of used macros
+  # (this evaluates to false (empty list) if there are no further
+  # macro calls or if this macro doesn't use the sought-after macro)
+  return sort @macro_list;
+}
+# </sub get_macros>
+
+# <sub get_r_macros>
+# returns a list of macro names which reference ("use") the specified macro
+#
+# usage:
+#   @macros = get_r_macros($db, $macro)
+#
+#   db:    hash reference to macro db
+#   macro: macro name
+#
+#   => macros: list of macros
+#
+sub get_r_macros {
+  my ($db, $macro) = @_;
+  my %refs = ();
+
+  # need to test each single macro's...
+  foreach my $m (sort keys %{$db}) {
+    # ...each single package
+    foreach my $p (sort keys %{$db->{$m}}) {
+      my $pm = "$p:$m";  # include package information in the macro name!
+
+                   # does this macro have any content?
+      $refs{$pm}++ if defined $db->{$m}->{$p}->{'content'}
+                   # then check if it uses our sought-after macro
+                   && get_macros(join(' ' => @{$db->{$m}->{$p}->{'content'}}), $macro);
+                                 # need to stringify content!
+    }
+  }
+
+  # now we have all the macros which use our sought-after
+  return sort keys %refs;
+}
+# </sub get_r_macros>
+
+# <sub recurse_packages>
+# recurse all packages for a given macro
+#
+# usage:
+#   recurse_packages($db, $macro)
+#
+#   db:    hash reference to macro db
+#   macro: macro name (any package specification will be dropped)
+#
+#   => VOID CONTEXT
+#
+sub recurse_packages {
+  my ($db, $macro) = @_;
+
+  # repeat until explicit break/exit
+  while (1) {
+    # get all the packages which our macro is defined in
+    ($macro, my @packages) = get_packages($db, $macro);
+    return unless @packages;
+
+    print "select package for macro '$macro' [leave empty to return]\n";
+    my $n = 0;
+    my $package = '';
+    # ask for user's selection...
+    do {
+      foreach my $pkg (@packages) {
+        printf "    [%d]%s %s\n", ++$n, " " x (4 - length $n), $pkg;
+      }
+      print "> ";
+      $package = <STDIN>;
+      die "\n"
+        unless defined $package;  # allow for exiting by hitting <ctrl>+d
+      chomp $package;
+      $n = 0;
+    # ...until we return...
+    } until ($package eq ''
+         # ...or a valid number is provided
+         || ($package =~ /^\d+$/ && $package > 0 && $package <= @packages));
+
+    return unless length $package;  # return to previous stage
+
+    # set selected package
+    $package = $packages[$package - 1];
+
+                  # some macros are defined, but don't have any content
+    my $content = defined $db->{$macro}->{$package}->{'content'}
+                ? join("\n" => @{$db->{$macro}->{$package}->{'content'}})
+                  # now we want to retain the original structure
+                : '';
+
+    my $content_string = <<HERE_CONTENT;
+* $package:$macro ($db->{$macro}->{$package}->{'file'}, line $db->{$macro}->{$package}->{'line'})
+  { $content }
+HERE_CONTENT
+
+    if ($paged) {
+      # pass output to pager
+
+      open(LESS, "| $pager")
+        or die "can't open pipe to '$pager': $!";
+
+      print LESS "$content_string";
+
+      close LESS;
+    }
+    else {
+      # print to standard out...
+
+      print      "\n$content_string\n";
+
+      # ...and wait for user reaction to continue
+      print "[press <enter> to continue]";
+      print "\n"
+        if <STDIN>;
+    }
+
+    # now on to the macros referenced within this one
+    recurse_macros($db, $content);
+  }
+}
+# </sub recurse_packages>
+
+# <sub get_packages>
+# returns list of packages for specified macro, also returns
+# modified macro name (without surrounding '_' and package specification)
+#
+# usage:
+#   ($macro, @packages) = get_packages($db, $macro)
+#
+#   db:    hash reference to macro db
+#   macro: macro name
+#
+#   => macro:    modified macro name
+#   => packages: list of packages
+#
+sub get_packages {
+  my ($db, $macro, $indent) = @_;
+  $indent ||= '';
+
+  # remove surrounding '_'
+  $macro =~ s/^_//;
+  $macro =~ s/_$//;
+
+  # save original macro name (including package specification)
+  my $omacro = $macro;
+
+  my @packages = ();
+
+                # for macro name considerations see above
+  if ($macro =~ /^([[:alpha:]]+:)?[[:alpha:]][[:alnum:]]*$/) {
+    # valid macro name
+
+    # strip off package specification
+    my $package = ($macro =~ s/^([[:alpha:]]+)://) ? $1 : '';
+
+    if (exists $db->{$macro}) {
+      # valid/existing macro
+
+      if (length $package && ! $browse) {
+        # regard any package specification unless we're in browse mode
+
+        @packages = ($package)
+          if exists $db->{$macro}->{$package};
+      }
+      else {
+        # get all packages otherwise
+
+        @packages = sort keys %{$db->{$macro}};
+      }
+    }
+  }
+  else {
+    # invalid macro name
+
+    warn "invalid macro name '$macro'!\n";
+    return;  # skip it
+  }
+
+  # no packages - no definition
+  unless (@packages) {
+    print "$indent- $omacro\n$indent  no definition for macro!\n\n";
+    return;  # skip it
+  }
+
+  # return modified macro name and packages found
+  return $macro, sort @packages;
+}
+# </sub get_packages>
+
+# <sub recurse_macros>
+# recurse all macros for a given content string
+#
+# usage:
+#   recurse_macros($db, $content)
+#
+#   db:      hash reference to macro db
+#   content: content string
+#
+#   => VOID CONTEXT
+#
+sub recurse_macros {
+  my ($db, $content) = @_;
+
+  # repeat until explicit break/exit
+  while (1) {
+    # get all the macros referenced within the current one
+    @macros = get_macros($content);
+    return unless @macros;
+
+    print "select macro [leave empty to return]\n";
+    my $n = 0;
+    my $macro = ''; 
+    # ask for user's selection...
+    do {
+      foreach my $m (@macros) {
+        printf "    [%d]%s %s\n", ++$n, " " x (4 - length $n), $m;
+      }
+      print "> ";
+      $macro = <STDIN>;
+      die "\n"
+        unless defined $macro;  # allow for exiting by hitting <ctrl>+d
+      chomp $macro;
+      $n = 0;
+    # ...until we return...
+    } until ($macro eq ''
+         # ...or a valid number is provided
+         || ($macro =~ /^\d+$/ && $macro > 0 && $macro <= @macros));
+
+    return unless length $macro;  # return to previous stage
+
+    # set selected macro
+    $macro = $macros[$macro - 1];
+
+    # now we want all the macro's packages again
+    recurse_packages($db, $macro);
+  }
+}
+# </sub recurse_macros>
