# -*- perl -*-
# Driver.pm $Id: Driver.pm,v 1.4.2.1 2000/01/30 13:56:23 jens Exp $
# (C) Copyright Jens G Jensen <jens@argaeus.ma.rhul.ac.uk>
# This file is part of epsmerge and is distributed under GNU GPL

package Driver;

use strict;
use Carp;
use Options;
use Eps;
use CellFactory;


# Parameters to constructor:
# An IO factory
sub new {
    my ($class, $io) = @_;
    # procs stores procedures (ready to print);
    # dsc stores a hash as follows (see also _store_dsc() below):
    #	needed => { file => ['foo', 'baz', 'sproz'], font => ['bar'] ]
    # for included (needed) resources;
    #	supplied => { file => ['otkrytki'] }
    # for supplied resources not stored in procs;
    #	language => 3
    # for the languagelevel.
    my $self = { 'stage' => 0, 'io' => $io, 'procs' => [ ],
		 'dsc' => {
			  'needed' => {},
			  'supplied' => {},
			  'language' => 0,
			  },
	       };
    Options->new()->setopts( '-io-' => $io );
    return bless $self, $class;
}

# change stage:
# input : new stage (number)
sub stage {
    my $self = shift;
    return if $_[0] == $self->{stage};
    my $prev;			# check all previous stages for consistency
    for($prev = 1; $prev < $_[0]; ++$prev) {
	my $msg = $self->check($prev);
	next unless $msg;
	$msg = "Cannot change to " . ('Input', 'Format', 'Output')[$_[0]-1] . "\n$msg";
	$self->{io}->message($msg, 'E');
	return;
    }
    $self->close( $self->{stage} );
    $self->open( $_[0] );
}

# dispatch functions
sub open {
    my $self = shift;
    return if $_[0] == 0;
    return $self->open_input() if $_[0] == 1;
    return $self->open_format() if $_[0] == 2;
    return $self->open_output() if $_[0] == 3;
    croak "Unknown stage identifier";
}

sub close {
    my $self = shift;
    return if $_[0] == 0;
    return $self->close_input() if $_[0] == 1;
    return $self->close_format() if $_[0] == 2;
    return $self->close_output() if $_[0] == 3;
    croak "Unknown stage identifier";
}

# Check functions return a description of the error
# or an empty string if there was no error
sub check {
    my $self = shift;
    return "" if $_[0] == 0;
    return $self->check_input() if $_[0] == 1;
    return $self->check_format() if $_[0] == 2;
    return $self->check_output() if $_[0] == 3;
    croak "Unknown stage identifier";
}


# Parameters to write method:
# A CellFactory
sub write {
    my $self = shift;
    foreach (1 .. 3) {
	my $errmsg = $self->check($_);
	if( $errmsg ) {
	    $self->{io}->message($errmsg, 'E');
	    $self->stage($_);
	    return;
	}
    }
    my $fact = shift;
    my $main = $fact->create_maincell();
    return "Create Cell error??" unless $main;
    return $main->write($self->{'procs'}, $self->{'dsc'});
}

