#!/usr/bin/perl -w 
# -*-cperl-*-
## Filename: ucs-config
## Modified: Mon Sep 20 17:58:58 2004 (evert)   
##   Author: Stefan Evert
##  Purpose: UCS configuration info and automatic configuration of UCS/Perl scripts

use UCS;
use UCS::File;

use Pod::Usage;
use Getopt::Long;

%Opt = map {$_ => 0} qw<BASE PERL BIN LIB R VERSION>;
$Opt_Help = 0;

# the "ucs-config --run ..." form is a special case 
# that we need to catch before normal command-line parsing takes place
unshift @ARGV, "--run"	    # this little knack implements the -e abbreviation
  if @ARGV >= 2 and $ARGV[0] eq "-e";
if (@ARGV >= 2 and $ARGV[0] =~ /^--?run$/i) {
  shift @ARGV;		      # drop the --run
  @mods = map { "-M$_" }      # try to be helpful and preload (almost) all UCS modules
    (
     qw<UCS UCS::File UCS::R UCS::SFunc>,
     qw<UCS::AM>,	      # load standard measures, but no add-on packages
     qw<UCS::Expression UCS::Expression::Func>,
     qw<UCS::DS UCS::DS::Stream UCS::DS::Memory UCS::DS::Format>,
    );
  @libs = map { "-I$_" } @UCS::PerlLibs;
  # run perl interpreter with UCS library path set and specified command-line arguments
  # (the exec() call bypasses the shell, so the libdir and the arguments won't be messed up)
  exec($UCS::PerlBin, @libs, @mods, @ARGV)
    or die "Error: exec() failed.  Has the Perl interpreter wandered off for a pint?\n";
}

$ok = GetOptions(
		 "version|v" => \$Opt{VERSION},
		 "base-dir|base" => \$Opt{BASE},
		 "perl-dir|perl" => \$Opt{PERL},
		 "bin-dir|bin" => \$Opt{BIN},
		 "lib-dir|lib" => \$Opt{LIB},
		 "R-bin|R" => \$Opt{R},
		 "help|h" => \$Opt_Help,
		 );

$Npar = 0;
map {$Npar += $_} values %Opt;

print STDERR "Error: you cannot specify multiple flags.\n"
  if $Npar > 1;
print STDERR "Error: you cannot specify both flags and filenames for in-place editing.\n"
  if $Npar and @ARGV;

die "Try 'ucs-config -h' for usage information\n"
  unless $ok and ($Npar <= 1) and not ($Npar and @ARGV);

pod2usage(qw<-verbose 1  -exitval 0>)
  if $Opt_Help;

