/usr/share/perl5/Language/INTERCAL/Charset.pm is in clc-intercal 1:1.0~4pre1.-94.-2-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 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;
|