--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/admin/subpkg_collector.pl	Mon Mar 26 18:21:13 2012 +0000
@@ -0,0 +1,178 @@
+#!/usr/bin/perl
+## Copyright (C) 2012 Carnë Draug <carandraug+dev@gmail.com>
+##
+## 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 3 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, see <http://www.gnu.org/licenses/>.
+
+use 5.010;                      # Use Perl 5.10
+use strict;                     # Enforce some good programming rules
+use warnings;                   # Replacement for the -w flag, but lexically scoped
+use File::Spec;                 # Portably perform operations on file names
+use File::Find;                 # Load functions to traverse a directory tree
+use File::Copy;
+
+## This function takes the path for the root of a package as argument and creates
+## a directory tree ready to be packaged on the current working directory.
+##
+## It expects the following:
+##
+##  -root--->deprecated---> .m files
+##        |
+##        |-> inst-------->subpkg1--->src---------> .cc/.h/Makefile files
+##        |           |            |
+##        |           |            |->deprecated--> .m files
+##        |           |            |
+##        |           |            |->private-----> .m files
+##        |           |            |
+##        |           |            -> .m files
+##        |           |
+##        |           |--->subpkg2--->same structure as subpkg1
+##        |           |--->subpkg3--->same structure as subpkg1
+##        |          ...
+##        |           |--->subpkgn
+##        |
+##        |-> src
+##
+##   * it will mix all Makefile it finds and merge them into a $root/src/Makefile.
+##      This file should then be adjusted by the package mantainer. A Makefile
+##      can already exist at $root/src and the others will be appended. If the
+##      Makefiles are written with this on mind, it can save having to fix it
+##
+##   * if the deprecated/src/private directories are empty at the end, the script
+##      removes them
+##
+##   * it's possible that $root/inst/private directory already exists inside
+##      inst/, as well as some .m files inside inst/ and .cc files inside src/
+
+my $dev   = $ARGV[0];
+my $root  = get_export_dir ($dev);
+
+my @command = ("svn", "export", $dev, $root);
+system(@command) == 0 or die "system @command failed: $?";
+
+find(\&rm_svnignore, $root);   # a little cleaning up
+
+my $inst        = File::Spec->catdir($root, "inst");
+my $deprecated  = File::Spec->catdir($root, "deprecated");
+my $src         = File::Spec->catdir($root, "src");
+my $private     = File::Spec->catdir($inst, "private");
+
+## create them if they don't exist
+-e $_ || mkdir $_ for ($inst, $deprecated, $src, $private);
+
+opendir(my $INST, $inst) or die "Can't opendir $inst: $!";
+while (my $subpkg = readdir($INST)) {
+  next if $subpkg =~ /^\.\.?$/;
+  next if $subpkg =~ /^private$/;
+
+  my $subpkg_path = File::Spec->catdir($inst, $subpkg);
+  opendir(my $SUBPKG, $subpkg_path) or die "Can't opendir $subpkg_path: $!";
+  while (my $file = readdir($SUBPKG)) {
+    next if $file =~ /^\.\.?$/;
+
+    my $old = File::Spec->catdir($inst, $subpkg, $file);
+    my $new;
+    if ($file =~ /^deprecated$/) {
+      $new = File::Spec->catdir($deprecated);
+    } elsif ($file =~ /^private$/) {
+      copy_private ($old, $private);
+      next;
+    } elsif ($file =~ /^src$/) {
+      my @makefile = copy_src ($old, $src);
+      my $makefile = File::Spec->catdir($src, "Makefile");
+      open(my $MAKEFILE, ">>", $makefile) or die "Couldn't open $makefile for reading: $!\n";
+      print {$MAKEFILE} $_ for @makefile;
+      close($MAKEFILE);
+      next;
+    } else {
+      $new = File::Spec->catdir($inst, $file);
+    }
+    move ($old, $new) or warn "Can't move $old to $new: $!";
+  }
+  closedir($SUBPKG);
+  rmdir $subpkg_path or warn "Could not rmdir $subpkg_path: $!";
+}
+closedir($INST);
+
+## if they were not necessary(are still empty, remove them
+rm_if_empty ($_) for ($inst, $deprecated, $src, $private);
+exit;
+
+################################################################################
+## Subroutines from this point on
+
+sub get_export_dir {
+  my @dirs = File::Spec->splitdir($_[0]);
+  pop @dirs if $dirs[-1] eq "";                 # because it will be empty string if given path ended in filesep
+  die "Export path '$dirs[-1]' already exist" if -e $dirs[-1];
+  return $dirs[-1];
+}
+
+sub rm_svnignore {
+  ## $_ is file path relative to pwd (always changing)
+  ## $path is relative to working directory where script started
+  my $path = $File::Find::name;
+  unlink $_ or warn "Could not unlink $path: $!" if $_ =~ m/^\.svnignore$/;
+}
+
+sub copy_private {
+  my ($old_private, $new_private) = @_;
+  opendir(my $PRIVATE, $old_private) or die "Can't opendir $old_private: $!";
+  while (my $file = readdir($PRIVATE)) {
+    next if $file =~ /^\.\.?$/;
+
+    my $old = File::Spec->catdir($old_private, $file);
+    my $new = File::Spec->catdir($new_private, $file);
+    if ($file =~ /^private$/) {
+      copy_private ($old, $new);
+    } else {
+      move ($old, $new) or warn "Can't move $old to $new: $!";
+    }
+  }
+  closedir($PRIVATE);
+  rmdir $old_private or warn "Could not rmdir $old_private: $!";
+}
+
+sub copy_src {
+  my ($old_src, $new_src) = @_;
+  my @makefile;
+  opendir(my $SRC, $old_src) or die "Can't opendir $old_src: $!";
+  while (my $source = readdir($SRC)) {
+    next if $source =~ /^\.\.?$/;
+    if ($source =~ /^Makefile$/) {
+      my $path = File::Spec->catdir($old_src, $source);
+      open(my $MAKEFILE, "<", $path) or die "Couldn't open $path for reading: $!\n";
+      @makefile = <$MAKEFILE>;
+      close($MAKEFILE);
+      unlink $path or warn "Could not unlink $path: $!";
+    } else {
+      my $old = File::Spec->catdir($old_src, $source);
+      my $new = File::Spec->catdir($new_src, $source);
+      move ($old, $new) or warn "Can't move $old to $new: $!";
+    }
+  }
+  closedir($SRC);
+  rmdir $old_src or warn "Could not rmdir $old_src: $!";
+  return @makefile;
+}
+
+sub rm_if_empty {
+  my $counter = 0;
+  opendir(my $DIR, $_[0]) or die "Can't opendir $_[0]: $!";
+  while (my $file = readdir($DIR) && $counter == 0) {
+    next if $file =~ /^\.\.?$/;
+    $counter++;
+  }
+  closedir ($DIR);
+  rmdir $_[0] or warn "Could not rmdir $_[0]: $!" if $counter == 0;
+}