package Language::INTERCAL::Charset;

# Character sets

# 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/Charset.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(fromascii toascii charset charset_default charset_name);

my @charsets;
my %charsets;
my $default;

BEGIN {
    $default = 'ASCII';
    @charsets = ( [$default, sub { shift }, sub { shift }] );
    %charsets = ( $default => scalar(@charsets) );
}

use constant charset_default => $charsets{$default};

sub _find {
    my ($how, $charset) = @_;
    $charset =~ s/\s+//g;
    if ($charset =~ /^\d+$/) {
	$charset = charset_default if $charset == 0;
	return undef if $charset < 1 || $charset > @charsets;
	return $how ? $charset : $charsets[$charset - 1];
    } else {
	if (! exists $charsets{$charset}) {
	    eval "require Language::INTERCAL::Charset::$charset";
	    return undef if $@;
	    my ($to, $from);
	    eval {
		no strict 'refs';
		$to = \&{"Language::INTERCAL::Charset::${charset}::\L${charset}\E2ascii"};
		&$to('');
		$from = \&{"Language::INTERCAL::Charset::${charset}::ascii2\L${charset}\E"};
		&$from('');
	    };
	    return undef if $@;
	    push @charsets, [$charset, $to, $from];
	    $charsets{$charset} = @charsets;
	}
	$charset = $charsets{$charset};
	return $how ? $charset : $charsets[$charset - 1];
    }
}

sub charset {
    @_ == 1 or croak "Usage: charset(CHARSET)";
    _find(1, @_);
}

sub charset_name {
    @_ == 1 or croak "Usage: charset_name(CHARSET)";
    my $charset = _find(0, @_);
    defined $charset ? $charset->[0] : undef;
}

sub toascii {
    @_ == 1 or croak "Usage: toascii(CHARSET)";
    my $charset = _find(0, @_);
    defined $charset ? $charset->[1] : undef;
}

sub fromascii {
    @_ == 1 or croak "Usage: fromascii(CHARSET)";
    my $charset = _find(0, @_);
    defined $charset ? $charset->[2] : undef;
}

1;