From: David Golden Date: Thu, 6 Jan 2011 03:25:23 +0000 (-0500) Subject: Add Perl::OSType as a dual-life core module X-Git-Tag: v5.13.9~304 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/935c8d19ecf9ad3ea7589ffd1721e6ba1c671ed9 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 --- diff --git a/MANIFEST b/MANIFEST index c81aa32..ba563e6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1655,6 +1655,9 @@ cpan/Parse-CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm Parse::CPAN::Meta testing lib cpan/Parse-CPAN-Meta/uupacktool.pl Parse::CPAN::Meta cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm PerlIO::via::QuotedPrint cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t PerlIO::via::QuotedPrint +cpan/Perl-OSType/lib/Perl/OSType.pm Perl::OSType +cpan/Perl-OSType/t/00-compile.t Perl::OSType +cpan/Perl-OSType/t/OSType.t Perl::OSType cpan/Pod-Escapes/ChangeLog ChangeLog for Pod::Escapes cpan/Pod-Escapes/lib/Pod/Escapes.pm Pod::Escapes cpan/Pod-Escapes/README README for Pod::Escapes diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index c4e692c..55e3af5 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1153,6 +1153,15 @@ use File::Glob qw(:case); 'UPSTREAM' => undef, }, + 'Perl::OSType' => + { + 'MAINTAINER' => 'dagolden', + 'DISTRIBUTION' => 'DAGOLDEN/Perl-OSType-1.002.tar.gz', + 'FILES' => q[cpan/Perl-OSType], + 'EXCLUDED' => [ ], + 'UPSTREAM' => 'cpan', + }, + 'perlpacktut' => { 'MAINTAINER' => 'laun', diff --git a/cpan/Perl-OSType/lib/Perl/OSType.pm b/cpan/Perl-OSType/lib/Perl/OSType.pm new file mode 100644 index 0000000..6c2cf12 --- /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 and L. (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, it will use the current operating system as a +default if no OS name is provided. + +=head1 SEE ALSO + +=over 4 + +=item * + +L + +=back + +=head1 AUTHOR + +David Golden + +=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 0000000..08e832b --- /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 0000000..d471f9c --- /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; + diff --git a/lib/.gitignore b/lib/.gitignore index 62c0aff..03961eb 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -298,6 +298,7 @@ /Package/Constants.pm /Params/Check.pm /Parse/CPAN/ +/Perl/OSType.pm /PerlIO/encoding.pm /PerlIO/scalar.pm /PerlIO/via.pm diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 2e821d4..42b7ee5 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -92,6 +92,14 @@ included with CPAN distributions or generated by the module installation toolchain. It should not be used for any other general YAML parsing or generation task. +=item * + +L 1.002 has been added 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. + =back =head2 Updated Modules and Pragmata