emailrelay/bin/fragment.pl_

#!/usr/bin/perl
#
# Copyright (C) 2001-2008 Graeme Walker <graeme_walker@users.sourceforge.net>
# 
# 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/>.
# ===
#
# fragment.pl
#
# Splits a source file into small fragments so that
# they can be compiled separately. 
#
# Starts a fragment at the start of a namespace or 
# a method. Ends a fragment at a blank line following 
# a closing brace in column one. If there is a comment
# "//pragma fragments" in the source file then it marks
# the end of the common, unfragmented code (eg. local 
# declarations).
#
# usage: fragment.sh [-r] <dir-in> <dir-out>
#
# Pokes inside "Makefile.am" files to get a lists of files.
#
# Logs all created files on stdout, suitable for backticks.
#

use strict ;
use FileHandle ;

sub makefile_variable
{
	return "FRAGMENTS_EXTRA_DIST" ;
}

sub debug
{
	# print @_ , "\n" ;
}

sub file_list_from_makefile
{
	my ( $dir_in ) = @_ ;
	my $path = "$dir_in/Makefile.am" ;
	debug( "makefile: $path" ) ;
	my $f = new FileHandle( $path ) or return () ;
	my %full_hash = () ;
	while( <$f> )
	{
		my $line = $_ ;
		chomp $line ;
		my $v = makefile_variable() ;
		if( $line =~ m/^$v/ )
		{
			$line =~ s/$v[[:space:]]*=[[:space:]]*// ;
			my @list = split( '\s+' , $line ) ;
			for my $l ( @list ) { $full_hash{$l} = 1 }
		}
	}
	debug( "makefile: $path: [".join("][",keys %full_hash)."]" ) ;
	return keys %full_hash ;
}

sub sub_directory_list
{
	my ( $base ) = @_ ;
	opendir( DIR , $base ) or return () ;
	my @list = grep { !m/^\./ && -d "$base/$_" } readdir(DIR) ;
	closedir( DIR ) ;
	debug( "sub_directory_list: [".join("][",@list)."]" ) ;
	return @list ;
}

sub basename
{
	my ( $path ) = @_ ;
	$path =~ s:.*/:: ;
	return $path ;
}

sub dirname
{
	my ( $path ) = @_ ;
	$path =~ s:/[^/]*$:: ;
	return $path eq "" ? "." : $path ;
}

sub noextension
{
	my ( $name ) = @_ ;
	$name =~ s/\.[a-z]*$// ;
	return $name ;
}

sub name_to_show
{
	my ( $path ) = @_ ;
	$path =~ s/.cpp$/.o/ ;
	return basename($path) ;
}

sub mkdir_for
{
	my ( $path_out ) = @_ ;
	my $dir_out = dirname( $path_out ) ;
	if( ! -d $dir_out )
	{
		debug( "mkdir [$dir_out]" ) ;
		mkdir($dir_out) or die basename($0).": cannot create directory [$dir_out] ($!)" ;
	}
}

sub print_banner
{
	my ( $output , $file_in , $file_out ) = @_ ;
	my $me = basename($0) ;
	my $filename_out = basename( $file_out ) ;
	my $filename_in = basename( $file_in ) ;
	print $output "//\n" ;
	print $output "// $filename_out -- autogenerated from $filename_in by $me\n" ;
	print $output "//\n" ;
	print $output "\n" ;
}

sub print_header
{
	my ( $output , $head_ref ) = @_ ;
	for my $h ( @$head_ref )
	{
		print $output $h , "\n" ;
	}
}

my $n_ = 0 ;
sub first_file_out
{
	$n_ = 0 ;
}
sub next_file_out
{
	my ( $file_in , $dir_out ) = @_ ;

	my $name = noextension(basename($file_in)) ;
	my $file_out = "$dir_out/$name.$n_.cpp" ;
	$n_++ ;
	debug( "next: [$file_in] [$dir_out] [$file_out]" ) ;
	return $file_out ;
}

sub is_pragma
{
	my ( $line ) = @_ ;
	return $line =~ m:^ *//pragma *fragments: ;
}

sub has_pragma
{
	my ( $file_in ) = @_ ;
	my $input = new FileHandle( $file_in , "<" ) ;
	while( <$input> ) { return 1 if is_pragma($_) }
	return 0 ;
}

sub fragment
{
	my ( $file_in , $dir_out ) = @_ ;

	my $has_pragma = has_pragma( $file_in ) ;
	my $input = new FileHandle( $file_in , "<" ) or die basename($0).": cannot open input file [$file_in]" ;
	my $output = undef ;
	my @head = () ;
	my $state = 0 ;
	my $previous_line = "" ;
	my $was_brace = 0 ;
	my $was_hash_if = 0 ;
	my $seen_pragma = 0 ;
	my @file_list = () ;
	first_file_out() ;
	while( <$input> )
	{
		my $line = $_ ;
		chomp $line ;

		my $is_pragma = is_pragma($line) ;
		my $is_namespace = $line =~ m/^namespace/ ;
		my $is_method = $line =~ m/^[^[:space:]].*::.*\(/ ;
		my $is_blank = $line =~ m/^[[:space:]]*$/ ;
		my $is_brace = $line =~ m/^}/ ;
		my $is_hash_if = $line =~ m/^#if/ ;

		if( ( $state == 0 || $state == 2 ) && ( ($seen_pragma || !$has_pragma) && ( $is_namespace || $is_method ) ) )
		{
			$state = 1 ;
			my $file_out = next_file_out( $file_in , $dir_out ) ;
			mkdir_for( $file_out ) ;
			$output = new FileHandle( $file_out , ">" ) or die basename($0).": cannot create output file [$file_out]" ;
			push @file_list , name_to_show($file_out) ;
			print_banner( $output , $file_in , $file_out ) ;
			print_header( $output , \@head ) ;
			if( $was_hash_if ) { print $output $previous_line , "\n" }
			print $output $line , "\n" ;
		}
		elsif( $state == 1 && $was_brace && $is_blank )
		{
			$state = 2 ;
		}
		elsif( $state == 1 )
		{
			print $output $line , "\n" ;
		}
		elsif( $state == 0 )
		{
			push @head , $line unless $is_pragma ;
		}
		$was_brace = $is_brace ;
		$was_hash_if = $is_hash_if ;
		$seen_pragma = $seen_pragma || $is_pragma ;
		$previous_line = $line ;
	}
	close $input or die ;
	if( defined($output) ) { close $output or die basename($0).": cannot close output file" }
	return @file_list ;
}

sub main
{
	my $recursive = scalar(@ARGV) && $ARGV[0] eq "-r" ;
	shift @ARGV if $recursive ;

	my $dir_in = shift @ARGV ;
	if( ! -d $dir_in )
	{
		die basename($0) . ": not a valid directory [$dir_in]" ;
	}

	my $dir_out = shift @ARGV ;
	if( ! -d $dir_out )
	{
		die basename($0) . ": not a valid directory [$dir_out]" ;
	}

	my @list_out = () ;
	my @dir_list_in = ( "." ) ;
	push @dir_list_in , sub_directory_list($dir_in) if $recursive ;

	for my $subdir ( @dir_list_in )
	{
		my $dir_in = "$dir_in/$subdir" ;
		my @list_in = file_list_from_makefile( $dir_in ) ;
		for my $file_in ( @list_in )
		{
			my $path_in = $dir_in . "/" . $file_in ;
			push @list_out , fragment( $path_in , $dir_out ) ;
		}
	}
	print join(" ",@list_out) , "\n" ;
}

main() ;