Mercurial > repo
view interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Backend.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::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;