"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/version.pm" (7 Mar 2020, 1976 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!perl -w
    2 package version;
    3 
    4 use 5.006002;
    5 use strict;
    6 use warnings::register;
    7 if ($] >= 5.015) {
    8     warnings::register_categories(qw/version/);
    9 }
   10 
   11 our $VERSION = 0.9924;
   12 our $CLASS = 'version';
   13 our (@ISA, $STRICT, $LAX);
   14 
   15 # avoid using Exporter
   16 require version::regex;
   17 *version::is_lax = \&version::regex::is_lax;
   18 *version::is_strict = \&version::regex::is_strict;
   19 *LAX = \$version::regex::LAX;
   20 *LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION;
   21 *LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION;
   22 *STRICT = \$version::regex::STRICT;
   23 *STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION;
   24 *STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION;
   25 
   26 sub import {
   27     no strict 'refs';
   28     my ($class) = shift;
   29 
   30     # Set up any derived class
   31     unless ($class eq $CLASS) {
   32     local $^W;
   33     *{$class.'::declare'} =  \&{$CLASS.'::declare'};
   34     *{$class.'::qv'} = \&{$CLASS.'::qv'};
   35     }
   36 
   37     my %args;
   38     if (@_) { # any remaining terms are arguments
   39     map { $args{$_} = 1 } @_
   40     }
   41     else { # no parameters at all on use line
   42     %args =
   43     (
   44         qv => 1,
   45         'UNIVERSAL::VERSION' => 1,
   46     );
   47     }
   48 
   49     my $callpkg = caller();
   50 
   51     if (exists($args{declare})) {
   52     *{$callpkg.'::declare'} =
   53         sub {return $class->declare(shift) }
   54       unless defined(&{$callpkg.'::declare'});
   55     }
   56 
   57     if (exists($args{qv})) {
   58     *{$callpkg.'::qv'} =
   59         sub {return $class->qv(shift) }
   60       unless defined(&{$callpkg.'::qv'});
   61     }
   62 
   63     if (exists($args{'UNIVERSAL::VERSION'})) {
   64     local $^W;
   65     *UNIVERSAL::VERSION
   66         = \&{$CLASS.'::_VERSION'};
   67     }
   68 
   69     if (exists($args{'VERSION'})) {
   70     *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
   71     }
   72 
   73     if (exists($args{'is_strict'})) {
   74     *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
   75       unless defined(&{$callpkg.'::is_strict'});
   76     }
   77 
   78     if (exists($args{'is_lax'})) {
   79     *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
   80       unless defined(&{$callpkg.'::is_lax'});
   81     }
   82 }
   83 
   84 
   85 1;