Mercurial > repo
view interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Exporter.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::Exporter; # Like the standard Exporter, but understand INTERCAL (per)version numbers # 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/Exporter.pm 1.-94.-2") =~ /\s(\S+)$/; use Carp; require Exporter; use vars qw(@EXPORT @EXPORT_OK); @EXPORT = qw(import); @EXPORT_OK = qw(is_intercal_number import require_version compare_version); sub is_intercal_number { @_ == 1 or croak "Usage: is_intercal_number(STRING)"; my ($s) = @_; $s =~ /^-?\d+(?:\.-?\d+)*$/; } sub import { my $package = shift; if (@_ && Language::INTERCAL::Exporter::is_intercal_number($_[0])) { Language::INTERCAL::Exporter::require_version($package, shift); } unshift @_, $package; goto &Exporter::import; } sub require_version { my ($package, $required) = @_; $package = caller if ! defined $package; no strict 'refs'; my $provided = ((${"${package}::PERVERSION"} || '0') =~ /\s(\S+$)/)[0]; compare_version($required, $provided) <= 0 or croak "$package perversion $provided is too old (required $required)"; } sub compare_version { @_ == 2 or croak "Usage: compare_version(NUM, NUM)"; my ($a, $b) = @_; my @a = split(/\./, $a); my @b = split(/\./, $b); while (@a || @b) { $a = @a ? shift @a : 0; $b = @b ? shift @b : 0; return -1 if $a < $b; return 1 if $a > $b; } 0; } 1;