# Checking input also converts input things to cells
sub check_input {
    my $self = shift;
    my $opt = Options->new();
    my @files = @{$opt->getopts('files')};
    my @cells = ();
    foreach (@files) {
	next if ref $_;
	# check if filename has a page-specification after it;
	# if it is non-E postscript it gets sliced anyway below;
	# note that each number is actually number-or-dollarsign,
	# dollarsign meaning last entry in file.
	my $nd = '(\d+|\$)';		# for convenience/readability
	if( /^(.*)$main::Separator($nd(,$nd|-$nd(?=,|$))*)$/o ) {
	    my $cell = Eps->new($1, $self->{'io'},	# $1 == filename
				sub { _store($self->{'procs'}, $_[0]) },
				sub { _store_dsc( $self, @_ ) },
			       );
	    unless( ref $cell ) {
		$self->{'io'}->message($cell, 'E');
		next;
	    }
	    my $number_of_pages = $cell->pages();	# ref to page-data
	    unless( defined $number_of_pages ) {
		$self->{'io'}->message("Asked to read pages for $_ but it doesn't have any", 'E');
		next;
	    }
	    $number_of_pages = @$number_of_pages;	# dereference, keep number
	    my @pp = split /,/, $2;			# $2 == pages
	    foreach (@pp) {
		if( /^(\d+|\$)-(\d+|\$)$/ ) {			# if page is a range of pages
		    my ($fst, $lst) = ($1, $2);
		    $fst = $number_of_pages if $fst eq '$'  # ' fontify happiness
			|| $fst > $number_of_pages;
		    $lst = $number_of_pages if $lst eq '$'  # ' fontify happiness
			|| $lst > $number_of_pages;
		    my $i;
		    for( $i = $fst; $i <= $lst; ++$i ) {
			my $r = EpsWrap->new( $cell, $i );
			return $r unless ref $r;
			push @cells, $r;
		    }
		}
		else {
		    $_ = $number_of_pages if $_ eq '$'	# ' fontify happiness
			|| $_ > $number_of_pages;
		    my $r = EpsWrap->new( $cell, $_ );
		    return $r unless ref $r;
		    push @cells, $r;
		}
	    }
	}
	else {
	    my $cell = Eps->new($_, $self->{'io'},
				sub { _store($self->{'procs'}, $_[0]) },
				sub { _store_dsc( $self, @_ ) },
			       );
	    unless( ref $cell ) {
		$self->{'io'}->message($cell, 'E');
		next;
	    }
	    # Check if it was a non-E postscript; if yes, expand it by
	    # taking all the individual pages as cells.
	    if( $cell->pages() ) {
		my $page = 1;				# first physical page
		foreach ( @{$cell->pages} ) {
		    push @cells, EpsWrap->new( $cell, $page++ );
		}
	    }
	    else {
		push @cells, $cell;
	    }
	}
    }
    $opt->setopts('files' => \@cells);
    return '';
}

sub check_format {
    my $opt = Options->new();
    # how many cells per page?
    my ($x, $y) = $opt->getopts('x', 'y');
    my $xy = $x * $y;
    $xy = @{$opt->getopts('files')} if($xy == 0);
    # option xy is used by CellFactory::create_maincell
    $opt->setopts('xy' => $xy);
    return '';
}

sub check_output {
    my $self = shift;
    my $opt = Options->new();
    return '';
}

sub open_input {
    my $self = shift;
    $self->{stage} = 1;
    return '';
}

sub open_format {
    my $self = shift;
    $self->{stage} = 2;
    return '';
}

sub open_output {
    my $self = shift;
    $self->{stage} = 3;
    return '';
}

sub close_input {
    my $self = shift;
    $self->{stage} = 0;
    return '';
}

sub close_format {
    my $self = shift;
    $self->{stage} = 0;
    return '';
}

sub close_output {
    my $self = shift;
    $self->{stage} = 0;
    return '';
}

# This function is used to store something (strings) in an array such
# that it is unique; currently it is called only from check_input.

sub _store {
    my ($array, $elem) = @_;
    # OK, we check uniqueness linearly; in the future I may use a hash
    # (as in TWDT => 1 for each procedure/resource TWDT)
    my $boz;
    foreach $boz (@$array) {
	return if $boz eq $elem;
    }
    push @$array, $elem;
}

# What is the policy with LanguageLevel?  Do we keep the largest?
# Smallest?  Currently we keep the largest.  So there.

sub _store_dsc {
    my ($self, $class, $type, $name) = @_;
    $type = lc $type;
    if( $class eq 'language' ) {
	# init'd to 0 in new(). $type holds the value; $name unused here
	my $current = $self->{'dsc'}->{'language'};
	if( $current < $type ) {
	    $self->{'dsc'} ->{'language'} = $type;
	}
    }
    elsif( $class !~ /^(needed|supplied)$/ ) {
	$self->{'io'}->message("Internal error: don't know DSC type $type","W");
    }
    else {
	push @{$self->{'dsc'}->{$class}->{$type}}, $name;
    }
}


package Driver_Console;

use strict;
use vars qw(@ISA);
@ISA = qw(Driver);

sub new {
    return Driver::new($_[0], new Io_Console);
}

sub main_loop {
    my $self = shift;
    my $msg = $self->write(new FileCellFactory);
    if($msg) {
	$self->{io}->message($msg);
	exit(1);
    }
    exit(0);
}


1;