Add Perl::OSType as a dual-life core module

This commit adds Perl::OSType 1.002 as a dual-life module.  It maps Perl
operating system names (e.g. 'dragonfly' or 'MSWin32') to more generic
types with standardized names (e.g.  "Unix" or "Windows").  It has been
refactored out of Module::Build and ExtUtils::CBuilder and consolidates
such mappings into a single location for easier maintenance.

c.f.
http://www.nntp.perl.org/group/perl.perl5.porters/2010/05/msg160280.html

3 files changed, 298 insertions, 0 deletions

diff --git a/cpan/Perl-OSType/lib/Perl/OSType.pm b/cpan/Perl-OSType/lib/Perl/OSType.pm
new file mode 100644
index 0000000000..6c2cf127e9
--- /dev/null
+++ b/cpan/Perl-OSType/lib/Perl/OSType.pm
@@ -0,0 +1,174 @@
+#
+# This file is part of Perl-OSType
+#
+# This software is copyright (c) 2010 by David Golden.
+#
+# This is free software; you can redistribute it and/or modify it under
+# the same terms as the Perl 5 programming language system itself.
+#
+use strict;
+use warnings;
+package Perl::OSType;
+BEGIN {
+  $Perl::OSType::VERSION = '1.002';
+}
+# ABSTRACT: Map Perl operating system names to generic types
+
+require Exporter;
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = (
+  all => [ qw( os_type is_os_type ) ]
+);
+
+our @EXPORT_OK = @{ $EXPORT_TAGS{all} };
+
+# originally taken from Module::Build by Ken Williams et al.
+my %OSTYPES = qw(
+  aix         Unix
+  bsdos       Unix
+  beos        Unix
+  dgux        Unix
+  dragonfly   Unix
+  dynixptx    Unix
+  freebsd     Unix
+  linux       Unix
+  haiku       Unix
+  hpux        Unix
+  iphoneos    Unix
+  irix        Unix
+  darwin      Unix
+  machten     Unix
+  midnightbsd Unix
+  mirbsd      Unix
+  next        Unix
+  openbsd     Unix
+  netbsd      Unix
+  dec_osf     Unix
+  nto         Unix
+  svr4        Unix
+  svr5        Unix
+  sco_sv      Unix
+  unicos      Unix
+  unicosmk    Unix
+  solaris     Unix
+  sunos       Unix
+  cygwin      Unix
+  os2         Unix
+  interix     Unix
+  gnu         Unix
+  gnukfreebsd Unix
+  nto         Unix
+  qnx         Unix
+
+  dos         Windows
+  MSWin32     Windows
+
+  os390       EBCDIC
+  os400       EBCDIC
+  posix-bc    EBCDIC
+  vmesa       EBCDIC
+
+  MacOS       MacOS
+  VMS         VMS
+  VOS         VOS
+  riscos      RiscOS
+  amigaos     Amiga
+  mpeix       MPEiX
+);
+
+sub os_type {
+  my ($os) = @_;
+  $os = $^O unless defined $os;
+  return $OSTYPES{ $os } || q{};
+}
+
+sub is_os_type {
+  my ($type, $os) = @_;
+  return unless $type;
+  $os = $^O unless defined $os;
+  return os_type($os) eq $type;
+}
+
+1;
+
+
+=pod
+
+=head1 NAME
+
+Perl::OSType - Map Perl operating system names to generic types
+
+=head1 VERSION
+
+version 1.002
+
+=head1 SYNOPSIS
+
+  use Perl::OSType ':all';
+
+  $current_type = os_type();
+  $other_type = os_type('dragonfly'); # gives 'Unix'
+
+=head1 DESCRIPTION
+
+Modules that provide OS-specific behaviors often need to know if
+the current operating system matches a more generic type of
+operating systems. For example, 'linux' is a type of 'Unix' operating system
+and so is 'freebsd'.
+
+This module provides a mapping between an operating system name as given by
+C<$^O> and a more generic type.  The initial version is based on the OS type
+mappings provided in L<Module::Build> and L<ExtUtils::CBuilder>.  (Thus,
+Microsoft operating systems are given the type 'Windows' rather than 'Win32'.)
+
+=head1 USAGE
+
+No functions are exported by default. The export tag ":all" will export
+all functions listed below.
+
+=head2 os_type()
+
+  $os_type = os_type();
+  $os_type = os_type('MSWin32');
+
+Returns a single, generic OS type for a given operating system name.  With no
+arguments, returns the OS type for the current value of C<$^O>.  If the
+operating system is not recognized, the function will return the empty string.
+
+=head2 is_os_type()
+
+  $is_windows = is_os_type('Windows');
+  $is_unix    = is_os_type('Unix', 'dragonfly');
+
+Given an OS type and OS name, returns true or false if the OS name is of the
+given type.  As with C<os_type>, it will use the current operating system as a
+default if no OS name is provided.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<Devel::CheckOS>
+
+=back
+
+=head1 AUTHOR
+
+David Golden <dagolden@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
diff --git a/cpan/Perl-OSType/t/00-compile.t b/cpan/Perl-OSType/t/00-compile.t
new file mode 100644
index 0000000000..08e832b092
--- /dev/null
+++ b/cpan/Perl-OSType/t/00-compile.t
@@ -0,0 +1,53 @@
+#!perl
+#
+# This file is part of Perl-OSType
+#
+# This software is copyright (c) 2010 by David Golden.
+#
+# This is free software; you can redistribute it and/or modify it under
+# the same terms as the Perl 5 programming language system itself.
+#
+
+use strict;
+use warnings;
+
+use Test::More;
+use File::Find;
+use File::Temp qw{ tempdir };
+
+my @modules;
+find(
+  sub {
+    return if $File::Find::name !~ /\.pm\z/;
+    my $found = $File::Find::name;
+    $found =~ s{^lib/}{};
+    $found =~ s{[/\\]}{::}g;
+    $found =~ s/\.pm$//;
+    # nothing to skip
+    push @modules, $found;
+  },
+  'lib',
+);
+
+my @scripts = glob "bin/*";
+
+my $plan = scalar(@modules) + scalar(@scripts);
+$plan ? (plan tests => $plan) : (plan skip_all => "no tests to run");
+
+{
+    # fake home for cpan-testers
+     local $ENV{HOME} = tempdir( CLEANUP => 1 );
+
+    like( qx{ $^X -Ilib -e "require $_; print '$_ ok'" }, qr/^\s*$_ ok/s, "$_ loaded ok" )
+        for sort @modules;
+
+    SKIP: {
+        eval "use Test::Script 1.05; 1;";
+        skip "Test::Script needed to test script compilation", scalar(@scripts) if $@;
+        foreach my $file ( @scripts ) {
+            my $script = $file;
+            $script =~ s!.*/!!;
+            script_compiles( $file, "$script script compiles" );
+        }
+    }
+}
diff --git a/cpan/Perl-OSType/t/OSType.t b/cpan/Perl-OSType/t/OSType.t
new file mode 100644
index 0000000000..d471f9c5fe
--- /dev/null
+++ b/cpan/Perl-OSType/t/OSType.t
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+
+use Test::More 0.88;
+
+use constant NON_EXISTENT_OS => 'titanix'; #the system they said could not go down...
+
+#--------------------------------------------------------------------------#
+# API tests
+#--------------------------------------------------------------------------#
+
+require_ok( 'Perl::OSType' );
+
+can_ok( 'Perl::OSType', 'os_type' );
+
+my @functions = qw/os_type is_os_type/ ;
+for my $sub ( @functions ) {
+  ok( eval { Perl::OSType->import($sub); 1 }, "importing $sub()" );
+  can_ok( 'main', $sub );
+}
+
+my $test_pkg = "testpackage$$";
+
+ok( eval "package $test_pkg; use Perl::OSType ':all'; 1",
+  "Testing 'use Perl::OSType qw/:all/'"
+);
+
+can_ok( $test_pkg, @functions );
+
+
+#--------------------------------------------------------------------------#
+# os_type
+#--------------------------------------------------------------------------#
+
+{
+  my $fcn = 'os_type()';
+
+  ok( my $current_type = os_type(), "$fcn: without arguments" );
+
+  is( $current_type, os_type( $^O ), "... matches os_type($^O)" );
+
+  is(os_type( NON_EXISTENT_OS ), '', "$fcn: unknown OS returns empty string");
+
+  is(os_type( '' ), '', "$fcn: empty string returns empty string");
+
+  local $^O = 'linux';
+
+  is(os_type( undef ), 'Unix', "$fcn: explicit undef uses $^O");
+}
+
+#--------------------------------------------------------------------------#
+# is_os_type
+#--------------------------------------------------------------------------#
+
+{
+  my $fcn = 'is_os_type()';
+
+  is(is_os_type(NON_EXISTENT_OS), '', "$fcn: non-existent type is false");
+
+  is(is_os_type(''), undef, "$fcn: empty string type is false");
+
+  is(is_os_type('Unix', NON_EXISTENT_OS), '', "$fcn: non-existent OS is false");
+
+  local $^O = 'VOS';
+  ok( ! is_os_type( 'Unix' ), "$fcn: false" );
+  ok( is_os_type( 'VOS' ),    "$fcn: true" );
+  ok( ! is_os_type(), "$fcn: false if no type provided" );
+}
+
+done_testing;
+