view release on metacpan or  search on metacpan

inc/Devel/CheckOS.pm  view on Meta::CPAN

=cut

sub die_if_os_isnt {
    os_is(@_) ? 1 : die_unsupported();
}

=head3 die_if_os_is

As C<os_isnt()>, except that it dies instead of returning false.

=cut

sub die_if_os_is {
    os_isnt(@_) ? 1 : die_unsupported();
}

=head2 And some utility functions ...

=head3 die_unsupported

This function simply dies with the message "OS unsupported", which is what
the CPAN testers look for to figure out whether a platform is supported or
not.

=cut

sub die_unsupported { die("OS unsupported\n"); }

=head3 list_platforms

When called in list context,
return a list of all the platforms for which the corresponding
Devel::AssertOS::* module is available.  This includes both OSes and OS
families, and both those bundled with this module and any third-party
add-ons you have installed.

In scalar context, returns a hashref keyed by platform with the filename
of the most recent version of the supporting module that is available to you.
This behaviour is deprecated.

Unfortunately, on some platforms this list may have file case
broken.  eg, some platforms might return 'freebsd' instead of 'FreeBSD'.
This is because they have case-insensitive filesystems so things
should Just Work anyway.

This function does not work in taint-mode.

=cut

my $case_flag = File::Spec->case_tolerant ? '(?i)' : '';
my $re_Devel    = qr/$case_flag ^Devel$/x;
my $re_AssertOS = qr/$case_flag ^AssertOS$/x;
my $re_Alias    = qr/$case_flag ^Alias\b/x;

sub list_platforms {
    # sort by mtime, so oldest last. This was necessary so that if a module
    # appears twice in @INC we pick the newer one but that functionality is
    # no longer needed. We do need to de-dupe the list though
    my @modules = sort {
        (stat($a->{file}))[9] <=> (stat($b->{file}))[9]
    } grep {
        $_->{module} !~ $re_Alias
    } map {
        my (undef, $dir_part, $file_part) = File::Spec->splitpath($_);
        $file_part =~ s/\.pm$//;
        my (@dirs) = grep {+length} File::Spec->splitdir($dir_part);
        foreach my $i (reverse 1..$#dirs) {
            next unless(
                $dirs[$i] =~ $re_AssertOS &&
                $dirs[$i - 1] =~ $re_Devel
            );;
            splice @dirs, 0, $i + 1;
            last;
        }
        {
            module => join('::', @dirs, $file_part),
            file   => File::Spec->canonpath($_)
        }
    } _find_pm_files_in_dirs(
        grep { -d }
        map { File::Spec->catdir($_, qw(Devel AssertOS)) }
        @INC
    );

    my %modules = map {
        $_->{module} => $_->{file}
    } @modules;

    if(wantarray()) {
        return sort keys %modules;
    } else {
        warn("Calling list_platforms in scalar context and getting back a reference is deprecated and will go away some time after April 2024. To disable this warning set \$Devel::CheckOS::NoDeprecationWarnings::Context to a true value.\n") unless($D...
        return \%modules;
    }
}

=head3 list_family_members

Takes the name of an OS 'family' and returns a list of all its members.
In list context, you get a list, in scalar context you get an arrayref.

If called on something that isn't a family, you get an empty list (or
a ref to an empty array).

=cut

sub list_family_members {
    my $family = shift() ||
        die(__PACKAGE__."::list_family_members needs a parameter\n");

    # this will die if it's the wrong OS, but the module is loaded ...
    eval qq{use Devel::AssertOS::$family};
    # ... so we can now query it
    my @members = eval qq{
        no strict 'refs';
        &{"Devel::AssertOS::${family}::matches"}()
    };
    if(wantarray()) {
        return @members;
    } else {