Useful bits for the Perl support code.

[sw-tools] / perl / SWConfig.pm.in

diff --git a/perl/SWConfig.pm.in b/perl/SWConfig.pm.in
new file mode 100644 (file)
index 0000000..73a9713
--- /dev/null
+++ b/perl/SWConfig.pm.in
@@ -0,0 +1,71 @@
+# -*-perl-*-
+#
+# $Id: SWConfig.pm.in,v 1.1 1999/07/30 18:48:05 mdw Exp $
+#
+# Exports configuration variables
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools 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.
+# 
+# sw-tools 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 sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SWConfig.pm.in,v $
+# Revision 1.1  1999/07/30 18:48:05  mdw
+# Useful bits for the Perl support code.
+#
+
+#----- Package preamble -----------------------------------------------------
+
+package SWConfig;
+use IO;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(%C);
+
+#----- Configuration variables ----------------------------------------------
+
+%C = ();
+$C{pkg} = '@PACKAGE@';
+$C{version} = '@VERSION@';
+$C{prefix} = '@prefix@';
+$C{datadir} = '@datadir@';
+$C{index} = '${prefix}/sw-index';
+$C{doc} = '${prefix}/doc';
+
+foreach my $k (qw(datadir index doc)) {
+  $C{$k} =~ s/\$\{(\w+)\}/$C{$1}/eg;
+}
+
+#----- Read a configuration file --------------------------------------------
+
+if (my $fh = IO::File->new("$C{datadir}/sw.conf")) {
+  LINE: while (my $line = $fh->getline()) {
+    chomp($line);
+    next LINE if $line =~ /^\s*\#/ || $line =~ /^\s*$/;
+    my ($k, $v) = split(/\s*=\s*|\s+/, $line, 2);
+    $v =~ s/\$\{(\w+)\}/$C{$1}/eg;
+    $C{$k} = $v;
+  }
+}
+
+#----- That's all, folks ----------------------------------------------------
+
+1;