move Storable CAN_FLOCK computation into XS
authorGraham Knop <haarg@haarg.org>
Sat, 20 Apr 2019 10:53:06 +0000 (12:53 +0200)
committerTony Cook <tony@develop-help.com>
Thu, 8 Aug 2019 01:26:34 +0000 (11:26 +1000)
At build time, Storable would check if it could use flock based on some
Config values, and generate the final Storable.pm file using tha value.
This was done to avoid needing to load Config at runtime.  This adds
complexity to the build process.

A simpler option is to build the constant in the XS code.  This means
the build process can be entirely standard for XS.

Some slight adjustments to the code are needed to load the XS module at
BEGIN time, so that the contant is available in the rest of the file.

MANIFEST
Porting/corelist.pl
dist/Storable/.gitignore [deleted file]
dist/Storable/MANIFEST
dist/Storable/Makefile.PL
dist/Storable/Storable.pm [moved from dist/Storable/__Storable__.pm with 99% similarity]
dist/Storable/Storable.pm.PL [deleted file]
dist/Storable/Storable.xs

index 9b7798e..e3785ee 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3630,7 +3630,6 @@ dist/SelfLoader/lib/SelfLoader.pm Load functions only on demand
 dist/SelfLoader/t/01SelfLoader.t       See if SelfLoader works
 dist/SelfLoader/t/02SelfLoader-buggy.t See if SelfLoader works
 dist/SelfLoader/t/03taint.t            See if SelfLoader works under taint
-dist/Storable/__Storable__.pm  Template to generate Storable.pm
 dist/Storable/ChangeLog                        Storable extension
 dist/Storable/hints/gnukfreebsd.pl     Hint for Storable for named architecture
 dist/Storable/hints/gnuknetbsd.pl      Hint for Storable for named architecture
@@ -3640,8 +3639,8 @@ dist/Storable/Makefile.PL         Storable extension
 dist/Storable/MANIFEST                 Storable MANIFEST file
 dist/Storable/README                   Storable extension
 dist/Storable/stacksize                        compute stack sizes
+dist/Storable/Storable.pm              Storable perl module
 dist/Storable/Storable.xs              Storable extension
-dist/Storable/Storable.pm.PL   perl script to generate Storable.pm from template
 dist/Storable/t/attach.t               Check STORABLE_attach doesn't create objects unnecessarily
 dist/Storable/t/attach_errors.t                Trigger and test STORABLE_attach errors
 dist/Storable/t/attach_singleton.t     Test STORABLE_attach for the Singleton pattern
index ad5a4ad..ce74ed4 100755 (executable)
@@ -98,7 +98,6 @@ find(
     sub {
         /(\.pm|_pm\.PL)$/ or return;
         /PPPort\.pm$/ and return;
-        /__Storable__\.pm$/ and return;
         my $module = $File::Find::name;
         $module =~ /\b(demo|t|private|corpus)\b/ and return;    # demo or test modules
         my $version = MM->parse_version($_);
diff --git a/dist/Storable/.gitignore b/dist/Storable/.gitignore
deleted file mode 100644 (file)
index de731b9..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-/Storable.pm
-/lib
index d30b94e..5e382d9 100644 (file)
@@ -1,4 +1,3 @@
-__Storable__.pm
 ChangeLog
 hints/gnukfreebsd.pl
 hints/gnuknetbsd.pl
@@ -11,7 +10,7 @@ META.yml                      Module meta-data (added by MakeMaker)
 ppport.h
 README
 stacksize
-Storable.pm.PL
+Storable.pm
 Storable.xs
 t/attach.t
 t/attach_errors.t
index c86f5ab..cdcc3e0 100644 (file)
@@ -10,10 +10,6 @@ use strict;
 use warnings;
 use ExtUtils::MakeMaker 6.31;
 use Config;
-use File::Copy qw(move copy);
-use File::Spec;
-
-my $pm = { 'Storable.pm' => '$(INST_ARCHLIB)/Storable.pm' };
 
 WriteMakefile(
     NAME                => 'Storable',
@@ -22,31 +18,26 @@ WriteMakefile(
     DISTNAME            => "Storable",
 # We now ship this in t/
 #    PREREQ_PM           => { 'Test::More' => '0.41' },
-    PL_FILES        => { }, # prevent default behaviour
-    PM              => $pm,
     PREREQ_PM           => { XSLoader => 0 },
     INSTALLDIRS => ($] >= 5.007 && $] < 5.012) ? 'perl' : 'site',
-    VERSION_FROM    => '__Storable__.pm',
-    ABSTRACT_FROM   => '__Storable__.pm',
+    VERSION_FROM    => 'Storable.pm',
+    ABSTRACT_FROM   => 'Storable.pm',
     ($ExtUtils::MakeMaker::VERSION > 6.45 ?
      (META_MERGE        => { resources =>
                                { bugtracker => 'http://rt.perl.org/perlbug/' },
                             provides    => {
                                 'Storable'  => {
-                                    file        => '__Storable__.pm',
-                                    version     => MM->parse_version('__Storable__.pm'),
+                                    file        => 'Storable.pm',
+                                    version     => MM->parse_version('Storable.pm'),
                                 },
                             },
 
                            },
     ) : ()),
     dist                => { SUFFIX => 'gz', COMPRESS => 'gzip -f' },
-    clean               => { FILES => 'Storable-* Storable.pm lib' },
+    clean               => { FILES => 'Storable-*' },
 );
 
-# Unlink the .pm file included with the distribution
-1 while unlink "Storable.pm";
-
 my $ivtype = $Config{ivtype};
 
 # I don't know if the VMS folks ever supported long long on 5.6.x
@@ -79,13 +70,3 @@ release : dist
        git push --tags
 "
 }
