#!/usr/bin/perl
# ###
# PiMPx - the Perl-inclusive Macro Processor
# (c) 2001-2002 - Ask Solem Hoel <ask@unixmonks.net>
# All rights reserved.
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2 
#   as published by the Free Software Foundation.
#
#   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, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#####

package main;

use strict;
use vars qw($me);
use Devel::PiMPx;

# ### basename of myself.
$me = $0;
$me =~ s%.*/%%;

my $pp = new Devel::PiMPx(programname=>$me);
$pp->no_lineno(1); # default on.
my $version = Version->new($Devel::PiMPx::VERSION);

# ###
# get filename from command arguments,
# and run the preprocessor.
my $file = _parseopts(@ARGV);
my $ret  = $pp->preprocess($file);
exit 0;

# ########################################################################################### #

# ##### void _version(void)
# print version information.
#
sub _version {
	printf STDERR "PiMPx - the Perl-inclusive Macro-Processor %s\n", $version->extended();
	print  STDERR "Copyright 2001-2002 Ask Solem Hoel <ask\@unixmonks.net>\n";
}

# ##### void _usage(void)
# print usage information
#
sub _usage {
	print STDERR "Usage: $me {[-I/include|-Dvar|-Dvar=val|--debug|--lineno]] - {filename}|[-h|-V]}\n";
}

# #### char _parseopts(array argv)
# parse command line arguments and return the filename given.
#
sub _parseopts {
	my @argv = @_;
	my $file; # filename to return
	while($_ = shift @argv) {
		if	(s/^-$//) {
			# ### 
			# if we get a "-" the rest of the arguments 
			# is the filename to process.
			return "@argv" if @argv;
		}
		elsif	(s/^-O//) {
			# ###
			# -Ofilename: redirect standard output to <filename>.
			#
			die "*** Missing filename as argument to -O\n"
			  unless $_;
			open OUTPUT, ">$_"
			  or die "*** $me: Error: Couldn't open $_: $!\n";
			*STDOUT=*OUTPUT;
		}
		elsif	(s/^(--version|-V)//) {
				# print version information
				_version();
				exit;
		}
		elsif	(s/^(--help|-h)//) {
				# print version and help
				_version();
				_usage();
				exit;
		}
		elsif	(s/^--debug//) {
				# print debugging information at runtime.
				$pp->debug(1);
				print STDERR "*** Debug option set\n";
		}
		elsif	(s/^(--no-lineno|-L)//) {
				# don't print #line comments.
				$pp->no_lineno(1);
				print STDERR "*** Don't print #line directives option set.\n" if $pp->debug;
		}
		elsif	(s/^(--lineno|-l)//) {
				# print #line comments
				$pp->no_lineno(0);
				print STDERR "*** Print #line directives option set.\n" if $pp->debug;
		}
		elsif	(s/^-I//) {
				# ### 
				# -Ipath: add path to @INC
				#
				die "*** Missing path as argument to -I\n" unless $_;
				print STDERR "*** New include path: $_\n" if $pp->debug;
				push @INC;
		}
		elsif	(s/^-D//) {
				# ###
				# -Dvar(=value)?: Define value to variable.
				# if no value is given, variable is set to true (1).
				#
				if(/^(.+?)=(.+?)?$/) {
					next unless $2; # must have value if "=" character found.
					print STDERR "*** Variable $1 set to $2\n" if $pp->debug;
					$pp->_define("$1 $2");
				}
				else {
					print STDERR "*** Variable $_ defined\n" if $pp->debug;
					print "$@\n" if $@;
					$pp->define("$1 1");
				}
		}
		elsif	(not /^-/) {
				# ### 
				# this argument is our file if no dash character
				# is found at the start.
				$file = $_;
		}
	};
	unless($file) {
		# ### print some help if no file given.
		_version();
		_usage();	
		END; exit;
	}
	return $file;
}

#--------- Version.pm ----------#
# ###
# Version.pm - kernel/gnome like version library
# (c) 1999-2002 Ask Solem Hoel <ask@unixmonks.net>
# All rights reserved.
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2
#   as published by the Free Software Foundation.
#
#   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, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#####

package Version;
use Carp;
use Exporter;
use vars qw(%EXPORT_TAGS @EXPORT @EXPORT_OK @ISA);

@ISA = qw(@EXPORT @EXPORT_OK);

@EXPORT = qw();
@EXPORT_OK = qw(cmp_version);
%EXPORT_TAGS = ( all => qw(cmp_version) );

# ### Version new(char version)
# create new Version object with thre dotted version
# as argument.
#
sub new {
	my ($pkg, $version) = @_;
	my $self = {};
	bless $self, $pkg;
	$self->version($version);
	return $self;
};

# ### char version(char version)
# set version or get version currently set
#
sub version {
	my ($self, $version) = @_;
	# set version if we got version as argument.
	if($version) {
		($self->{MAJOR}, $self->{MINOR}, $self->{RELEA})
			= split('\.', $version);   
		$self->{VERSION} = $version;
	};
	return $self->{VERSION};
};

# ### accessors
sub major { $_[0]->{MAJOR} };
sub minor { $_[0]->{MINOR} };
sub relea { $_[0]->{RELEA} };

# ### char extended(void)
# get extended version information
#
sub extended {
	my $self = shift;
	my $su;
	# ### stable if even, unstable if odd.
	if($self->minor() % 2) {
		$su = "unstable";
	}
	else {
		$su = "stable";
	};
	return sprintf("%s (%s)", $self->version, $su);
};

# ### int check(char check_against, char operator)
# check current version against check_against with operator.
# example:
#	# ### check if version "1.1.0" is higher or equal to current version.
#	unless($version->check("1.1.0", ">=") {
#		die("Must have version higher than or equal to 1.1.0\n");
#	};
#
sub check {
	my($self, $check_against, $operator) = @_;
	# ###
	# operator can only be of the following characters:
	# >, <, =, !
	carp "Illegal characters in operator or missing operator."
		unless $operator =~ /^[\>\<\=\!]+$/;
	# ### 
	# remove the dots from the versions
	# i.e 2.4.0 and 2.2.0 becomes 240 and 220,
	# then we just check the two against the operator.
	$check_against =~ s/\.//g;
	my $version = $self->version();
	$version =~ tr/.//d;
	if(eval "return 1 if($check_against $operator $version)") {
		return 1;
	}
	else {
		return 0;
	};
};

# ### int check(char version1|Version version, version2);
# compare two versions. if first argument is reference to Version
# object it swaps version 1 with Version->version().
# returns equal, less than og higher than.
#
sub cmp_version {
	my($x, $y) = @_;
	my $version;
	if(ref $x) {
		# swap
		my $self = $x;	
		$x = $self->version();
	}
	$x =~ tr/.//d; $y =~ tr/.//d;	
	return ($x - $y);
}

__END__

=head1 NAME

pimpx - The Perl-inclusive Macro Processor

=head1 SYNOPSIS

 pimpx {[-I/include|-Dvar|-Dvar=val|--debug|--lineno]] - {filename}|[-h|-V]}

=head1 DESCRIPTION

PiMPx is the Perl-inclusive Macro Processor.
It simplifies the management of bigger projects in Perl and can
be used in other languages that use lines beginning with "#" as comments.

=head1 EXPORT

None by default.

=head1 AUTHOR

Ask Solem Hoel E<lt>ask@unixmonks.netE<gt>

=head1 SEE ALSO
 
L<perl>. L<Devel::PiMPx>

=cut