if ($Npar) {					# print configuration information
  print "$UCS::Version\n" if $Opt{VERSION};
  print "$UCS::BaseDir\n" if $Opt{BASE};
  print "$UCS::PerlDir\n" if $Opt{PERL};
  print "$UCS::PerlDir/bin\n" if $Opt{BIN};
  print "$UCS::PerlDir/lib\n" if $Opt{LIB};
  print "$UCS::Rbin\n" if $Opt{R} and defined $UCS::Rbin;
}
elsif (@ARGV) {					# in-place edit UCS/Perl and UCS/R scripts
  foreach $file (@ARGV) {
    $isR = ($file =~ /\.[RS]$/) ? 1 : 0;	# files with extension .R or .S are interpreted as UCS/R scripts
    $fh = UCS::File::Open $file;
    print "[in-place editing ",(($isR) ? "UCS/R" : "UCS/Perl")," script $file]\n";
    die "Can't read '$file'. Aborted.\n"
      unless defined $fh;
    @lines = <$fh>;
    die "Read error.\n"
      unless @lines >= 6;			# rough check :o)   [might check against "wc -l" instead]
    $fh->close;
    if ($isR) {					# edit UCS/R script
      $substitutions = 0;
      foreach $l (@lines) {
	if ($l =~ /^\s*source\(\s*(\"([^\"]*\/)?ucs\.R\"|\'([^\"]*\/)?ucs\.R\')\s*\)/) {
	  $l = "source('$UCS::R_BaseDir/R/lib/ucs.R')\t # in-place edit by ucs-config\n";
	  $substitutions++;
	}
      }
      die "Error: could not find place where to insert path to UCS/R configuration file.\n",
	"You may need to insert the following command manually on a separated line:\n",
	  "\tsource(\"ucs.R\")\n"
	    unless $substitutions > 0;
      warn "Warning: path to UCS/R configuration file was inserted in more than one place.\n",
	"Please check the edited file for errors (see backup in $file~).\n"
	  if $substitutions > 1;
    }
    else {					# edit UCS/Perl script
      die "Error: script doesn't begin with #! line. Aborted.\n"
	unless $lines[0] =~ /^\s*\#\!/;
      $lines[0] = $UCS::PerlCmd."\n";
    }
    $backup = "$file~";				# back up original file
    unlink $backup
      if -f $backup;
    system "cp -p $file $backup";
    $fh = UCS::File::Open "> $file";		# write modified lines back to file
    map { $fh->print($_) } @lines;
    $fh->close
      or die "Write error. '$file' may be damaged!\n";
    system "touch -r $backup $file";		# reset modification time of edited file 
  }
}
else {						# print splash screen and configuration summary
  UCS::Splash();

  print "======================================================================\n";
  print "UCS Version:       $UCS::Version\n";
  print "UCS base dir:      $UCS::BaseDir/\n";
  print "UCS/Perl dir:      $UCS::PerlDir/\n";
  print "UCS/R interpreter: ", (defined $UCS::Rbin) ? $UCS::Rbin : "-- not installed --", "\n";
  if ($UCS::R_BaseDir ne $UCS::BaseDir) {
    print "UCS base dir (R):  $UCS::R_BaseDir/\n";
  }
  print "UCS/Perl command:  $UCS::PerlCmd\n";
  print "======================================================================\n";
  print "\n";
}




__END__

=head1 NAME

ucs-config - Automatic configuration of UCS/Perl scripts

=head1 SYNOPSIS

  ucs-config

  ucs-config [--version | --base-dir | --perl-dir | --bin-dir | --lib-dir | --R-bin]
  ucs-config [-v | --base | --perl | --bin | --lib | -R]

  ucs-config ucs-script.pl ucs-script.R ...

  ucs-config --run [options] one-liner.perl
  ucs-config --run [options] -e '...'
  ucs-config -e '...'

=head1 DESCRIPTION

The B<ucs-config> program is used to print information about the
installed UCS/Perl version and directories, as well as for the
automatic configuration of UCS/Perl scripts.  The program can be run
in four different modes.

Invoking B<ucs-config> without any arguments prints the UCS splash
screen and a configuration summary.  

In the second mode, the program prints one item of configuration
information selected with one of the following flags.  This mode is
most suitable for use in shell scripts and makefiles.  Note that
you are not allowed to specify more than one flag at a time.

  --version    UCS version
  --base-dir   root directory of the UCS system
  --perl-dir   root directory of the UCS/Perl subsystem
  --bin-dir    bin/ directory of UCS/Perl (contains UCS programs)
  --lib-dir    lib/ directory of UCS/Perl (contains UCS modules)
  --R-bin      fully qualified filename of the R interpreter

The third mode is used to in-place edit Perl and R scripts so that
they can load the B<UCS> modules and libraries.  For B<Perl scripts>,
B<ucs-config> inserts a suitable shebang (C<#!>) line, invoking the
Perl interpreter for which UCS is configured together with the
necessary include paths.  For B<R scripts> (which are recognised by
their extension C<.R> or C<.S>), B<ucs-config> looks for a line
containing the command C<source(".../ucs.R")> in the script, and
inserts the correct path there.  Please make sure that this line does
not contain any other commands.

The final mode, introduced by the command-line switch C<--run>,
invokes the Perl interpreter with the correct UCS library path
and (almost) all B<UCS modules> pre-loaded (including the standard
association measures from B<UCS::AM>, but none of the add-on packages).
The remaining command-line arguments are passed through to the Perl
interpreter, which is I<really cool> for writing one-liners in B<UCS/Perl>.
The flag C<-e> is an abbreviation of C<--run -e>, but does not allow
any options to be passed to the interpreter.


=head1 COPYRIGHT

Copyright 2004 Stefan Evert.

This software is provided AS IS and the author makes no warranty as to
its use and performance. You may use the software, redistribute and
modify it under the same terms as Perl itself.

=cut
