Mercurial > repo
diff interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Charset.pm @ 996:859f9b4339e6
<Gregor> tar xf egobot.tar.xz
author | HackBot |
---|---|
date | Sun, 09 Dec 2012 19:30:08 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Charset.pm Sun Dec 09 19:30:08 2012 +0000 @@ -0,0 +1,86 @@ +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;