Win32::GUI::Constants - exporter for Win32 API constants

  use Win32:GUI::Constants;

  use Win32:GUI::Constants ();

  use Win32::GUI::Constansts [@pragmata,] [@symbols];

  [!]name         This name only
  [!]:tag         All names in class 'tag'
  [!]/pattern/    All names which match pattern

  my $value = Win32::GUI::Constants::constant('SOME_CONST');

package Win32::GUI::Constants;

# $Id: Constants.pm,v 1.11 2008/02/09 08:51:27 robertemay Exp $
# Win32::GUI::Constants, part of the Win32::GUI package
# (c) Robert May, 2005..2006
# released under the same terms as Perl.

use 5.006;
use strict;
use warnings;
use warnings::register;

our $VERSION = '0.04';
our $XS_VERSION = $VERSION;
eval $VERSION;

require XSLoader;
XSLoader::load('Win32::GUI::Constants', $XS_VERSION);

our ($Verbose, $AUTOLOAD);

# We're only exporting our own subroutines, write our own import function, simplifying
# Exporter::Heavy::heavy_export.  This implementation can only export subroutines, and
# export list must not pre-pend '&' to the subroutine names.
sub import
{
    my $pkg = shift;
    my $callpkg = caller;
    my @imports;
    my $inline = 0;
    my $export = 1;
    my $autoload = 0;
    my $oops = 0;
    my $compatibility_win32_gui = 0;

    # detect and remove our pragmas from the import list, and do
    # version checking:
    my $setpkg = 0;
    foreach (@_) {
        # Always expect the export package name immediately after
        # the -exportpkg pragma
        $callpkg=$_,$setpkg=0, next if $setpkg;
        $inline=1,             next if /^-inline$/;
        # Always inline if not exporting, otherwise -noexport does nothing
        $export=0, $inline=1,  next if /^-noexport$/;
        $setpkg=1,             next if /^-exportpkg$/;
        $autoload=1,           next if /^-autoload$/;
        # warn if we see an unrecognised pragma
        ++$oops, warnings::warn qq("$_" is not a recognised pragma), next if /^-/;
        $pkg->VERSION($_),     next if /^\d/;    # inherit from UNIVERSAL
        push @imports, $_;
    }

    if(@imports) {
        # expand @imports, if necessary
        if (grep m{^[/!:]}, @imports) {
            my %imports;
            # negated first item implies starting with default set:
            # our default is empty, so don't add anything
            #unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
            foreach my $spec (@imports) {
                my @names;
                my $remove = $spec =~ s/^!//;

                if ($spec =~ s/^://){
                    # Only require Tags module if we need it
                    require Win32::GUI::Constants::Tags;
                    if(my $namesref = Win32::GUI::Constants::Tags::tag($spec)){
                        @names = @$namesref;
                    }
                    else {
                        warnings::warn qq(tag ":$spec" is not defined by $pkg);
                        ++$oops;
                        next;
                    }
                    # :compatibility_win32_gui has very special semantics if
                    # the calling package is Win32::GUI for backwards compatibility
                    if (($spec eq 'compatibility_win32_gui') and (caller eq 'Win32::GUI')) {
                        $compatibility_win32_gui = 1;
                    }
                }
                elsif ($spec =~ m:^/(.*)/$:){
                    my $patn = $1;
                    # If we expect to see lots of these, then we
                    # may want to store the reference rather than
                    # calling _export_ok() each time
                    @names = grep(/$patn/, @{_export_ok()}); # not anchored by default
                }
                else {
                    @names = ($spec); # is a normal symbol name
                }

                warn "Import ".($remove ? "del":"add").": @names " if $Verbose;

                if ($remove) {
                    foreach my $sym (@names) { delete $imports{$sym} } 
                }
                else {
                    @imports{@names} = (1) x @names;
                }
            }
            @imports = keys %imports;
        }
    }

    # If we did
    #   use Win32::GUI::Constants 0.01, '';
    # I.e. a version check with no imports, then imports contains a single entry with value ''
    if( @imports == 1 and $imports[0] eq '' ) {
        @imports = ();
    }

    # export @imports to caller's namespace
    if($Verbose) {
        my $t = join(", ", sort @imports) . "\n" . scalar(@imports) . " symbols being ";
        $t   .= "imported into $callpkg from $pkg " if $export;
        $t   .= "and " if $export and $inline;
        $t   .= "prepared for inlining " if $inline;
        warn $t;
    }

    {
        no strict 'refs';
        # Single loop with statement modifiers is faster than 2 loops,
        # unless both $export and $inline are false.  That doesn't
        # happen
        my @export_ok = @{_export_ok()};
        foreach my $sym (@imports) {
            #check that $sym can be exported, and croak if not.
            if(not grep /^$sym$/, @export_ok) {
                warnings::warn qq("$sym" is not exported by $pkg);
                ++$oops;
                next;
            }
            *{"${callpkg}::$sym"} = \&{"${pkg}::$sym"} if $export;
            &{"${pkg}::$sym"} if $inline;  # force AUTOLOAD
	    eval "sub Win32::GUI::$sym();" if $compatibility_win32_gui;
        }

        *{"${callpkg}::AUTOLOAD"} = \&{"${pkg}::AUTOLOAD"} if $autoload;
    }

    if($oops) {
        # only require Carp if we need it
        require Carp;
        Carp::croak(qq(Can't continue after import errors));
    }
}

sub AUTOLOAD
{
    my $constant = $AUTOLOAD;
    $constant =~ s/.*:://;

    my $val = constant($constant);

    if(defined $val) {
        {
            no warnings; # avoid perl 5.6 warning about prototype mismatches
            eval "sub $AUTOLOAD() {$val}";
        }
        goto &$AUTOLOAD;
    }

    #TODO: use Carp?  Change to 'Constant $constant is not found by Win32::GUI::Constants'
    warnings::warnif("AUTOLOAD failed to find '$constant'");
    return undef;
}

1; # End of Constants.pm
__END__