V.pm

   1 #!/pro/bin/perl
   2
   3 package Config::Perl::V;
   4
   5 use strict;
   6 use warnings;
   7
   8 our $VERSION = "0.02";
   9
  10 use Config;
  11
  12 #  Characteristics of this binary (from libperl):
  13 #    Compile-time options: DEBUGGING PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP
  14 #                          USE_64_BIT_INT USE_LARGE_FILES USE_PERLIO
  15
  16 # The list are as the perl binary has stored it in PL_bincompat_options
  17 #  search for it in
  18 #   perl.c line 1768 (first  block)
  19 #   perl.h line 4454 (second block),
  20 my %BTD = map { $_ => 0 } qw(
  21
  22     DEBUGGING
  23     NO_MATHOMS
  24     PERL_DONT_CREATE_GVSV
  25     PERL_MALLOC_WRAP
  26     PERL_MEM_LOG
  27     PERL_MEM_LOG_ENV
  28     PERL_MEM_LOG_ENV_FD
  29     PERL_MEM_LOG_STDERR
  30     PERL_MEM_LOG_TIMESTAMP
  31     PERL_USE_DEVEL
  32     PERL_USE_SAFE_PUTENV
  33     USE_FAST_STDIO
  34     USE_SITECUSTOMIZE
  35
  36     DEBUG_LEAKING_SCALARS
  37     DEBUG_LEAKING_SCALARS_FORK_DUMP
  38     DECCRTL_SOCKETS
  39     FAKE_THREADS
  40     MULTIPLICITY
  41     MYMALLOC
  42     PERL_DEBUG_READONLY_OPS
  43     PERL_GLOBAL_STRUCT
  44     PERL_IMPLICIT_CONTEXT
  45     PERL_IMPLICIT_SYS
  46     PERL_MAD
  47     PERL_NEED_APPCTX
  48     PERL_NEED_TIMESBASE
  49     PERL_OLD_COPY_ON_WRITE
  50     PERL_POISON
  51     PERL_TRACK_MEMPOOL
  52     PERL_USES_PL_PIDSTATUS
  53     PL_OP_SLAB_ALLOC
  54     THREADS_HAVE_PIDS
  55     USE_64_BIT_ALL
  56     USE_64_BIT_INT
  57     USE_IEEE
  58     USE_ITHREADS
  59     USE_LARGE_FILES
  60     USE_LONG_DOUBLE
  61     USE_PERLIO
  62     USE_REENTRANT_API
  63     USE_SFIO
  64     USE_SOCKS
  65     VMS_DO_SOCKETS
  66     VMS_SYMBOL_CASE_AS_IS
  67     );
  68
  69 # These are all the keys that are
  70 # 1. Always present in %Config (first block)
  71 # 2. Reported by 'perl -V' (the rest)
  72 my @config_vars = qw(
  73
  74     archlibexp
  75     dont_use_nlink
  76     d_readlink
  77     d_symlink
  78     exe_ext
  79     inc_version_list
  80     ldlibpthname
  81     path_sep
  82     privlibexp
  83     scriptdir
  84     sitearchexp
  85     sitelibexp
  86     usevendorprefix
  87     version
  88
  89     package revision version_patchlevel_string
  90
  91     osname osvers archname
  92     myuname
  93     config_args
  94     hint useposix d_sigaction
  95     useithreads usemultiplicity
  96     useperlio d_sfio uselargefiles usesocks
  97     use64bitint use64bitall uselongdouble
  98     usemymalloc bincompat5005
  99
 100     cc ccflags
 101     optimize
 102     cppflags
 103     ccversion gccversion gccosandvers
 104     intsize longsize ptrsize doublesize byteorder
 105     d_longlong longlongsize d_longdbl longdblsize
 106     ivtype ivsize nvtype nvsize lseektype lseeksize
 107     alignbytes prototype
 108
 109     ld ldflags
 110     libpth
 111     libs
 112     perllibs
 113     libc so useshrplib libperl
 114     gnulibc_version
 115
 116     dlsrc dlext d_dlsymun ccdlflags
 117     cccdlflags lddlflags
 118     );
 119
 120 my %empty_build = (
 121     osname  => "",
 122     stamp   => 0,
 123     options => { %BTD },
 124     patches => [],
 125     );
 126
 127 sub plv2hash
 128 {
 129     my %config;
 130     for (split m/\n+/ => join "\n", @_) {
 131
 132         if (s/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)//) {
 133             $config{"package"} = $1;
 134             my $rev = $2;
 135             $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1;
 136             $rev and $config{version_patchlevel_string} = $rev;
 137             next;
 138             }
 139
 140         my %kv = m/\G,?\s*([^=]+)=('[^']+?'|\S+)/gc;
 141
 142         while (my ($k, $v) = each %kv) {
 143             $k =~ s/\s+$//;
 144             $v =~ s/,$//;
 145             $v =~ m/^'(.*)'$/ and $v = $1;
 146             $v =~ s/^\s+//;
 147             $v =~ s/\s+$//;
 148             $config{$k} = $v;
 149             }
 150         }
 151     my $build = { %empty_build };
 152     $build->{osname} = $config{osname};
 153     return {
 154         build           => $build,
 155         environment     => {},
 156         config          => \%config,
 157         inc             => [],
 158         };
 159     } # plv2hash
 160
 161 sub myconfig
 162 {
 163     my $args = shift;
 164     my %args = ref $args eq "HASH"  ? %  $args  :
 165                ref $args eq "ARRAY" ? %{@$args} : ();
 166
 167     #y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
 168     my $pv = qx[$^X -V];
 169        $pv =~ s{.*?\n\n}{}s;
 170        $pv =~ s{\n(?:  \s+|\t\s*)}{ }g;
 171
 172     #print $pv;
 173
 174     my $build = { %empty_build };
 175     $pv =~ m{^\s+Built under (.*)}m                and $build->{osname} = $1;
 176     $pv =~ m{^\s+Compiled at (.*)}m                and $build->{stamp}  = $1;
 177     $pv =~ m{^\s+Locally applied patches:\s+(.*)}m and $build->{patches} = [ split m/\s+/, $1 ];
 178     $pv =~ m{^\s+Compile-time options:\s+(.*)}m    and map { $build->{options}{$_} = 1 } split m/\s+/, $1;
 179
 180     my @KEYS = keys %ENV;
 181     my %env  =
 182         map   { $_    => $ENV{$_} } grep m/^PERL/ => @ENV;
 183     $args{db} || $args{pg} || $args{postgres} and
 184         map { $env{$_} = $ENV{$_} } grep m{^PG}        => @KEYS;
 185     $args{db} || $args{oracle} and
 186         map { $env{$_} = $ENV{$_} } grep m{^ORACLE}    => @KEYS;
 187     $args{db} || $args{mysql}  and
 188         map { $env{$_} = $ENV{$_} } grep m{^M[yY]SQL}  => @KEYS;
 189     $args{env} and
 190         map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS;
 191
 192     my %config = map { $_ => $Config{$_} } @config_vars;
 193
 194     return {
 195         build           => $build,
 196         environment     => \%env,
 197         config          => \%config,
 198         inc             => \@INC,
 199         };
 200     } # myconfig
 201
 202 1;
 203
 204 __END__
 205
 206 =head1 NAME
 207
 208 Config::Perl::V - Structured data retreival of perl -V output
 209
 210 =head1 SYNOPSIS
 211
 212 use Config::Perl::V;
 213
 214 my $local_config = Config::Perl::V::myconfig ();
 215 print $local_config->{config}{osname};
 216
 217 =head1 DESCRIPTION
 218
 219 =head2 myconfig ()
 220
 221 Currently the only function. Documentation will follow.
 222
 223 =head2 plv2hash ()
 224
 225 Convert a sole 'perl -V' text block to a complete myconfig hash.
 226 All unknown entries are defaulted.
 227
 228 =head1 REASONING
 229
 230 This module was written to be able to return the configuration for the
 231 currently used perl as deeply as needed for the CPANTESTERS framework.
 232 Up until now they used the output of myconfig as a single text blob,
 233 and so it was missing the vital binary characteristics of the running
 234 perl and the optional applied patches.
 235
 236 =head1 BUGS
 237
 238 Please feedback what is wrong
 239
 240 =head1 TODO
 241
 242 * Implement retreival functions/methods
 243 * Document what is done and why
 244 * Include the perl -V parse block from Andreas
 245
 246 =head1 AUTHOR
 247
 248 H.Merijn Brand <h.m.brand@xs4all.nl>
 249
 250 =head1 COPYRIGHT AND LICENSE
 251
 252 Copyright (C) 1999-2009 H.Merijn Brand
 253
 254 This library is free software; you can redistribute it and/or modify
 255 it under the same terms as Perl itself.
 256
 257 =cut