Mercurial > repo
view interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Charset.pm @ 3553:a2c0fbb7c2b1
<Roujo> revert
author | HackBot |
---|---|
date | Thu, 29 Aug 2013 20:30:48 +0000 |
parents | 859f9b4339e6 |
children |
line wrap: on
line source
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;