-
-sub postamble {
-'
-all :: Storable.pm
-       $(NOECHO) $(NOOP)
-
-Storable.pm :: Storable.pm.PL __Storable__.pm
-       $(PERLRUN) Storable.pm.PL
-'
-}
similarity index 99%
rename from dist/Storable/__Storable__.pm
rename to dist/Storable/Storable.pm
index 8ed247f..5804f47 100644 (file)
@@ -8,7 +8,7 @@
 #  in the README file that comes with the distribution.
 #
 
-require XSLoader;
+BEGIN { require XSLoader }
 require Exporter;
 package Storable;
 
@@ -27,7 +27,9 @@ our @EXPORT_OK = qw(
 
 our ($canonical, $forgive_me);
 
-our $VERSION = '3.16';
+BEGIN {
+  our $VERSION = '3.16';
+}
 
 our $recursion_limit;
 our $recursion_limit_hash;
@@ -104,14 +106,12 @@ $Storable::flags = FLAGS_COMPAT;
 $Storable::downgrade_restricted = 1;
 $Storable::accept_future_minor = 1;
 
-XSLoader::load('Storable');
+BEGIN { XSLoader::load('Storable') };
 
 #
 # Determine whether locking is possible, but only when needed.
 #
 
-sub CAN_FLOCK; # TEMPLATE - replaced by Storable.pm.PL
-
 sub show_file_magic {
     print <<EOM;
 #
@@ -266,7 +266,7 @@ sub _store {
     local *FILE;
     if ($use_locking) {
         open(FILE, ">>", $file) || logcroak "can't write into $file: $!";
-        unless (&CAN_FLOCK) {
+        unless (CAN_FLOCK) {
             logcarp
               "Storable::lock_store: fcntl/flock emulation broken on $^O";
             return undef;
@@ -410,7 +410,7 @@ sub _retrieve {
     my $self;
     my $da = $@;                       # Could be from exception handler
     if ($use_locking) {
-        unless (&CAN_FLOCK) {
+        unless (CAN_FLOCK) {
             logcarp
               "Storable::lock_store: fcntl/flock emulation broken on $^O";
             return undef;
diff --git a/dist/Storable/Storable.pm.PL b/dist/Storable/Storable.pm.PL
deleted file mode 100644 (file)
index df979c0..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-use strict;
-use warnings;
-
-use Config;
-
-my $template;
-{      # keep all the code in an external template to keep it easy to update
-       local $/;
-       open my $FROM, '<', '__Storable__.pm' or die $!;
-       $template = <$FROM>;
-       close $FROM or die $!;
-}
-
-sub CAN_FLOCK {
-       return
-               $Config{'d_flock'} ||
-               $Config{'d_fcntl_can_lock'} ||
-               $Config{'d_lockf'}
-               ? 1 : 0;
-}
-
-my $CAN_FLOCK = CAN_FLOCK();
-
-# populate the sub and preserve it if used outside
-$template =~ s{^sub CAN_FLOCK;.*$}{sub CAN_FLOCK { ${CAN_FLOCK} } # computed by Storable.pm.PL}m;
-# alternatively we could remove the sub
-#$template =~ s{^sub CAN_FLOCK;.*$}{}m;
-# replace local function calls to hardcoded value
-$template =~ s{&CAN_FLOCK}{${CAN_FLOCK}}g;
-
-{
-       open my $OUT, '>', 'Storable.pm' or die $!;
-       print {$OUT} $template or die $!;
-       close $OUT or die $!;
-}
index d75125b..c233568 100644 (file)
 #  define strEQc(s,c) memEQ(s, ("" c ""), sizeof(c))
 #endif
 
+#if defined(HAS_FLOCK) || defined(FCNTL_CAN_LOCK) && defined(HAS_LOCKF)
+#define CAN_FLOCK &PL_sv_yes
+#else
+#define CAN_FLOCK &PL_sv_no
+#endif
+
 #ifdef DEBUGME
 
 #ifndef DASSERT
@@ -7794,6 +7800,8 @@ BOOT:
     newCONSTSUB(stash, "BIN_MINOR", newSViv(STORABLE_BIN_MINOR));
     newCONSTSUB(stash, "BIN_WRITE_MINOR", newSViv(STORABLE_BIN_WRITE_MINOR));
 
+    newCONSTSUB(stash, "CAN_FLOCK", CAN_FLOCK);
+
     init_perinterp(aTHX);
     gv_fetchpv("Storable::drop_utf8",   GV_ADDMULTI, SVt_PV);
 #ifdef DEBUGME