package Language::INTERCAL::Backend;

# Backends

# This file is part of CLC-INTERCAL

# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

use strict;
use vars qw($VERSION $PERVERSION);
($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Backend.pm 1.-94.-2") =~ /\s(\S+)$/;

use Carp;
use Language::INTERCAL::Exporter '1.-94.-2';
use vars qw(@EXPORT @EXPORT_OK);
@EXPORT = ();
@EXPORT_OK = qw(backend generate_code);

my @backends = ();
my %backends = ();

sub backend {
    @_ == 1 or croak "Usage: backend(BACKEND)";
    my ($backend) = @_;
    $backend =~ s/\s+//g;
    if ($backend =~ /^\d+$/) {
	return undef if $backend < 0 || $backend >= @backends;
	return $backend;
    } else {
	if (! exists $backends{$backend}) {
	    eval "require Language::INTERCAL::Backend::$backend";
	    return undef if $@;
	    $backends{$backend} = @backends;
	    push @backends, $backend;
	}
	$backend = $backends{$backend};
	return $backend;
    }
}

sub generate_code {
    @_ == 6 or @_ == 7 or croak
	"Usage: generate_code(INTERPRETER, BACKEND, NAME, BASENAME, " .
	"FILESPEC, ORIG [,OPTIONS])";
    my ($int, $backend, $name, $basename, $filespec, $orig, $options) = @_;
    $options ||= {};
    my $verb = $options->{verbose};
    $backend = 'Language::INTERCAL::Backend::' . $backend;
    eval "require $backend"; die $@ if $@;
    my $suffix = $backend->default_suffix;
    my $mode = $backend->default_mode;
    my $handle = '';
    my $filename = undef;
    my %p = ('%' => '%', 'p' => $basename, 's' => $suffix, 'o' => $orig);
    if (defined $suffix) {
	$filename = $filespec;
	$filename =~ s/%([%ops])/$p{$1}/ge;
	&$verb($filename) if $verb;
	$handle = new Language::INTERCAL::GenericIO 'FILE', 'r', $filename;
    } else {
	&$verb('') if $verb;
    }
    $name =~ s/%([%ops])/$p{$1}/ge;
    $backend->generate($int, $name, $handle, $options);
    undef $handle;
    if (defined $filename && defined $mode) {
	chmod $mode & ~umask, $filename;
    }
}

1;