#!/usr/bin/perl -w
use strict;
my $Root;     # root option 
my $Line_dir; # format option
my (@roots, %used, %chunks, $file);
while ($ARGV[0] =~ m/^-/) {
   $_ = shift @ARGV;
   last                          if m/^--$/;
   $Root   = $1                  if m/^-R(.*)/;
   $Line_dir = '#line %L "%F"%N' if m/^-L/;
}
unless (@ARGV) {die "no file given for processing\n"}
$file = $ARGV[0];
open(FILE,$file)||die "can't open $file $!";
while ( <FILE> ) {
    my $line = $_;
    my $line_no = $. + 1;
    if ($line =~ m/^<<([^>]+)>>=\s*$/) {
        my $begin_offset = tell FILE;
        while (($line !~ m/^(\@\s*$|\@\s*\%def)/)) {
           $line = <FILE>;
           $used{$1} += 1 if $line =~ m/^\s*<<([^>]+)>>\s*$/;
        }
        push @{$chunks{$1}}, "$begin_offset:$file:$line_no";
    }
}
if ($Root) {
    @roots = ($Root);
} else {
    foreach my $key (keys %chunks) {
        push @roots, $key if not $used{$key};
    }
}
foreach my $root (@roots) {
    open(PROGRAM, ">$root") || die "can't open $root: $!";
    print_chunk($root,'');
}
close PROGRAM;
sub print_chunk {
    my ($chunk,$whitespace) = @_;
    unless (exists $chunks{$chunk}) {
        warn "undefined chunk name: <<$chunk>>\n";
        return;
    }
    my @locations = @{$chunks{$chunk}};
    foreach my $item (@locations) {
        my ($offset, $filename, $line_number) = split /:/,$item;
        seek(FILE, $offset,0) || die "seek failed on $filename: $!";
        my $line=<FILE>;
        my $shebang_special = 0;
        $shebang_special = 1 if $line =~ m/^#!/;
        my $line_dir;
        if ($Line_dir) {
           $line_dir = make_line_dir($line_number,$filename);
           $line =~ m/^\s*<<.*?>>\s*$/ || 
                    $shebang_special   ||
                    print PROGRAM  "$line_dir";
        }
        while ($line !~ m/^(\@\s*$|\@\s\%def)/) {
            if ($line =~ m/^(\s*?)<<([^>]+)>>\s*$/) {
                my $offset = tell FILE;
                my $addedspace = $1;
                $whitespace = $addedspace.$whitespace;
                &print_chunk($2,$whitespace);
                $whitespace = substr($whitespace,length($addedspace));
                seek(FILE,$offset,0) || die "can't seek on $filename: $!";
                $line_number += 1;
                $line = <FILE>;
                if ($Line_dir) {
                    $line_dir = make_line_dir($line_number,$filename);
                    print PROGRAM $line_dir if $line !~ /^\s*<<.*?>>\s*$/;
                }
            } else {
                print PROGRAM $whitespace,$line;
                $line = <FILE>;
                $line_number += 1;
                if ($Line_dir && $shebang_special) {
                    $line_dir = make_line_dir($line_number,$filename);
                    print PROGRAM "$line_dir" if $line !~ m/^\s*<<[^>]+>>\s*$/;
                    $shebang_special = 0;
                }
            }
        }
    }
}
sub make_line_dir {
    my ($line_no,$file) = @_;
    my $line_dir = $Line_dir;
    $line_dir =~ s/\%L/$line_no/;
    $line_dir =~ s/\%F/$file/;
    $line_dir =~ s/\%\%/%/;
    $line_dir =~ s/\%N/\n/;
    return $line_dir;
}