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     api_subversion
  75     api_version
  76     api_versionstring
  77     archlibexp
  78     dont_use_nlink
  79     d_readlink
  80     d_symlink
  81     exe_ext
  82     inc_version_list
  83     ldlibpthname
  84     patchlevel
  85     path_sep
  86     perl_patchlevel
  87     privlibexp
  88     scriptdir
  89     sitearchexp
  90     sitelibexp
  91     subversion
  92     usevendorprefix
  93     version
  94
  95     git_commit_id
  96     git_describe
  97     git_branch
  98     git_uncommitted_changes
  99     git_commit_id_title
 100     git_snapshot_date
 101
 102     package revision version_patchlevel_string
 103
 104     osname osvers archname
 105     myuname
 106     config_args
 107     hint useposix d_sigaction
 108     useithreads usemultiplicity
 109     useperlio d_sfio uselargefiles usesocks
 110     use64bitint use64bitall uselongdouble
 111     usemymalloc bincompat5005
 112
 113     cc ccflags
 114     optimize
 115     cppflags
 116     ccversion gccversion gccosandvers
 117     intsize longsize ptrsize doublesize byteorder
 118     d_longlong longlongsize d_longdbl longdblsize
 119     ivtype ivsize nvtype nvsize lseektype lseeksize
 120     alignbytes prototype
 121
 122     ld ldflags
 123     libpth
 124     libs
 125     perllibs
 126     libc so useshrplib libperl
 127     gnulibc_version
 128
 129     dlsrc dlext d_dlsymun ccdlflags
 130     cccdlflags lddlflags
 131     );
 132
 133 my %empty_build = (
 134     osname  => "",
 135     stamp   => 0,
 136     options => { %BTD },
 137     patches => [],
 138     );
 139
 140 sub _make_derived
 141 {
 142     my $conf = shift;
 143
 144     exists $conf->{config}{Off_t}
 145         $conf->{derived}{Off_t} = delete $conf->{config}{Off_t};
 146     exists $conf->{derived}{Off_t} && !exists $conf->{config}{lseektype} and
 147         $conf->{config}{lseektype} = $conf->{derived}{Off_t};
 148
 149     } # _make_derived
 150
 151 sub plv2hash
 152 {
 153     my %config;
 154     for (split m/\n+/ => join "\n", @_) {
 155
 156         if (s/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)//) {
 157             $config{"package"} = $1;
 158             my $rev = $2;
 159             $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1;
 160             $rev and $config{version_patchlevel_string} = $rev;
 161             next;
 162             }
 163
 164         my %kv = m/\G,?\s*([^=]+)=('[^']+?'|\S+)/gc;
 165
 166         while (my ($k, $v) = each %kv) {
 167             $k =~ s/\s+$//;
 168             $v =~ s/,$//;
 169             $v =~ m/^'(.*)'$/ and $v = $1;
 170             $v =~ s/^\s+//;
 171             $v =~ s/\s+$//;
 172             $config{$k} = $v;
 173             }
 174         }
 175     my $build = { %empty_build };
 176     $build->{osname} = $config{osname};
 177     return {
 178         build           => $build,
 179         environment     => {},
 180         config          => \%config,
 181         inc             => [],
 182         };
 183     } # plv2hash
 184
 185 sub myconfig
 186 {
 187     my $args = shift;
 188     my %args = ref $args eq "HASH"  ? %$args :
 189                ref $args eq "ARRAY" ? @$args : ();
 190
 191     #y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
 192     my $pv = qx[$^X -V];
 193        $pv =~ s{.*?\n\n}{}s;
 194        $pv =~ s{\n(?:  \s+|\t\s*)}{ }g;
 195
 196     #print $pv;
 197
 198     my $build = { %empty_build };
 199     $pv =~ m{^\s+Built under (.*)}m                and $build->{osname} = $1;
 200     $pv =~ m{^\s+Compiled at (.*)}m                and $build->{stamp}  = $1;
 201     $pv =~ m{^\s+Locally applied patches:\s+(.*)}m and $build->{patches} = [ split m/\s+/, $1 ];
 202     $pv =~ m{^\s+Compile-time options:\s+(.*)}m    and map { $build->{options}{$_} = 1 } split m/\s+/, $1;
 203
 204     my @KEYS = keys %ENV;
 205     my %env  =
 206         map {      $_ => $ENV{$_} } grep m/^PERL/      => @KEYS;
 207     $args{env} and
 208         map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS;
 209
 210     my %config = map { $_ => $Config{$_} } @config_vars;
 211
 212     return {
 213         build           => $build,
 214         environment     => \%env,
 215         config          => \%config,
 216         inc             => \@INC,
 217         };
 218     } # myconfig
 219
 220 1;
 221
 222 __END__
 223
 224 =head1 NAME
 225
 226 Config::Perl::V - Structured data retreival of perl -V output
 227
 228 =head1 SYNOPSIS
 229
 230  use Config::Perl::V;
 231
 232  my $local_config = Config::Perl::V::myconfig ();
 233  print $local_config->{config}{osname};
 234
 235 =head1 DESCRIPTION
 236
 237 =head2 myconfig ()
 238
 239 This function will collect the data decribed in L<the hash structure> below,
 240
 241 =head2 plv2hash ()
 242
 243 Convert a sole 'perl -V' text block to a complete myconfig hash.
 244 All unknown entries are defaulted.
 245
 246 =head2 The hash structure
 247
 248 The returned hash consists of 4 parts:
 249
 250 =over 4
 251
 252 =item build
 253
 254 This information is extracted from the second block that is emitted by
 255 C<perl -V>, and usually looks something like
 256
 257  Characteristics of this binary (from libperl):
 258    Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
 259    Locally applied patches:
 260          defined-or
 261          MAINT24637
 262    Built under linux
 263    Compiled at Jun 13 2005 10:44:20
 264    @INC:
 265      /usr/lib/perl5/5.8.7/i686-linux-64int
 266      /usr/lib/perl5/5.8.7
 267      /usr/lib/perl5/site_perl/5.8.7/i686-linux-64int
 268      /usr/lib/perl5/site_perl/5.8.7
 269      /usr/lib/perl5/site_perl
 270      .
 271
 272 or
 273
 274  Characteristics of this binary (from libperl):
 275    Compile-time options: DEBUGGING MULTIPLICITY
 276                          PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
 277                          PERL_MALLOC_WRAP PERL_TRACK_MEMPOOL
 278                          PERL_USE_SAFE_PUTENV USE_ITHREADS
 279                          USE_LARGE_FILES USE_PERLIO
 280                          USE_REENTRANT_API
 281    Built under linux
 282    Compiled at Jan 28 2009 15:26:59
 283
 284 This information is not available anywhere else, including C<%Config>,
 285 but it is the information that is only known to the perl binary.
 286
 287 The extracted information is stored in 4 entries in the C<build> hash:
 288
 289 =over 4
 290
 291 =item osname
 292
 293 This is most likely the same as C$Config{osname}>, and was the name
 294 known when perl was built. It might be different if perl was cross-compiled.
 295
 296 The default for this field, if it cannot be extracted, is to copy C<$Config{osname}>.
 297 `
 298 =item stamp
 299
 300 This is the time string for which the perl binary was compiled. The default
 301 value is 0.
 302
 303 =item options
 304
 305 This is a hash with all the known defines as keys. The value is either 0,
 306 which means unknown or unset, or 1, which means defined.
 307
 308 =item patches
 309
 310 This is a list of optionally locally applied patches. Default is an empty list.
 311
 312 =back
 313
 314 This include the flags that define the binary compatibility, like if
 315 this perl was compiled for 64bitall (C<USE_64_BIT_ALL>), and basically is
 316
 317 =item environment
 318
 319 By default this hash is only filled with the environment variables
 320 out of %ENV that start with C<PERL>, but you can pass the C<env> option
 321 to myconfig to get more
 322
 323  my $conf = Config::Perl::V::myconfig ({ env => qr/^ORACLE/ });
 324  my $conf = Config::Perl::V::myconfig ([ env => qr/^ORACLE/ ]);
 325
 326 =item config
 327
 328 This hash is filled with the variables that C<perl -V> fils it's report
 329 with, and it has the same variables that C<Config::myconfig> returns
 330 from C<%Config>.
 331
 332 =item inc
 333
 334 This is the list of default @INC.
 335
 336 =back
 337
 338 =head1 REASONING
 339
 340 This module was written to be able to return the configuration for the
 341 currently used perl as deeply as needed for the CPANTESTERS framework.
 342 Up until now they used the output of myconfig as a single text blob,
 343 and so it was missing the vital binary characteristics of the running
 344 perl and the optional applied patches.
 345
 346 =head1 BUGS
 347
 348 Please feedback what is wrong
 349
 350 =head1 TODO
 351
 352 * Implement retrieval functions/methods
 353 * Documentation
 354 * Include the perl -V parse block from Andreas
 355
 356 =head1 AUTHOR
 357
 358 H.Merijn Brand <h.m.brand@xs4all.nl>
 359
 360 =head1 COPYRIGHT AND LICENSE
 361
 362 Copyright (C) 1999-2009 H.Merijn Brand
 363
 364 This library is free software; you can redistribute it and/or modify
 365 it under the same terms as Perl itself.
 366
 367 =cut