Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 596 lines (474 sloc) 12.3 KB
#!/usr/bin/env perl
use strict;
use warnings;
use Pegex::Parser;
use lib 'lib';
use OpsBoy::Grammar;
use Getopt::Std;
use Data::Dumper;
use File::Copy;
my %opts;
getopts("co:", \%opts) or
die "Usage: $0 [-c] [-o <outfile>] <infile>\n";
my $compile_only = $opts{c};
my $outfile = $opts{o} || "a.pl";
{
package OpsBoy::AST;
use base 'Pegex::Tree';
#use Data::Dumper;
sub got_assignment {
my ($self, $list) = @_;
+{ $list->[0] => $list->[1] }
}
sub got_block {
my ($self, $list) = @_;
$list->[0]; # rule*
}
sub got_single_quoted_string {
my ($self, $list) = @_;
eval $list;
}
}
my $infile = shift or
die "No input file specified.\n";
open my $in, $infile or
die "Cannot open $infile for reading: $!\n";
my $src = do { local $/; <$in> };
my $ast =
Pegex::Parser->new(
grammar => OpsBoy::Grammar->new,
receiver => OpsBoy::AST->new,
)->parse($src);
#print "AST: ", Dumper($ast);
my $default_goal;
my %entities;
my %vars;
#my $i = 0;
for my $target (@$ast) {
#warn "$i: ref: ", ref($target);
#$i++;
if (!ref $target) {
die "Unknown target: $target";
}
if (ref $target eq 'HASH') {
# variable assignment
while (my ($name, $val) = each %$target) {
#warn "$name = $val\n";
$vars{$name} = $val;
}
next;
}
my ($name, $rules) = @$target;
if (!$default_goal) {
$default_goal = $name;
}
#warn "target: $name\n";
if ($entities{$name}) {
die "target \"$name\" redefined.\n";
}
my %rules;
$entities{$name} = \%rules;
for my $rule (@$rules) {
my ($cmd, $args) = @$rule;
if ($rules{$cmd}) {
push @{ $rules{$cmd} }, @$args;
} else {
$rules{$cmd} = $args;
}
}
my $deps = $rules{dep};
my $gits = $rules{git};
if ($gits) {
if (!$deps) {
$rules{dep} = ['git'];
} else {
unshift @$deps, 'git';
}
}
my $cpans = $rules{cpan};
if ($cpans) {
if (!$deps) {
$rules{dep} = ['cpan'];
} else {
unshift @$deps, 'cpan';
}
}
}
for my $name (keys %entities) {
my $rules = $entities{$name};
my $deps = $rules->{dep};
if ($deps) {
for my $dep (@$deps) {
if (!$entities{$dep}) {
die "Entity $dep is required by $name but is not defined.\n";
}
}
}
}
if (!defined $default_goal) {
die "No targets defined.\n";
}
#warn "default goal: $default_goal\n";
open my $out, ">$outfile" or
die "Cannot open $outfile for writing: $!\n";
my $data = \*DATA;
while (<$data>) {
print $out $_;
}
print $out "\$default_goal = '$default_goal';\n\n";
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
print $out Data::Dumper->Dump([\%vars], ['vars']);
print $out "\n";
print $out Data::Dumper->Dump([\%entities], ['entities']);
print $out "\nmain();\n";
close $out;
chmod 0755, $outfile or
die "failed to chmod 0755 $outfile: $!\n";
__DATA__
#!/usr/bin/env perl
use 5.006001;
use strict;
use warnings;
use File::Spec;
my ($default_goal, $entities, $vars);
my ($check_only, $git_pull);
my (%made, %making);
sub make ($$);
sub check_dir ($);
sub main ();
sub can_run ($);
sub sh (@);
my $freebsd;
if ($^O eq'freebsd') {
$freebsd = 1;
}
my $osx;
if ($^O eq 'darwin') {
$osx = 1;
}
my $use_dnf;
if (can_run("dnf")) {
$use_dnf = 1;
}
my $use_yum;
if (can_run("yum")) {
$use_yum = 1;
}
sub make ($$) {
my ($target, $parent) = @_;
if ($made{$target}) {
return;
}
if ($making{$target}) {
die "Circular dependency found through ", $parent || "ROOT", " -> $target\n";
}
$making{$target} = 1;
my $rules = $entities->{$target};
if (!$rules) {
die "target \"$target\" not defined.\n";
}
my $deps = $rules->{dep};
my $gits = $rules->{git};
if ($gits) {
if (!$deps) {
$rules->{dep} = ['git'];
} else {
unshift @$deps, 'git';
}
}
my $fetches = $rules->{fetch};
if (defined $fetches) {
if (!$deps) {
$rules->{dep} = ['wget'];
} else {
unshift @$deps, 'wget';
}
}
my $pkgs = $rules->{debuginfo};
if ($pkgs) {
if (!$deps) {
$rules->{dep} = ['yum-utils'];
} else {
unshift @$deps, 'yum-utils';
}
}
my $tarball = $rules->{tarball};
if ($tarball) {
if (!$deps) {
$rules->{dep} = ['tar'];
} else {
unshift @$deps, 'tar';
}
}
if ($deps) {
for my $dep (@$deps) {
make($dep, $target);
}
}
warn "making $target ...\n";
my $envs = $rules->{env};
if (defined $envs) {
my @vals = @$envs;
while (@vals) {
my $name = shift @vals;
if (!defined $name) {
die "Undefined environment name.\n";
}
my $value = shift @vals;
if (!defined $value) {
die "Environment $name does not take a value.\n";
}
$value =~ s/\$(\w+)/defined $ENV{$1} ? $ENV{$1} : ''/ge;
$value =~ s/^~/$ENV{HOME}/;
#warn "Setting $name to $value\n";
$value =~ s/`(.*?)`/my $s = `$1`; chomp $s; $s/ge;
$ENV{$name} = $value;
}
}
if ($gits) {
if (@$gits % 2 != 0) {
die "Bad number of arguments to the \"git\" command: ",
scalar(@$gits);
}
my @args = @$gits;
while (@args) {
my $url = shift @args;
my $dir = shift @args;
$dir =~ s/^~/$ENV{HOME}/;
my $parent;
if ($dir =~ m{(.+/)[^/]+$}) {
$parent = $1;
if (!-d $parent) {
sh("mkdir", "-p", $parent);
}
}
if (!good_git_repos($dir)) {
if (-d $dir) {
system("mv $dir $dir.bak");
}
sh("git", "clone", $url, $dir);
} else {
if ($git_pull) {
sh("cd $dir && git reset --hard && git checkout master && git pull");
}
}
}
}
my $requires_making;
my $progs = $rules->{prog};
if ($progs) {
for my $prog (@$progs) {
if (!can_run($prog)) {
warn "program $prog missing.\n";
$requires_making = 1;
last;
}
}
}
my $tests = $rules->{test};
if ($tests) {
#warn "Found tests!";
for my $test (@$tests) {
#warn "running command $test";
if (system($test) != 0) {
warn "shell test failed: $test\n";
$requires_making = 1;
last;
}
}
}
my $runnings = $rules->{running};
if ($runnings) {
for my $running (@$runnings) {
if (system("ps aux|grep '$running'|grep -v grep") != 0) {
warn "process matching '$running' not found.\n";
$requires_making = 1;
last;
}
}
}
my $files = $rules->{file};
if ($files) {
for my $file (@$files) {
$file =~ s/^~/$ENV{HOME}/;
$file =~ s/\$(\w+)/defined $ENV{$1} ? $ENV{$1} : ''/eg;
if (!-e $file) {
$requires_making = 1;
last;
}
}
}
if ($rules->{always}) {
$requires_making = 1;
}
if ($requires_making) {
my $pkgs = $rules->{yum};
if ($pkgs) {
for my $pkg (@$pkgs) {
if ($freebsd) {
sh("sudo pkg_add -r $pkg");
} elsif ($osx) {
sh("brew install $pkg");
} elsif ($use_dnf) {
sh("sudo dnf install $pkg -y");
} elsif ($use_yum) {
sh("sudo yum install $pkg -y");
} else {
sh("unsupported OS for package installation");
}
}
}
$pkgs = $rules->{debuginfo};
if ($pkgs) {
for my $pkg (@$pkgs) {
if ($use_dnf) {
sh("sudo dnf debuginfo-install $pkg -y");
} elsif ($use_yum) {
sh("sudo debuginfo-install $pkg -y");
} else {
sh("unsupported OS for debuginfo package installation");
}
}
}
my $cpans = $rules->{cpan};
if ($cpans) {
for my $cpan (@$cpans) {
sh("sudo", "cpan", $cpan);
}
}
my $cwds = $rules->{cwd};
if (defined $cwds) {
for my $cwd (@$cwds) {
$cwd =~ s/^~/$ENV{HOME}/;
if (!-d $cwd) {
system("mkdir -p $cwd") == 0 or die "Cannot mkdir $cwd\n";
}
print "cd $cwd\n";
chdir $cwd or die "Cannot cd to $cwd\n";
}
}
my $fetches = $rules->{fetch};
if (defined $fetches) {
for my $fetch (@$fetches) {
$fetch =~ s/\$(\w+)/$ENV{$1}/g;
sh('wget', '-N', $fetch);
}
}
my $tarballs = $rules->{tarball};
if (defined $tarballs) {
for my $tarball (@$tarballs) {
$tarball =~ s/\$(\w+)/$ENV{$1}/g;
if ($osx) {
sh('tar', '-jxvf', $tarball);
} else {
sh('tar', '-xvf', $tarball);
}
}
}
my $cmds = $rules->{sh};
if ($cmds) {
for my $cmd (@$cmds) {
$cmd =~ s/\$(\w+)/defined $ENV{$1} ? $ENV{$1} : ''/ge;
#warn "CMD: [$cmd]";
sh($cmd);
}
}
}
$made{$target} = 1;
delete $making{$target};
}
sub sh (@) {
print "@_\n";
if (!$check_only) {
if (system(@_) != 0) {
die "failed to run command: $?\n";
}
}
}
sub good_git_repos ($) {
my $dir = shift;
if (-d $dir && -d "$dir/.git"
&& -d "$dir/.git/refs" && -d "$dir/.git/objects") {
#print "good git repos $dir.\n";
return 1;
}
return undef;
}
sub check_dir ($) {
my $dir = shift;
$dir =~ s/^~/$ENV{HOME}/;
if (-d $dir) {
print "Directory $dir exists.\n";
} else {
print "Directory $dir NOT exists.\n";
}
}
sub main () {
my $cmd = shift @ARGV or
die "No command specified.\n";
while (my ($var, $val) = each %$vars) {
$ENV{$var} = $val;
}
if ($cmd eq 'check') {
$check_only = 1;
} elsif ($cmd eq 'make') {
undef $check_only;
} else {
die "unknown command: $cmd\n";
}
my ($keep_going, @goals);
if (@ARGV) {
for my $arg (@ARGV) {
if ($arg =~ /^([A-Za-z][-\w]*)=(.*)/) {
$ENV{$1} = $2;
next;
}
if ($arg =~ /^-/) {
if ($arg eq '--git-pull') {
$git_pull = 1;
} elsif ($arg eq '-k') {
$keep_going = 1;
} else {
die "unknown option: $arg\n";
}
next;
}
push @goals, $arg;
}
}
if (!@goals) {
push @goals, $default_goal;
}
my $begin = time();
for my $goal (@goals) {
if ($keep_going) {
eval {
make($goal, undef);
};
if ($@) {
warn $@;
}
} else {
make($goal, undef);
}
}
my $elapsed = time() - $begin;
warn "For total $elapsed sec elapsed.\n";
}
# check if we can run some command
sub can_run ($) {
my ($cmd) = @_;
#warn "can run: @_\n";
my $_cmd = $cmd;
return $_cmd if -x $_cmd;
return undef if $_cmd =~ m{[\\/]};
# FIXME: this is a hack; MSWin32 is not supported anyway
my $path_sep = ':';
for my $dir ((split /$path_sep/, $ENV{PATH}), '.') {
next if $dir eq '';
my $abs = File::Spec->catfile($dir, $_[0]);
return $abs if -x $abs;
}
return undef;
}