20 Jan
2007
20 Jan
'07
3:21 p.m.
URL: https://svn.lrde.epita.fr/svn/xrm/trunk
ChangeLog:
2007-01-20 SIGOURE Benoit <tsuna(a)lrde.epita.fr>
Fix binary distributions.
Binary distributions were incomplete because files under /nix were not
included.
* bin-dist.sh: Use relocate_xtc_repos.pl to make XTC repositories
relocatable.
* relocate_xtc_repos.pl: New. Handle inclusions of XTC repositories
and files under /nix.
bin-dist.sh | 44 ++++++++++++-
relocate_xtc_repos.pl | 160 ++++++++++++++++++++++++++++++++++++++++++++++++++
vcs/xrm.rb | 2
3 files changed, 201 insertions(+), 5 deletions(-)
Index: bin-dist.sh
===================================================================
--- bin-dist.sh (revision 105)
+++ bin-dist.sh (working copy)
@@ -1,5 +1,25 @@
#! /bin/sh
# Generate a binary distribution of XRM.
+# Copyright (C) 2007 Benoit Sigoure.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# or the GNU Lesser General Public License as published by the
+# Free Software Foundation; either version 2.1 of the
+# GNU Lesser General Public License or version 2 of the
+# GNU General Public 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 or the GNU Lesser General Public License
+# for more details.
+#
+# You should have received a copy of either the GNU General Public
+# License or the GNU Lesser General Public License along with this
+# program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
me=`basename "$0"`
abort()
@@ -27,19 +47,35 @@
make all install LDFLAGS='-all-static' || abort 'Compilation failed'
+mkdir _inst/share/nix || abort 'Could not create the nix directory'
+chmod 755 _inst/share/nix || abort 'Could not set rights of the nix dir'
+
: ${DEFAULT_XTC_REPOS=:}
echo '>>> Replacing and fixing binary XTC repositories with plain-text'
cd _inst || abort 'Cannot cd to _inst'
+
+# Now we need to remove all absolute paths from the XTC repository. Some of
+# them are easy to remove because they have just been copied by make install
+# and we now the prefix we used for that very make install. Now we also have
+# to deal with paths pointing to the Nix store (/nix/store) because we can't
+# assume the user will also have that installed (obviously...). The problem is
+# that an XTC repository can import another and this is what typically
+# happens: your project creates an XTC repos, registers its tools and imports
+# Stratego/XT's repos.
+# We thus need to handle (recursively) the fact that an XTC repos might import
+# another which will in turn bring many new files in the binary distribution
+# and potentially other XTC repositories. This work is done by
+# relocate_xtc_repos.pl.
+
for f in : `find share -type f -name XTC`; do
test x"$f" = x: && continue
echo -n " $f: "
- mv "$f" "$f.bin" || abort "Failed to rename
'$f'"
- pp-aterm -i "$f.bin" -o "$f.tmp" || abort "pp-aterm failed on
'$f.bin'"
- sed "s,$prefix,@prefix@,g" "$f.tmp" >"$f" || abort
"Failed to sed '$f.tmp'"
+ ../relocate_xtc_repos.pl "$prefix" "$f.tmp" >"$f"
rm -f "$f.tmp"
echo 'OK'
test x"$DEFAULT_XTC_REPOS" = x: && DEFAULT_XTC_REPOS=$f
done
+
cd .. || abort 'Cannot cd ..'
echo ">>> Hooking binary programs with shell scripts
@@ -71,6 +107,6 @@
echo 'OK'
mv $tarname.tar.{gz,bz2} .. || abort 'Failed to move tarballs'
cd .. || abort 'Failed to cd back to parent directory'
-rm -rf _static || abort 'Failed to clean the _static directory'
+#rm -rf _static || abort 'Failed to clean the _static directory'
echo "Binary distribution ready in $tarname.tar.gz and $tarname.tar.bz2"
Index: vcs/xrm.rb
===================================================================
--- vcs/xrm.rb (revision 105)
+++ vcs/xrm.rb (working copy)
@@ -7,7 +7,7 @@
def xrm_commit! ( *args )
common_commit!("XRM <%= rev %>: <%= title %>", *args) do
|subject|
- mail!(:to => %w[projects(a)lrde.epita.fr], :subject => subject)
+ mail!(:to => %w[xrm-patches(a)lrde.epita.fr], :subject => subject)
end
end
alias_command :xrmci, :xrm_commit
Index: relocate_xtc_repos.pl
===================================================================
--- relocate_xtc_repos.pl (revision 0)
+++ relocate_xtc_repos.pl (revision 0)
@@ -0,0 +1,160 @@
+#! /usr/bin/perl -w
+# Make Stratego XTC repositories relocatable.
+# Copyright (C) 2007 Benoit Sigoure.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# or the GNU Lesser General Public License as published by the
+# Free Software Foundation; either version 2.1 of the
+# GNU Lesser General Public License or version 2 of the
+# GNU General Public 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 or the GNU Lesser General Public License
+# for more details.
+#
+# You should have received a copy of either the GNU General Public
+# License or the GNU Lesser General Public License along with this
+# program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+use strict;
+use IO::File;
+use File::Copy;
+use File::Path;
+use File::Basename;
+use Getopt::Long;
+
+# Verbosity level: 0 = quiet, 1 = notice, 2 = verbose, 3 = debug.
+my $verbosity = 1;
+
+sub usage()
+{
+ print <<EOF;
+Usage: relocate_xtc_repos.pl [OPTIONS] <prefix> <XTC>
+Make Stratego XTC repositories relocatable.
+
+Options:
+ -h, --help: This message.
+ -q, --quiet: Don't print informational messages on stderr.
+ -v, --verbose: Be more verbose. Pass it more than once to increase
+ verbosity level.
+
+Copyright (C) 2007 Benoit Sigoure.
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+EOF
+ exit 0;
+}
+
+usage if $#ARGV != 1;
+
+my $prefix = $ARGV[0];
+
+# Prototypes.
+sub copy_from_nix($$);
+sub make_xtc_repos_relocatable($);
+
+# ------------ #
+# Helper subs. #
+# ------------ #
+
+sub notice($)
+{
+ print STDERR shift if $verbosity >= 1;
+}
+
+sub verbose($)
+{
+ print STDERR shift if $verbosity >= 2;
+}
+
+sub debug($)
+{
+ print STDERR shift if $verbosity >= 3;
+}
+
+sub copy_from_nix($$)
+{
+ my ($from, $to) = @_;
+ my $dir = dirname ($to . $from);
+
+ verbose "Copying '$from' to '$to'\n";
+
+ verbose "Skipping '$from' (No such file).\n" if ! -f $from;
+ return 0 if ! -f $from;
+
+ mkpath $dir
+ or die "Failed to create directory tree '" . $dir . "':
$!"
+ unless -d $dir;
+
+ copy $from, $to . $from or die "Failed to copy '$from' to
'$to$from': $!";
+ return 1;
+}
+
+sub make_xtc_repos_relocatable($)
+{
+ local $_;
+ # Path to the XTC repos we're working on.
+ my $xtc = shift;
+ # XTC repos imported by $xtc. We'll deal with then once we're finished with
+ # $xtc.
+ my @xtc_repositories_imported;
+
+ notice "Relocating $xtc\n";
+
+ # Pretty-print the XTC repository in full text ATerm.
+ move $xtc, "$xtc.bin" or die "Could not rename $xtc: $!";
+ print `pp-aterm -i '$xtc.bin' -o '$xtc'`;
+ die "pp-aterm failed and returned " . ($? >> 8) if $? >> 8 != 0;
+
+ my $in = new IO::File($xtc)
+ or die "Failed to open $xtc for reading: $!";
+ my $out = new IO::File(">$xtc.tmp")
+ or die "Failed to open $xtc.tmp for writting: $!";
+
+ while ($_ = $in->getline())
+ {
+ debug "Examinating $_";
+ s{$prefix}{\@prefix@}o;
+ copy_from_nix $1, '_inst/share' if
m{\((?:Tool|Import)\(.*?"(/nix/[^"]+)"};
+ push(@xtc_repositories_imported, "_inst/share$1")
+ if /\(Import\(\), \["([^"]+)"\]\)/;
+ s{"/nix}{"\@prefix@/share/nix};
+ $out->print($_);
+ }
+
+ $in->close() or die "Failed to close $xtc: $!";
+ move "$xtc.tmp", $xtc or die "Could not overwrite $xtc: $!";
+ notice "Relocated $xtc\n";
+
+ # Now make the XTC repos imported by $xtc relocatable.
+ map { make_xtc_repos_relocatable $_ } @xtc_repositories_imported;
+}
+
+# ----- #
+# Main. #
+# ----- #
+
+Getopt::Long::config ("bundling", "pass_through");
+Getopt::Long::GetOptions
+(
+ 'h|help' => sub { usage },
+ 'q|quiet' => sub { $verbosity = 0 },
+ 'v|verbose' => sub { ++$verbosity; },
+) or die;
+
+foreach my $arg (@ARGV)
+{
+ if ($arg =~ /^-./)
+ {
+ print STDERR "$0: unrecognized option `$arg'\n";
+ print STDERR "Try `$0 --help' for more information.\n";
+ exit 1;
+ }
+}
+
+make_xtc_repos_relocatable $ARGV[1];
Property changes on: relocate_xtc_repos.pl
___________________________________________________________________
Name: svn:executable
+ *
--
SIGOURE Benoit aka Tsuna (SUSv3 compliant)
_____ "On a long enough timeline, the survival rate
/EPITA\ Promo 2008.CSI/ACU/YAKA for everyone drops to zero" -- Jack.