scripts/compile_commands.pl

@@ -0,0 +1,101 @@
+#!/usr/bin/env perl
+
+my $usage = <<USAGE;
+Usage:  $0 [-m MASK]
+
+Options:
+    -m MASK  Generate compile_commands JSON with platform mask MASK.
+USAGE
+
+use FindBin '$RealBin';
+
+use lib "$RealBin/../tools/perl";
+
+use Compile::Driver;
+use Compile::Driver::Catalog;
+use Compile::Driver::Configuration;
+use Compile::Driver::Options;
+
+use warnings FATAL => 'all';
+use strict;
+
+use Getopt::Std;
+use JSON::XS;
+
+sub HELP_MESSAGE {
+  my $stat = shift;
+
+  print $usage;
+
+  exit ($stat eq 1 ? 1 : 0);
+}
+
+my @db;
+my %opts;
+if (not getopts('hm:', \%opts)) {
+    HELP_MESSAGE(1);
+}
+
+my $mask;
+Compile::Driver::Options::set_options( ( "-S" ) );
+my $config = Compile::Driver::Configuration::->new(
+    Compile::Driver::Options::specs
+);
+my %catalog = %{ Compile::Driver::Catalog::catalog() };
+
+if (exists $opts{h}) {
+    HELP_MESSAGE(0);
+}
+
+if (exists $opts{m}) {
+    $mask = $opts{m};
+} else {
+    $mask = $config->platform_mask;
+}
+
+sub get_module {
+    my ( $name ) = @_;
+
+    my $desc = Compile::Driver::Catalog::find_project( $name, $mask );
+
+    if ( !$desc ) {
+        $desc = { NAME => $name, MEMO => { PREREQS => [] } };
+    }
+
+    return Compile::Driver::Module::->new( $config, $desc );
+}
+
+sub get_job {
+    my ( $job ) = @_;
+
+    return if !$job->is_buildable;
+}
+
+sub process_jobs {
+    my ( @jobs ) = @_;
+
+    my $job;
+    for $job (@jobs) {
+        if ( $job->{TYPE} eq 'CC' ) {
+            ;
+
+            my $entry = {
+                          directory => $job->{FROM}->tree,
+                          command   => join( " ", $job->command ),
+                          file      => $job->input_files
+                        };
+
+            push @db, $entry;
+        }
+    }
+}
+
+my $name;
+for $name (keys %catalog) {
+    my $module = get_module($name);
+
+    my @jobs = Compile::Driver::jobs_for($module);
+
+    process_jobs(@jobs);
+}
+print JSON::XS::encode_json \@db;

tools/perl/Compile/Driver/Catalog.pm

@@ -1,7 +1,5 @@
 package Compile::Driver::Catalog;
 
-use FindBin '$RealBin';
-
 use Compile::Driver::Files;
 use Compile::Driver::InputFile::Catalog;
 use Compile::Driver::InputFile::Description;
@@ -20,8 +18,11 @@ use strict;
 
 my $subpath = "var/cache/compile-driver";
 
-# Assume we're called from the repo's top level
-my $File = "$RealBin/$subpath/catalog";
+my $gitroot = `git rev-parse --show-toplevel`;
+
+chomp $gitroot;
+
+my $File = "$gitroot/$subpath/catalog";
 
 my %Catalog;
 
@@ -37,6 +38,11 @@ else
 }
 
 
+sub catalog
+{
+	return \%Catalog;
+}
+
 sub add_project_description
 {
 	my ( $dir, $path ) = @_;
@@ -45,7 +51,7 @@ sub add_project_description
 
 	my $data = read_description_file( $path );
 
-	my $prefix = $RealBin . "/";
+	my $prefix = $gitroot . "/";
 
 	if ( substr( $path, 0, length $prefix ) eq $prefix )
 	{
@@ -115,7 +121,7 @@ sub scan_for_project_descriptions
 
 sub create_catalog_file
 {
-	my $root = $RealBin;
+	my $root = $gitroot;
 
 	scan_for_project_descriptions( $root );
 
@@ -157,7 +163,7 @@ sub find_project
 
 		if ( $path !~ m{^ / }x )
 		{
-			$path = "$RealBin/$path";
+			$path = "$gitroot/$path";
 		}
 
 		$entry->{DATA} = read_description_file( $path );

tools/perl/Compile/Driver/Configuration.pm

@@ -151,7 +151,7 @@ sub get_module
 
 	if ( !$desc )
 	{
-		if ( $optional )
+		if ( $optional or Compile::Driver::Options::stupid() )
 		{
 			$desc = { NAME => $name, MEMO => { PREREQS => [] } };
 		}

tools/perl/Compile/Driver/Module.pm

@@ -2,6 +2,7 @@ package Compile::Driver::Module;
 
 use Compile::Driver::Files;
 use Compile::Driver::InputFile::SourceList;
+use Compile::Driver::Options;
 
 use warnings FATAL => 'all';
 use strict;
@@ -277,7 +278,10 @@ sub sources_from_list
 	{
 		my $path = "$dir/$subpath";
 
-		die "Can't find $subpath\n"  if !-f $path;
+		unless ( Compile::Driver::Options::stupid() )
+		{
+			die "Can't find $subpath\n"  if !-f $path;
+		}
 
 		$subpath = $path;
 	}

tools/perl/Compile/Driver/Options.pm

@@ -7,6 +7,7 @@ my %Flag_for_option = qw
 (
 	v verbose
 	i install
+	S stupid
 );
 
 my %Spec_for_option = qw
@@ -25,6 +26,11 @@ my %Flags;
 my @Specs;
 my $N_jobs;
 
+sub stupid
+{
+	return $Flags{ stupid };
+}
+
 sub verbose
 {
 	return $Flags{ verbose };