Source

packaging / dl-rules_hack

Full commit
#!/usr/bin/perl -w
#
# Daybo Logic rules hack script.
# (post-alien processor).
#

use strict;
use Getopt::Std;

use constant OPTS => ('i:o:dh');
use constant EXIT_SUCCESS => (0);
use constant EXIT_INPUT => (1);
use constant EXIT_OUTPUT => (2);
use constant EXIT_SYNTAX_CLI => (3);
use constant EXIT_UNKNOWN => (4);

use constant SCRIPT_VERSION => ('0.0.1');
#----------------------------------------------------------------------------
my $Debug = 0;

sub Main();
sub Syntax($$);
sub CheckOpts($);
sub ReadInput($$);
sub WriteOutput($$);
sub Process($$);
sub Uncomment($$);
#----------------------------------------------------------------------------
sub Main()
{
	my %opts = ( );
	my $ret = EXIT_UNKNOWN();
	return EXIT_SYNTAX_CLI() unless ( getopts(OPTS(), \%opts) );

	if ( $opts{'h'} ) {
		Syntax(1,1);
		return EXIT_SUCCESS();
	}
	if ( CheckOpts(\%opts) ) {
		my @data = ( );
		my $lines = 0;
		return EXIT_INPUT() unless ( $lines = ReadInput(\@data, $opts{'i'}) );
		printf("Processing %u lines\n", $lines) if ( $Debug );
		return $ret unless ( Process(\@data, $lines) );
		return EXIT_OUTPUT() unless ( WriteOutput(\@data, $opts{'o'}) == $lines );
		$ret = EXIT_SUCCESS();
	} else {
		Syntax(0,0);
		$ret = EXIT_SYNTAX_CLI();
	}

	printf(STDERR "%s script exiting with code %u\n", $0, $ret) if ( $Debug );
	return $ret;
}
#----------------------------------------------------------------------------
sub Syntax($$)
{
	my %opt_desc_map = ( # Human-readable
		'o' => 'Output file (stdout will be used if not specified)',
		'i' => 'Input file (stdin will be used if not specified)',
		'h' => 'This help text',
		'd' => 'Enable verbose debug output on stderr'
	);

	my %opt_arg_map = (
		'o' => 'output',
		'i' => 'input'
	);

	my ( $DoBanner, $DoDetail ) = ( @_ );
	if ( $DoBanner ) {
		printf("dl-rules-hack script %s\n", SCRIPT_VERSION());
		print("(c)2010 Daybo Logic, all rights reserved.\n\n");
	}

	my $cli = $0;
	my @allArgs = split(//, OPTS());
	for ( my $i = 0; $i < scalar(@allArgs); $i++ ) {
		my $a = $allArgs[$i];
		next if ( $a eq ':' );
		$cli .= ' -' . $a;
		if ( ($i < scalar(@allArgs)-1) && $allArgs[$i+1] eq ':' ) {
			$cli .= ' <' . $opt_arg_map{$a} . '>';
		}
	}
	print("$cli\n\n");

	return unless ( $DoDetail );
	for ( my $i = 0; $i < scalar(@allArgs); $i++ ) {
		my $a = $allArgs[$i];
		next if ( $a eq ':' );
		printf(
			"-%s %s\n\t%s\n",
			$a,
			(exists($opt_arg_map{$a})) ? ('<' . $opt_arg_map{$a} . '>') : (''),
			$opt_desc_map{$a}
		);
	}
	print("\n");

	return;
}
#----------------------------------------------------------------------------
sub CheckOpts($)
{
	my $ret = 0;
	my $Opts = $_[0];
	return $ret unless ( $Opts );
	foreach my $a ( keys(%$Opts) ) {
		if ( $a eq 'd' ) {
			$Debug = 1;
			print(STDERR "Debugging mode enabled.\n");
		}
	}
	$ret = 1; # It's legal to specify nothing for now.

	printf(STDERR "Debug command line: %s %s\n", $0, join(' ', @ARGV)) if ( $Debug );
	print(STDERR "Command-line error\n") unless ( $ret );
	return $ret;
}
#----------------------------------------------------------------------------
sub ReadInput($$)
{
	my $nextLine;
	my $fileOpen = 0;
	my $inHandle = undef;
	my $readLines = 0;
	my ( $Lines, $InFile ) = ( @_ );
	if ( $InFile ) {
		if ( open(INFILE, '< ' . $InFile) ) {
			$inHandle = *INFILE;
			$fileOpen = 1;
		} else {
			printf(STDERR "Error opening %s - %s\n", $InFile, $!) if ( $Debug );
			return 0;
		}
	} else {
		$inHandle = *STDIN;
	}

	while ( $nextLine = <$inHandle> ) {
		chomp($nextLine);
		push @$Lines, $nextLine;
		$readLines++;
	}

	close($inHandle) if ( $fileOpen );
	return $readLines;
}
#----------------------------------------------------------------------------
sub WriteOutput($$)
{
	my $doneVerbose = 0;
	my $fileOpen = 0;
	my $outHandle = undef;
	my $writtenLines = 0;
	my ( $Lines, $OutFile ) = ( @_ );
	if ( $OutFile ) {
		if ( open(OUTFILE, '> ' . $OutFile) ) {
			$outHandle = *OUTFILE;
			$fileOpen = 1;
		} else {
			printf(STDERR "Error opening %s - %s\n", $OutFile, $!) if ( $Debug );
			return 0;
		}
	} else {
		$outHandle = *STDOUT;
	}

	foreach my $nextLine ( @$Lines ) {
		$nextLine .= "\n";
		if ( print($outHandle $nextLine) ) {
			$writtenLines++;
		} elsif ( $Debug && !$doneVerbose ) {
			printf(STDERR "Error writing output to %s - %s\n", $OutFile, $!);
			$doneVerbose = 1;
		}
	}

	close($outHandle) if ( $fileOpen );
	return $writtenLines;
}
#----------------------------------------------------------------------------
sub Process($$)
{
	my $processedCount = 0;
	my ( $LinesPtr, $LineCount ) = ( @_ );
	die 'Internal error' unless ( $LinesPtr );
	my ( $Real, $Remark ) = ( undef, undef );
	for ( my $linei = 0; $linei < $LineCount; $linei++ ) {
		( $Real, $Remark ) = split('#', $LinesPtr->[$linei]);
		if ( defined($Remark) ) {
			my $remark = '';
			if ( $Debug ) {
				printf(
				  STDERR
				  "The following was recognised as a remark at line %u/%u: %s\n",
				  $linei + 1, $LineCount, '#' . $Remark
				);
			}
			if ( Uncomment($Remark, \$remark) ) {
				$Real .= $Remark; # Uncomment
				printf(STDERR "Uncommented line %u\n", $linei+1);
				$LinesPtr->[$linei] = $Real;
			}
		}

		if ( defined($Real) && length($Real) ) {
			$processedCount++;
		}
	}
	return $processedCount;
}
#----------------------------------------------------------------------------
sub Uncomment($$)
{
	my @uncomment_me = (
		'export DH_VERBOSE=1',
		'dh_fixperms'
	);

	my ( $In, $Out ) = ( @_ );
	my $uncommented = 0;
	foreach my $u ( @uncomment_me ) {
		if ( index($In, $u) > -1 ) {
			$$Out = $u;
			$uncommented = 1;
			last;
		}
	}
	return $uncommented;
}
#----------------------------------------------------------------------------
exit Main(); # Entry point.
#----------------------------------------------------------------------------