1#!/usr/local/bin/perl
2# create-module.pl
3# Creates a single .wbm file containing multiple modules, possibly with
4# forced versions
5
6@ARGV >= 2 || die "usage: create-module.pl [--dir name] <file.wbm> <module>[/version] ..";
7
8my $pwd;
9chop($pwd = `pwd`);
10
11# Parse command-line options
12my @exclude;
13while(@ARGV) {
14	if ($ARGV[0] eq "--dir") {
15		shift(@ARGV);
16		$forcedir = shift(@ARGV);
17		}
18	elsif ($ARGV[0] eq "--sign") {
19		shift(@ARGV);
20		$createsig = 1;
21		}
22	elsif ($ARGV[0] eq "--exclude") {
23		shift(@ARGV);
24		push(@exclude, shift(@ARGV));
25		}
26	else {
27		last;
28		}
29	}
30
31my $file = shift(@ARGV);
32if ($file !~ /^\//) {
33	$file = "$pwd/$file";
34	}
35unlink($file);
36foreach my $m (@ARGV) {
37	# Parse module and forced version
38	$m =~ s/\/$//;
39	if ($m =~ /^(.*)\/(.*)$/) {
40		$mod = $1;
41		$ver = $2;
42		}
43	else {
44		$mod = $m;
45		$ver = undef;
46		}
47
48	# Copy module to temp dir
49	system("rm -rf /tmp/create-module");
50	mkdir("/tmp/create-module", 0755);
51	$subdir = $forcedir || $mod;
52	$copydir = "/tmp/create-module/$subdir";
53	system("rm -rf $copydir");
54	system("cp -r -L $mod $copydir 2>/dev/null || cp -R -L $mod $copydir");
55	foreach my $e (@exclude) {
56		system("find $copydir -name ".quotemeta($e)." | xargs rm -rf");
57		}
58
59	# Find type from .info file
60	undef(%minfo);
61	if (&read_file($ifile = "$copydir/module.info", \%minfo)) {
62		$type = 0;
63		}
64	elsif (&read_file($ifile = "$copydir/theme.info", \%minfo)) {
65		$type = 1;
66		}
67	else {
68		die "Module or theme $mod not found";
69		}
70	if ($ver) {
71		$minfo{'version'} = $ver;
72		&write_file($ifile, \%minfo);
73		}
74	$flags = !-r $file ? "chf" : "rhf";
75	system("cd /tmp/create-module && find . -name .svn | xargs rm -rf");
76	system("cd /tmp/create-module && find . -name .git | xargs rm -rf");
77	system("cd /tmp/create-module && find . -name .build | xargs rm -rf");
78	system("cd /tmp/create-module && find . -name .pyc | xargs rm -rf");
79	system("cd /tmp/create-module && find . -name \\*.svn-work | xargs rm -rf");
80	system("cd /tmp/create-module && find . -name \\*.svn-base | xargs rm -rf");
81	system("cd /tmp/create-module && find . -name '*~' -o -name '*.rej' -o -name '*.orig' -o -name '.*.swp' | xargs rm -rf");
82	system("cd /tmp/create-module && find . -name RELEASE -o -name RELEASE.sh | xargs rm -rf");
83	system("cd /tmp/create-module && find . -name linux.sh -o -name freebsd.sh -o -name LICENCE -o -name README.md -o -name distrib | xargs rm -rf");
84	system("cd /tmp/create-module && find . -name 'makemodule*.pl' | xargs rm -rf");
85	if (-r "/tmp/create-module/$subdir/EXCLUDE") {
86		system("cd /tmp/create-module/$subdir && cat EXCLUDE | xargs rm -rf");
87		unlink("/tmp/create-module/$subdir/EXCLUDE");
88		}
89	unlink("/tmp/create-module/$subdir/IDEAS");
90	system("cd /tmp/create-module && find . -name \\*.cgi | xargs chmod +x");
91	system("cd /tmp/create-module && find . -name \\*.pl | xargs chmod +x");
92	system("cd /tmp/create-module && tar $flags $file $subdir") && die "Failed to create tar file";
93	}
94if ($file =~ /^(.*)\.gz$/i) {
95	system("mv $file $1");
96	system("gzip -c $1 >$file");
97	unlink("$1");
98	}
99if ($createsig) {
100	system("rm -f $file-sig.asc");
101	system("gpg --armor --output $file-sig.asc --detach-sig $file");
102	}
103
104# read_file(file, &assoc, [&order], [lowercase])
105# Fill an associative array with name=value pairs from a file
106sub read_file
107{
108open(ARFILE, "<".$_[0]) || return 0;
109while(<ARFILE>) {
110	s/\r|\n//g;
111        if (!/^#/ && /^([^=]*)=(.*)$/) {
112		$_[1]->{$_[3] ? lc($1) : $1} = $2;
113		push(@{$_[2]}, $1) if ($_[2]);
114        	}
115        }
116close(ARFILE);
117return 1;
118}
119
120# write_file(file, array)
121# Write out the contents of an associative array as name=value lines
122sub write_file
123{
124local(%old, @order);
125&read_file($_[0], \%old, \@order);
126open(ARFILE, ">".$_[0]);
127foreach $k (@order) {
128        print ARFILE $k,"=",$_[1]->{$k},"\n" if (exists($_[1]->{$k}));
129	}
130foreach $k (keys %{$_[1]}) {
131        print ARFILE $k,"=",$_[1]->{$k},"\n" if (!exists($old{$k}));
132        }
133close(ARFILE);
134}
135