/usr/share/perl5/Language/INTERCAL/Backend.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 | 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;
|