major update

build/patch/SSLeay.xs

+/*
+ * $Id: SSLeay.xs,v 1.2 2000/05/10 16:37:25 ben Exp $
+ * Copyright 1998 Gisle Aas.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the same terms as Perl itself.
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+
+/* CRYPT_SSLEAY_free() will not be #defined to be free() now that we're no
+ * longer supporting pre-2000 OpenSSL.
+#define NO_XSLOCKS
+*/
+
+#include "XSUB.h"
+
+/* build problem under openssl 0.9.6 and some builds of perl 5.8.x */
+#ifndef PERL5
+#define PERL5 1
+#endif
+
+/* Makefile.PL no longer generates the following header file
+ * #include "crypt_ssleay_version.h"
+ * Among other things, Makefile.PL used to determine whether
+ * to use #include<openssl/ssl.h> or #include<ssl.h> and
+ * whether to use OPENSSL_free or free etc, but such distinctions
+ * ceased to matter pre-2000. Crypt::SSLeay no longer supports
+ * pre-2000 OpenSSL */
+
+#include <openssl/ssl.h>
+#include <openssl/crypto.h>
+#include <openssl/err.h>
+#include <openssl/rand.h>
+#include <openssl/pkcs12.h>
+
+#define CRYPT_SSLEAY_free OPENSSL_free
+
+#undef Free /* undo namespace pollution from crypto.h */
+#ifdef __cplusplus
+}
+#endif
+
+
+#if SSLEAY_VERSION_NUMBER >= 0x0900
+#define CRYPT_SSL_CLIENT_METHOD SSLv3_client_method()
+#else
+#define CRYPT_SSL_CLIENT_METHOD SSLv2_client_method()
+#endif
+
+static void InfoCallback(const SSL *s,int where,int ret)
+    {
+    const char *str;
+    int w;
+
+    w = where & ~SSL_ST_MASK;
+
+    if(w & SSL_ST_CONNECT)
+       str="SSL_connect";
+    else if(w & SSL_ST_ACCEPT)
+       str="SSL_accept";
+    else
+       str="undefined";
+
+    if(where & SSL_CB_LOOP) {
+       fprintf(stderr,"%s:%s\n",str,SSL_state_string_long(s));
+    }
+    else if(where & SSL_CB_ALERT) {
+       str=(where & SSL_CB_READ)?"read":"write";
+       fprintf(stderr,"SSL3 alert %s:%s:%s\n",str,
+           SSL_alert_type_string_long(ret),
+           SSL_alert_desc_string_long(ret));
+       }
+    else if(where & SSL_CB_EXIT) {
+       if(ret == 0)
+         fprintf(stderr,"%s:failed in %s\n",str,SSL_state_string_long(s));
+       else if (ret < 0)
+         fprintf(stderr,"%s:error in %s\n",str,SSL_state_string_long(s));
+       }
+    }
+
+MODULE = Crypt::SSLeay                PACKAGE = Crypt::SSLeay
+
+PROTOTYPES: DISABLE
+
+MODULE = Crypt::SSLeay         PACKAGE = Crypt::SSLeay::Err PREFIX = ERR_
+
+#define CRYPT_SSLEAY_ERR_BUFSIZE 1024
+
+const char *
+ERR_get_error_string()
+    PREINIT:
+        unsigned long code;
+        char buf[ CRYPT_SSLEAY_ERR_BUFSIZE ];
+
+    CODE:
+        if ((code = ERR_get_error()) == 0) {
+            RETVAL = NULL;
+        }
+        else {
+            /* www.openssl.org/docs/crypto/ERR_error_string.html */
+            ERR_error_string_n(code, buf, CRYPT_SSLEAY_ERR_BUFSIZE);
+            RETVAL = buf;
+        }
+    OUTPUT:
+        RETVAL
+
+MODULE = Crypt::SSLeay    PACKAGE = Crypt::SSLeay::CTX    PREFIX = SSL_CTX_
+
+#define CRYPT_SSLEAY_RAND_BUFSIZE 1024
+
+SSL_CTX*
+SSL_CTX_new(packname, ssl_version)
+     SV* packname
+     int ssl_version
+     CODE:
+        SSL_CTX* ctx;
+        static int bNotFirstTime;
+        char buf[ CRYPT_SSLEAY_RAND_BUFSIZE ];
+
+        if(!bNotFirstTime) {
+            OpenSSL_add_all_algorithms();
+            SSL_load_error_strings();
+            ERR_load_crypto_strings();
+            SSL_library_init();
+            bNotFirstTime = 1;
+        }
+
+        /**** Code from Devin Heitmueller, 10/3/2002 ****/
+        /**** Use /dev/urandom to seed if available  ****/
+        /* ASU: 2014/04/23 It looks like it is OK to leave
+         * this in. See following thread:
+         * http://security.stackexchange.com/questions/56469/
+         */
+       if (RAND_load_file("/dev/urandom", CRYPT_SSLEAY_RAND_BUFSIZE)
+            != CRYPT_SSLEAY_RAND_BUFSIZE)
+        {
+            /* Couldn't read /dev/urandom, just seed off
+             * of the stack variable (the old way)
+             */
+            RAND_seed(buf, CRYPT_SSLEAY_RAND_BUFSIZE);
+        }
+
+        if(ssl_version == 23) {
+            ctx = SSL_CTX_new(SSLv23_client_method());
+        }
+        else if(ssl_version == 3) {
+	    ctx = SSL_CTX_new(TLS_client_method());
+        }
+        else {
++#if !defined OPENSSL_NO_SSL2 && OPENSSL_VERSION_NUMBER < 0x10100000L
+            /* v2 is the default */
+            ctx = SSL_CTX_new(SSLv2_client_method());
+#else
+            /* v3 is the default */
+            ctx = SSL_CTX_new(TLS_client_method());
+#endif
+        }
+
+        SSL_CTX_set_options(ctx,SSL_OP_ALL|0);
+        SSL_CTX_set_default_verify_paths(ctx);
+        SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL);
+        RETVAL = ctx;
+     OUTPUT:
+        RETVAL
+
+void
+SSL_CTX_free(ctx)
+     SSL_CTX* ctx
+
+int
+SSL_CTX_set_cipher_list(ctx, ciphers)
+     SSL_CTX* ctx
+     char* ciphers
+
+int
+SSL_CTX_use_certificate_file(ctx, filename, mode)
+     SSL_CTX* ctx
+     char* filename
+     int mode
+
+int
+SSL_CTX_use_PrivateKey_file(ctx, filename ,mode)
+     SSL_CTX* ctx
+     char* filename
+     int mode
+
+int
+SSL_CTX_use_pkcs12_file(ctx, filename, password)
+     SSL_CTX* ctx
+     const char *filename
+     const char *password
+     PREINIT:
+        FILE *fp;
+        EVP_PKEY *pkey;
+        X509 *cert;
+        STACK_OF(X509) *ca = NULL;
+        PKCS12 *p12;
+     CODE:
+        if ((fp = fopen(filename, "rb"))) {
+            p12 = d2i_PKCS12_fp(fp, NULL);
+            fclose (fp);
+
+            if (p12) {
+                if(PKCS12_parse(p12, password, &pkey, &cert, &ca)) {
+                    if (pkey) {
+                        RETVAL = SSL_CTX_use_PrivateKey(ctx, pkey);
+                        EVP_PKEY_free(pkey);
+                    }
+                    if (cert) {
+                        RETVAL = SSL_CTX_use_certificate(ctx, cert);
+                        X509_free(cert);
+                    }
+                }
+                PKCS12_free(p12);
+            }
+        }
+     OUTPUT:
+        RETVAL
+
+
+int
+SSL_CTX_check_private_key(ctx)
+     SSL_CTX* ctx
+
+SV*
+SSL_CTX_set_verify(ctx)
+     SSL_CTX* ctx
+     PREINIT:
+        char* CAfile;
+        char* CAdir;
+     CODE:
+        CAfile=getenv("HTTPS_CA_FILE");
+        CAdir =getenv("HTTPS_CA_DIR");
+
+        if(!CAfile && !CAdir) {
+            SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL);
+            RETVAL = newSViv(0);
+        }
+        else {
+            SSL_CTX_load_verify_locations(ctx,CAfile,CAdir);
+            SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER, NULL);
+            RETVAL = newSViv(1);
+        }
+     OUTPUT:
+       RETVAL
+
+MODULE = Crypt::SSLeay        PACKAGE = Crypt::SSLeay::Conn        PREFIX = SSL_
+
+SSL*
+SSL_new(packname, ctx, debug, ...)
+        SV* packname
+        SSL_CTX* ctx
+        SV* debug
+        PREINIT:
+        SSL* ssl;
+        CODE:
+           ssl = SSL_new(ctx);
+           SSL_set_connect_state(ssl);
+           /* The set mode is necessary so the SSL connection can
+            * survive a renegotiated cipher that results from
+            * modssl VerifyClient config changing between
+            * VirtualHost & some other config block.  At modssl
+            * this would be a [trace] ssl message:
+            *  "Changed client verification type will force renegotiation"
+            * -- jc 6/28/2001
+            */
+#ifdef SSL_MODE_AUTO_RETRY
+           SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY);
+#endif
+           RETVAL = ssl;
+           if(SvTRUE(debug)) {
+             SSL_set_info_callback(RETVAL,InfoCallback);
+           }
+           if (items > 2) {
+               PerlIO* io = IoIFP(sv_2io(ST(3)));
+#ifdef _WIN32
+               SSL_set_fd(RETVAL, _get_osfhandle(PerlIO_fileno(io)));
+#else
+               SSL_set_fd(RETVAL, PerlIO_fileno(io));
+#endif
+           }
+        OUTPUT:
+           RETVAL
+
+void
+SSL_free(ssl)
+        SSL* ssl
+
+int
+SSL_pending(ssl)
+        SSL* ssl
+
+int
+SSL_set_fd(ssl,fd)
+        SSL* ssl
+        int  fd
+
+int
+SSL_connect(ssl)
+        SSL* ssl
+
+int
+SSL_accept(ssl)
+        SSL* ssl
+
+SV*
+SSL_write(ssl, buf, ...)
+        SSL* ssl
+        PREINIT:
+           STRLEN blen;
+           int len;
+           int offset = 0;
+           int keep_trying_to_write = 1;
+        INPUT:
+           char* buf = SvPV(ST(1), blen);
+        CODE:
+           if (items > 2) {
+               len = SvOK(ST(2)) ? SvIV(ST(2)) : blen;
+               if (items > 3) {
+                   offset = SvIV(ST(3));
+                   if (offset < 0) {
+                       if (-offset > blen)
+                           croak("Offset outside string");
+                       offset += blen;
+                   }
+                   else if (offset >= blen && blen > 0)
+                       croak("Offset outside string");
+               }
+               if (len > blen - offset)
+                   len = blen - offset;
+           }
+           else {
+               len = blen;
+           }
+
+           /* try to handle incomplete writes properly
+            * see RT bug #64054 and RT bug #78695
+            * 2012/08/02: Stop trying to distinguish between good & bad
+            * zero returns from underlying SSL_read/SSL_write
+            */
+           while (keep_trying_to_write)
+           {
+                int n = SSL_write(ssl, buf+offset, len);
+                int x = SSL_get_error(ssl, n);
+
+                if ( n >= 0 )
+                {
+                    keep_trying_to_write = 0;
+                    RETVAL = newSViv(n);
+                }
+                else
+                {
+                    if
+                    (
+                        (x != SSL_ERROR_WANT_READ) &&
+                        (x != SSL_ERROR_WANT_WRITE)
+                    )
+                    {
+                        keep_trying_to_write = 0;
+                        RETVAL = &PL_sv_undef;
+                    }
+                }
+           }
+        OUTPUT:
+           RETVAL
+
+SV*
+SSL_read(ssl, buf, len,...)
+        SSL* ssl
+        int len
+        PREINIT:
+           char *buf;
+           STRLEN blen;
+           int offset = 0;
+           int keep_trying_to_read = 1;
+        INPUT:
+           SV* sv = ST(1);
+        CODE:
+           buf = SvPV_force(sv, blen);
+           if (items > 3) {
+               offset = SvIV(ST(3));
+               if (offset < 0) {
+                   if (-offset > blen)
+                       croak("Offset outside string");
+                   offset += blen;
+               }
+               /* this is not a very efficient method of appending
+                * (offset - blen) NUL bytes, but it will probably
+                * seldom happen.
+                */
+               while (offset > blen) {
+                   sv_catpvn(sv, "\0", 1);
+                   blen++;
+               }
+           }
+           if (len < 0)
+               croak("Negative length");
+
+           SvGROW(sv, offset + len + 1);
+           buf = SvPVX(sv);  /* it might have been relocated */
+
+           /* try to handle incomplete writes properly
+            * see RT bug #64054 and RT bug #78695
+            * 2012/08/02: Stop trying to distinguish between good & bad
+            * zero returns from underlying SSL_read/SSL_write
+            */
+           while (keep_trying_to_read) {
+                int n = SSL_read(ssl, buf+offset, len);
+                int x = SSL_get_error(ssl, n);
+
+                if ( n >= 0 )
+                {
+                    SvCUR_set(sv, offset + n);
+                    buf[offset + n] = '\0';
+                    keep_trying_to_read = 0;
+                    RETVAL = newSViv(n);
+                }
+                else
+                {
+                    if
+                    (
+                        (x != SSL_ERROR_WANT_READ) &&
+                        (x != SSL_ERROR_WANT_WRITE)
+                    )
+                    {
+                        keep_trying_to_read = 0;
+                        RETVAL = &PL_sv_undef;
+                    }
+                }
+           }
+        OUTPUT:
+           RETVAL
+
+X509*
+SSL_get_peer_certificate(ssl)
+        SSL* ssl
+
+SV*
+SSL_get_verify_result(ssl)
+        SSL* ssl
+        CODE:
+           RETVAL = newSViv((SSL_get_verify_result(ssl) == X509_V_OK) ? 1 : 0);
+        OUTPUT:
+           RETVAL
+
+#define CRYPT_SSLEAY_SHARED_CIPHERS_BUFSIZE 512
+
+char*
+SSL_get_shared_ciphers(ssl)
+    SSL* ssl
+    PREINIT:
+        char buf[ CRYPT_SSLEAY_SHARED_CIPHERS_BUFSIZE ];
+    CODE:
+        RETVAL = SSL_get_shared_ciphers(
+                    ssl, buf, CRYPT_SSLEAY_SHARED_CIPHERS_BUFSIZE
+                 );
+    OUTPUT:
+        RETVAL
+
+char*
+SSL_get_cipher(ssl)
+        SSL* ssl
+        CODE:
+           RETVAL = (char*) SSL_get_cipher(ssl);
+        OUTPUT:
+           RETVAL
+
+#if OPENSSL_VERSION_NUMBER >= 0x0090806fL && !defined(OPENSSL_NO_TLSEXT)
+
+void
+SSL_set_tlsext_host_name(ssl, name)
+        SSL *ssl
+        const char *name
+
+#endif
+
+MODULE = Crypt::SSLeay        PACKAGE = Crypt::SSLeay::X509        PREFIX = X509_
+
+void
+X509_free(cert)
+       X509* cert
+
+SV*
+subject_name(cert)
+        X509* cert
+        PREINIT:
+           char* str;
+        CODE:
+           str = X509_NAME_oneline(X509_get_subject_name(cert), NULL, 0);
+           RETVAL = newSVpv(str, 0);
+           CRYPT_SSLEAY_free(str);
+        OUTPUT:
+           RETVAL
+
+SV*
+issuer_name(cert)
+        X509* cert
+        PREINIT:
+           char* str;
+        CODE:
+           str = X509_NAME_oneline(X509_get_issuer_name(cert), NULL, 0);
+           RETVAL = newSVpv(str, 0);
+           CRYPT_SSLEAY_free(str);
+        OUTPUT:
+           RETVAL
+
+char *
+get_notBeforeString(cert)
+         X509* cert
+         CODE:
+            RETVAL = (char *)X509_get_notBefore(cert)->data;
+         OUTPUT:
+            RETVAL
+
+char *
+get_notAfterString(cert)
+         X509* cert
+         CODE:
+            RETVAL = (char *)X509_get_notAfter(cert)->data;
+         OUTPUT:
+            RETVAL
+
+MODULE = Crypt::SSLeay      PACKAGE = Crypt::SSLeay::Version    PREFIX = VERSION_
+
+const char *
+VERSION_openssl_version()
+    CODE:
+        RETVAL = SSLeay_version(SSLEAY_VERSION);
+    OUTPUT:
+        RETVAL
+
+long
+VERSION_openssl_version_number()
+    CODE:
+        RETVAL = OPENSSL_VERSION_NUMBER;
+    OUTPUT:
+        RETVAL
+
+const char *
+VERSION_openssl_cflags()
+    CODE:
+        RETVAL = SSLeay_version(SSLEAY_CFLAGS);
+    OUTPUT:
+        RETVAL
+
+const char *
+VERSION_openssl_platform()
+    CODE:
+        RETVAL = SSLeay_version(SSLEAY_PLATFORM);
+    OUTPUT:
+        RETVAL
+
+const char *
+VERSION_openssl_built_on()
+    CODE:
+        RETVAL = SSLeay_version(SSLEAY_BUILT_ON);
+    OUTPUT:
+        RETVAL
+
+const char *
+VERSION_openssl_dir()
+    CODE:
+        RETVAL = SSLeay_version(SSLEAY_DIR);
+    OUTPUT:
+        RETVAL
+
+

build/perl_modules_req.txt

+IPC::Shareable 1.13
+Crypt::SSLeay 0.72
+Crypt::OpenSSL::Guess
+Crypt::OpenSSL::Random
+Crypt::OpenSSL::Bignum
+Crypt::OpenSSL::RSA
+AnyEvent 7.17
 Path::Class
 ExtUtils::CBuilder
 Imager::File::PNG 0.99|--configure-args="--libpath=/opt/thirdlane/perl_lib/local/usr/lib --incpath=/opt/thirdlane/perl_lib/local/usr/include"
-AnyEvent 7.17|--notest|--force
 Module::CoreList
 Filter::Crypto::CryptFile 2.09
-Crypt::OpenSSL::Guess
 Net::SSLeay
 CryptX 0.044
 Crypt::Blowfish
@@ -14,10 +19,7 @@ Crypt::Password 0.28|--notest|--force
 Crypt::Primes 0.50
 Crypt::RC4 2.02
 Crypt::Random 1.25
-Crypt::OpenSSL::RSA
-Crypt::OpenSSL::Bignum
 UUID 0.28
-Crypt::SSLeay
 Compress::Raw::Zlib 2.087|--notest|--force
 DBD::mysql
 Convert::ASN1 0.27
@@ -45,7 +47,6 @@ Text::QRCode 0.05
 HTML::QRCode 0.01
 Imager::QRCode 0.035
 Async::Interrupt 1.25
-IPC::Shareable 0.61
 B::Lint 1.20|--notest|--force
 B::FindAmpersand 0.04|--notest|--force
 Devel::SawAmpersand 0.33|--notest|--force
@@ -108,7 +109,6 @@ CPAN::Meta::Requirements 2.140
 CPAN::DistnameInfo 0.12
 YAML::Tiny 1.70
 File::Copy::Recursive 0.38
-AnyEvent 7.04
 AnyEvent::DBI 2.2
 AnyEvent::HTTP 2.15
 App::cpanminus 1.5021

build/test_net_ssleay.pl

+#!/usr/bin/env perl
+
+use Net::SSLeay qw(die_now die_if_ssl_error get_https post_https sslcat make_headers make_form);
+Net::SSLeay::load_error_strings();
+Net::SSLeay::SSLeay_add_ssl_algorithms();    # Important!
+Net::SSLeay::ENGINE_load_builtin_engines();  # If you want built-in engines
+Net::SSLeay::ENGINE_register_all_complete(); # If you want built-in engines
+Net::SSLeay::randomize();
+ 
+($page) = get_https('www.bacus.pt', 443, '/');                 # Case 1

opt/thirdlane/perl_lib/local/dist/lib/perl5/IPC/Shareable.pm

 package IPC::Shareable;
 
-require 5.00503;
+use warnings;
 use strict;
+
+require 5.00503;
+
+use Carp qw(croak confess carp);
+use Data::Dumper;
 use IPC::Semaphore;
 use IPC::Shareable::SharedMem;
 use IPC::SysV qw(
@@ -10,38 +15,47 @@ use IPC::SysV qw(
     IPC_EXCL
     IPC_NOWAIT
     SEM_UNDO
-                 );
-use Storable 0.6 qw(
-                    freeze
-                    thaw
-                    );
+);
+use JSON qw(-convert_blessed_universally);
 use Scalar::Util;
+use String::CRC32;
+use Storable 0.6 qw(freeze thaw);
+
+our $VERSION = '1.13';
+
+use constant {
+    LOCK_SH               => 1,
+    LOCK_EX               => 2,
+    LOCK_NB               => 4,
+    LOCK_UN               => 8,
+
+    DEBUGGING             => ($ENV{SHAREABLE_DEBUG} or 0),
 
-use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
+    SHM_BUFSIZ            => 65536,
+    SEM_MARKER            => 0,
+    SHM_EXISTS            => 1,
 
-$VERSION = 0.61;
+    SHMMAX_BYTES          => 1073741824, # 1 GB
 
-use constant LOCK_SH => 1;
-use constant LOCK_EX => 2;
-use constant LOCK_NB => 4;
-use constant LOCK_UN => 8;
+    # Perl sends in a double as opposed to an integer to shmat(), and on some
+    # systems, this causes the IPC system to round down to the maximum integer
+    # size of 0x80000000 we correct that when generating keys with CRC32
+
+    MAX_KEY_INT_SIZE      => 0x80000000,
+
+    EXCLUSIVE_CHECK_LIMIT => 10, # Number of times we'll check for existing segs
+};
 
 require Exporter;
-@ISA = 'Exporter';
-@EXPORT = ();
-@EXPORT_OK = qw(LOCK_EX LOCK_SH LOCK_NB LOCK_UN);
-%EXPORT_TAGS = (
+our @ISA = 'Exporter';
+our @EXPORT_OK = qw(LOCK_EX LOCK_SH LOCK_NB LOCK_UN);
+our %EXPORT_TAGS = (
     all     => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )],
     lock    => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )],
-        'flock' => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )],
+    flock   => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )],
 );
 Exporter::export_ok_tags('all', 'lock', 'flock');
 
-use constant DEBUGGING     => ($ENV{SHAREABLE_DEBUG} or 0);
-use constant SHM_BUFSIZ    =>  65536;
-use constant SEM_MARKER    =>  0;
-use constant SHM_EXISTS    =>  1;
-
 # Locking scheme copied from IPC::ShareLite -- ltl
 my %semop_args = (
     (LOCK_EX),
@@ -77,655 +91,887 @@ my %semop_args = (
     ],
 );
 
-my %Def_Opts = (
+my %default_options = (
     key        => IPC_PRIVATE,
-                create    => '',
-                exclusive => '',
-                destroy   => '',
+    create     => 0,
+    exclusive  => 0,
+    destroy    => 0,
     mode       => 0666,
     size       => SHM_BUFSIZ,
-                );
-
-# XXX Perl seems to garbage collect nested referents before we're done with them
-# XXX This cache holds a reference to things until END() is called
+    protected  => 0,
+    limit      => 1,
+    graceful   => 0,
+    warn       => 0,
+    tidy       => 0,
+    serializer => 'storable',
+);
 
-my %Global_Reg;
-my %Proc_Reg;
+my %global_register;
+my %process_register;
+my %used_ids;
 
 sub _trace;
 sub _debug;
 
-###############################################################################
-                                                                 # Debug mark
-
-# --- Public methods
-sub shlock {
-    _trace @_                                                    if DEBUGGING;
-    my ($self, $typelock) = @_;
-    ($typelock = LOCK_EX) unless defined $typelock;
-
-    return $self->shunlock if ($typelock & LOCK_UN);
-
-    return 1 if ($self->{_lock} & $typelock);
-
-    # If they have a different lock than they want, release it first
-    $self->shunlock if ($self->{_lock});
-
-    my $sem = $self->{_sem};
-    _debug "Attempting type=", $typelock, " lock on", $self->{_shm}, 
-        "via", $sem->id                                         if DEBUGGING;
-    my $return_val = $sem->op(@{ $semop_args{$typelock} });
-    if ($return_val) {
-        $self->{_lock} = $typelock;
-        _debug "Got lock on", $self->{_shm}, "via", $sem->id    if DEBUGGING;
-
-        $self->{_data} = _thaw($self->{_shm}),
-
-    } else {
-        _debug "Failed lock on", $self->{_shm}, "via", $sem->id if DEBUGGING;
-    }
-    return $return_val;
-}
-
-sub shunlock {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
-
-    return 1 unless $self->{_lock};
-    if ($self->{_was_changed}) {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!\n";
-        };
-        $self->{_was_changed} = 0;
-    }
-    my $sem = $self->{_sem};
-    _debug "Freeing lock on", $self->{_shm}, "via", $sem->id     if DEBUGGING;
-    my $typelock = $self->{_lock} | LOCK_UN;
-    $typelock ^= LOCK_NB if ($typelock & LOCK_NB);
-    $sem->op(@{ $semop_args{$typelock} });
-
-    $self->{_lock} = 0;
-    _debug "Lock on", $self->{_shm}, "via", $sem->id, "freed"    if DEBUGGING;
-
-    1;
-}
-
 # --- "Magic" methods
 sub TIESCALAR {
-    _trace @_                                                    if DEBUGGING;
-    return _tie(SCALAR => @_);
+    return _tie('SCALAR', @_);
 }
-
 sub TIEARRAY {
-    _trace @_                                                    if DEBUGGING;
-    return _tie(ARRAY => @_);
+    return _tie('ARRAY', @_);
 }
-
 sub TIEHASH {
-    _trace @_                                                    if DEBUGGING;
-    return _tie(HASH => @_);
+    return _tie('HASH', @_);
 }
-
 sub STORE {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    my $sid = $self->{_shm}->{_id};
+    if (! exists $global_register{$knot->seg->id}) {
+        $global_register{$knot->seg->id} = $knot;
+    }
 
-    $Global_Reg{$self->{_shm}->id} ||= $self;
+    $knot->{_data} = $knot->_decode($knot->seg) unless ($knot->{_lock});
 
-    $self->{_data} = _thaw($self->{_shm}) unless ($self->{_lock});
-  TYPE: {
-      if ($self->{_type} eq 'SCALAR') {
-          my $val = shift;
-          _mg_tie($self => $val) if _need_tie($val);
-          $self->{_data} = \$val;
-          last TYPE;
+    if ($knot->{_type} eq 'HASH') {
+        my ($key, $val) = @_;
+        _mg_tie($knot, $val, $key) if $knot->_need_tie($val, $key);
+        $knot->{_data}{$key} = $val;
     }
-      if ($self->{_type} eq 'ARRAY') {
-          my $i   = shift;
-          my $val = shift;
-          _mg_tie($self => $val) if _need_tie($val);
-          $self->{_data}->[$i] = $val;
-          last TYPE;
+    elsif ($knot->{_type} eq 'ARRAY') {
+        my ($i, $val) = @_;
+        _mg_tie($knot, $val, $i) if $knot->_need_tie($val, $i);
+        $knot->{_data}[$i] = $val;
     }
-      if ($self->{_type} eq 'HASH') {
-          my $key = shift;
-          my $val = shift;
-          _mg_tie($self => $val) if _need_tie($val);
-          $self->{_data}->{$key} = $val;
-          last TYPE;
+    elsif ($knot->{_type} eq 'SCALAR') {
+        my ($val) = @_;
+        _mg_tie($knot, $val) if $knot->_need_tie($val);
+        $knot->{_data} = \$val;
     }
-      require Carp;
-      Carp::croak "Variables of type $self->{_type} not supported";
+    else {
+        croak "Variables of type $knot->{_type} not supported";
     }
 
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!\n";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!\n";
+        }
     }
+
     return 1;
 }
-
 sub FETCH {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    $Global_Reg{$self->{_shm}->id} ||= $self;
+    if (! exists $global_register{$knot->seg->id}) {
+        $global_register{$knot->seg->id} = $knot;
+    }
 
     my $data;
-    if ($self->{_lock} || $self->{_iterating}) {
-        $self->{_iterating} = ''; # In case we break out
-        $data = $self->{_data};
+    if ($knot->{_lock} || $knot->{_iterating}) {
+        $knot->{_iterating} = 0; # In case we break out
+        $data = $knot->{_data};
     } else {
-        $data = _thaw($self->{_shm});
-        $self->{_data} = $data;
+        $data = $knot->_decode($knot->seg);
+        $knot->{_data} = $data;
     }
 
     my $val;
-  TYPE: {
-      if ($self->{_type} eq 'SCALAR') {
+
+    if ($knot->{_type} eq 'HASH') {
         if (defined $data) {
-              $val = $$data;
-              last TYPE;
+            my $key = shift;
+            $val = $data->{$key};
         } else {
             return;
         }
     }
-      if ($self->{_type} eq 'ARRAY') {
+    elsif ($knot->{_type} eq 'ARRAY') {
         if (defined $data) {
             my $i = shift;
             $val = $data->[$i];
-              last TYPE;
         } else {
             return;
         }
     }
-      if ($self->{_type} eq 'HASH') {
+    elsif ($knot->{_type} eq 'SCALAR') {
         if (defined $data) {
-              my $key = shift;
-              $val = $data->{$key};
-              last TYPE;
+            $val = $$data;
         } else {
             return;
         }
     }
-      require Carp;
-      Carp::croak "Variables of type $self->{_type} not supported";
+    else {
+        croak "Variables of type $knot->{_type} not supported";
     }
 
     if (my $inner = _is_kid($val)) {
-        my $s = $inner->{_shm};
-        $inner->{_data} = _thaw($s);
+        my $s = $inner->seg;
+        $inner->{_data} = $knot->_decode($s);
     }
     return $val;
 
 }
-
 sub CLEAR {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    if ($self->{_type} eq 'ARRAY') {
-        $self->{_data} = [ ];
-    } elsif ($self->{_type} eq 'HASH') {
-        $self->{_data} = { };
-    } else {
-        require Carp;
-        Carp::croak "Attempt to clear non-aggegrate";
+    if ($knot->{_type} eq 'HASH') {
+        $knot->{_data} = { };
+    }
+    elsif ($knot->{_type} eq 'ARRAY') {
+        $knot->{_data} = [ ];
     }
 
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    else {
+        croak "Attempt to clear non-aggegrate";
+    }
+
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
 }
-
 sub DELETE {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
     my $key  = shift;
 
-    $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock};
-    my $val = delete $self->{_data}->{$key};
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    $knot->{_data} = $knot->_decode($knot->seg) unless $knot->{_lock};
+    my $val = delete $knot->{_data}->{$key};
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
 
     return $val;
 }
-
 sub EXISTS {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
     my $key  = shift;
 
-    $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock};
-    return exists $self->{_data}->{$key};
+    $knot->{_data} = $knot->_decode($knot->seg) unless $knot->{_lock};
+    return exists $knot->{_data}->{$key};
 }
-
 sub FIRSTKEY {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
-    my $key  = shift;
+    my $knot = shift;
 
-    _debug "setting hash iterator on", $self->{_shm}->id         if DEBUGGING;
-    $self->{_iterating} = 1;
-    $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock};
-    my $reset = keys %{$self->{_data}};
-    my $first = each %{$self->{_data}};
+    $knot->{_iterating} = 1;
+    $knot->{_data} = $knot->_decode($knot->seg) unless $knot->{_lock};
+    my $reset = keys %{$knot->{_data}};
+    my $first = each %{$knot->{_data}};
     return $first;
 }
-
 sub NEXTKEY {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
     # caveat emptor if hash was changed by another process
-    my $next = each %{$self->{_data}};
+    my $next = each %{$knot->{_data}};
     if (not defined $next) {
-        _debug "resetting hash iterator on", $self->{_shm}->id   if DEBUGGING;
-        $self->{_iterating} = '';
+        $knot->{_iterating} = 0;
         return;
     } else {
-        $self->{_iterating} = 1;
+        $knot->{_iterating} = 1;
         return $next;
     }
 }
-
 sub EXTEND {
-    _trace @_                                                    if DEBUGGING;
     #XXX Noop
 }
-
 sub PUSH {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    $Global_Reg{$self->{_shm}->id} ||= $self;
-    $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock};
+    if (! exists $global_register{$knot->seg->id}) {
+        $global_register{$knot->seg->id} = $knot;
+    }
+
+    $knot->{_data} = $knot->_decode($knot->seg, $knot->{_data}) unless $knot->{_lock};
 
-    push @{$self->{_data}} => @_;
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    push @{$knot->{_data}}, @_;
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
         };
     }
 }
-
 sub POP {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock};
+    $knot->{_data} = $knot->_decode($knot->seg, $knot->{_data}) unless $knot->{_lock};
 
-    my $val = pop @{$self->{_data}};
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    my $val = pop @{$knot->{_data}};
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
     return $val;
 }
-
 sub SHIFT {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock};
-    my $val = shift @{$self->{_data}};
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    $knot->{_data} = $knot->_decode($knot->seg, $knot->{_data}) unless $knot->{_lock};
+    my $val = shift @{$knot->{_data}};
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
     return $val;
 }
-
 sub UNSHIFT {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock};
-    my $val = unshift @{$self->{_data}} => @_;
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    $knot->{_data} = $knot->_decode($knot->seg, $knot->{_data}) unless $knot->{_lock};
+    my $val = unshift @{$knot->{_data}}, @_;
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
     return $val;
 }
-
 sub SPLICE {
-    _trace @_                                                    if DEBUGGING;
-    my($self, $off, $n, @av) = @_;
+    my($knot, $off, $n, @av) = @_;
 
-    $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock};
-    my @val = splice @{$self->{_data}}, $off, $n => @av;
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    $knot->{_data} = $knot->_decode($knot->seg, $knot->{_data}) unless $knot->{_lock};
+    my @val = splice @{$knot->{_data}}, $off, $n, @av;
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
     return @val;
 }
-
 sub FETCHSIZE {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock};
-    return scalar(@{$self->{_data}});
+    $knot->{_data} = $knot->_decode($knot->seg) unless $knot->{_lock};
+    return scalar(@{$knot->{_data}});
 }
-
 sub STORESIZE {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
     my $n    = shift;
 
-    $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock};
-    $#{$self->{_data}} = $n - 1;
-    if ($self->{_lock} & LOCK_EX) {
-        $self->{_was_changed} = 1;
+    $knot->{_data} = $knot->_decode($knot->seg) unless $knot->{_lock};
+    $#{$knot->{_data}} = $n - 1;
+    if ($knot->{_lock} & LOCK_EX) {
+        $knot->{_was_changed} = 1;
     } else {
-        defined _freeze($self->{_shm} => $self->{_data}) or do {
-            require Carp;
-            Carp::croak "Could not write to shared memory: $!";
-        };
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!";
+        }
     }
     return $n;
 }
 
+# --- Public methods
+
+sub new {
+    my ($class, %opts) = @_;
+
+    my $type = $opts{var} || 'HASH';
+
+    if ($type eq 'HASH') {
+        my $k = tie my %h, 'IPC::Shareable', \%opts;
+        return \%h;
+    }
+    if ($type eq 'ARRAY') {
+        my $k = tie my @a, 'IPC::Shareable', \%opts;
+        return \@a;
+    }
+    if ($type eq 'SCALAR') {
+        my $k = tie my $s, 'IPC::Shareable', \%opts;
+        return \$s;
+    }
+}
+sub global_register {
+     # This is a ridiculous way to do this, but if we don't call Dumper, hashes
+    # that are created in a separate process than the parent hash don't
+    # show up properly in the global register. t/81
+
+    local $SIG{__WARN__} = sub {
+        my ($warning) = @_;
+        if ($warning !~ /hash after insertion/) {
+            warn $warning;
+        }
+    };
+
+    Dumper \%global_register;
+
+    return \%global_register;
+}
+sub process_register {
+    return \%process_register;
+}
+
+sub attributes {
+    my ($knot, $attr) = @_;
+
+    my $attrs = $knot->{attributes};
+
+    if (defined $attr) {
+        return $knot->{attributes}{$attr};
+    }
+    else {
+        return $knot->{attributes};
+    }
+}
+sub ipcs {
+    my $count = `ipcs -m | wc -l`;
+    chomp $count;
+    return int($count);
+}
+sub lock {
+    my ($knot, $flags) = @_;
+    $flags = LOCK_EX if ! defined $flags;
+
+    return $knot->unlock if ($flags & LOCK_UN);
+
+    return 1 if ($knot->{_lock} & $flags);
+
+    # If they have a different lock than they want, release it first
+    $knot->unlock if ($knot->{_lock});
+
+    my $sem = $knot->sem;
+    my $return_val = $sem->op(@{ $semop_args{$flags} });
+    if ($return_val) {
+        $knot->{_lock} = $flags;
+        $knot->{_data} = $knot->_decode($knot->seg),
+    }
+    return $return_val;
+}
+sub unlock {
+    my $knot = shift;
+
+    return 1 unless $knot->{_lock};
+    if ($knot->{_was_changed}) {
+        if (! defined $knot->_encode($knot->seg, $knot->{_data})){
+            croak "Could not write to shared memory: $!\n";
+        }
+        $knot->{_was_changed} = 0;
+    }
+    my $sem = $knot->sem;
+    my $flags = $knot->{_lock} | LOCK_UN;
+    $flags ^= LOCK_NB if ($flags & LOCK_NB);
+    $sem->op(@{ $semop_args{$flags} });
+
+    $knot->{_lock} = 0;
+
+    1;
+}
+*shlock = \&lock;
+*shunlock = \&unlock;
+
 sub clean_up {
-    _trace @_                                                    if DEBUGGING;
     my $class = shift;
 
-    for my $s (values %Proc_Reg) {
-        next unless $s->{_opts}->{_owner} == $$;
+    for my $id (keys %process_register) {
+        my $s = $process_register{$id};
+        next unless $s->attributes('owner') == $$;
+        next if $s->attributes('protected');
         remove($s);
     }
 }
-
 sub clean_up_all {
-    _trace @_                                                    if DEBUGGING;
     my $class = shift;
 
-    for my $s (values %Global_Reg) {
+    my $global_register = __PACKAGE__->global_register;
+
+    for my $id (keys %$global_register) {
+        my $s = $global_register->{$id};
+        next if $s->attributes('protected');
         remove($s);
     }
 }
+sub clean_up_protected {
+    my ($knot, $protect_key);
+
+    if (scalar @_ == 2) {
+        ($knot, $protect_key) = @_;
+    }
+    if (scalar @_ == 1) {
+        ($protect_key) = @_;
+    }
+
+    if (! defined $protect_key) {
+        croak "clean_up_protected() requires a \$protect_key param";
+    }
+
+    if ($protect_key !~ /^\d+$/) {
+        croak
+            "clean_up_protected() \$protect_key must be an integer. You sent $protect_key";
+    }
+
+    my $global_register = __PACKAGE__->global_register;
+
+    for my $id (keys %$global_register) {
+        my $s = $global_register->{$id};
+        my $stored_key = $s->attributes('protected');
 
+        if ($stored_key && $stored_key == $protect_key) {
+            remove($s);
+        }
+    }
+}
 sub remove {
-    _trace @_                                                    if DEBUGGING;
-    my $self = shift;
+    my $knot = shift;
 
-    my $s = $self->{_shm};
+    my $s = $knot->seg;
     my $id = $s->id;
 
-    $s->remove or do {
-        require Carp;
-        Carp::carp "Couldn't remove shared memory segment $id: $!";
-    };
+    $s->remove or warn "Couldn't remove shared memory segment $id: $!";
 
-    $s = $self->{_sem};
-    $s->remove or do {
-        require Carp;
-        Carp::carp "Couldn't remove semaphore set $id: $!";
+    $s = $knot->sem;
+
+    $s->remove or warn "Couldn't remove semaphore set $id: $!";
+
+    delete $process_register{$id};
+    delete $global_register{$id};
+}
+sub seg {
+    my ($knot) = @_;
+    return $knot->{_shm} if defined $knot->{_shm};
+}
+sub sem {
+    my ($knot) = @_;
+    return $knot->{_sem} if defined $knot->{_sem};
+}
+sub singleton {
+
+    # If called with IPC::Shareable::singleton() as opposed to
+    # IPC::Shareable->singleton(), the class isn't sent in. Check
+    # for this and fix it if necessary
+
+    if (! defined $_[0] || $_[0] ne __PACKAGE__) {
+        unshift @_, __PACKAGE__;
+    }
+
+    my ($class, $glue, $warn) = @_;
+
+    if (! defined $glue) {
+        croak "singleton() requires a GLUE parameter";
+    }
+
+    $warn = 0 if ! defined $warn;
+
+    tie my $lock, 'IPC::Shareable', {
+        key         => $glue,
+        create      => 1,
+        exclusive   => 1,
+        graceful    => 1,
+        destroy     => 1,
+        warn        => $warn
     };
-    delete $Proc_Reg{$id};
-    delete $Global_Reg{$id};
+
+    return $$;
 }
 
 END {
-    _trace @_                                                    if DEBUGGING;
-    for my $s (values %Proc_Reg) {
-        shunlock($s);
-        next unless $s->{_opts}->{destroy};
-        next unless $s->{_opts}->{_owner} == $$;
+    _end();
+}
+
+# --- Private methods below
+
+sub _encode {
+    my ($knot, $seg, $data) = @_;
+
+    my $serializer = $knot->attributes('serializer');
+
+    if ($serializer eq 'storable') {
+        return _freeze($seg, $data);
+    }
+    elsif ($serializer eq 'json'){
+        return _encode_json($seg, $data);
+    }
+
+    return undef;
+}
+sub _end {
+    for my $s (values %process_register) {
+        unlock($s);
+        next if $s->attributes('protected');
+        next if ! $s->attributes('destroy');
+        next if $s->attributes('owner') != $$;
         remove($s);
     }
 }
+sub _decode {
+    my ($knot, $seg) = @_;
 
-# --- Private methods below
+    my $serializer = $knot->attributes('serializer');
+
+    if ($serializer eq 'storable') {
+        return _thaw($seg);
+    }
+    elsif ($serializer eq 'json'){
+        return _decode_json($seg);
+    }
+
+    return undef;
+}
+sub _encode_json {
+    my $seg  = shift;
+    my $data = shift;
+
+    my $json = encode_json $data;
+
+    if (length($json) > $seg->size) {
+        croak "Length of shared data exceeds shared segment size";
+    }
+    $seg->shmwrite($json);
+}
+sub _decode_json {
+    my $seg = shift;
+
+    my $json = $seg->shmread;
+
+    return if ! $json;
+
+    # Remove \x{0} after end of string (broke JSON)
+
+    $json =~ s/\x00+//;
+
+#    my $tag = substr $json, 0, 14, '';
+
+#    if ($tag eq 'IPC::Shareable') {
+        my $data = decode_json $json;
+        if (! defined($data)){
+            croak "Munged shared memory segment (size exceeded?)";
+        }
+        return $data;
+#    } else {
+#        return;
+#    }
+}
 sub _freeze {
-    _trace @_                                                    if DEBUGGING;
-    my $s  = shift;
+    my $seg  = shift;
     my $water = shift;
 
     my $ice = freeze $water;
     # Could be a large string.  No need to copy it.  substr more efficient
     substr $ice, 0, 0, 'IPC::Shareable';
 
-    _debug "writing to shm segment ", $s->id, ": ", $ice         if DEBUGGING;
-    if (length($ice) > $s->size) {
-        require Carp;
-        Carp::croak "Length of shared data exceeds shared segment size";
-    };
-    $s->shmwrite($ice);
+    if (length($ice) > $seg->size) {
+        croak "Length of shared data exceeds shared segment size";
+    }
+    $seg->shmwrite($ice);
 }
-
 sub _thaw {
-    _trace @_                                                    if DEBUGGING;
-    my $s = shift;
+    my $seg = shift;
+
+    my $ice = $seg->shmread;
 
-    my $ice = $s->shmread;
-    _debug "read from shm segment ", $s->id, ": ", $ice          if DEBUGGING;
+    return if ! $ice;
 
     my $tag = substr $ice, 0, 14, '';
 
     if ($tag eq 'IPC::Shareable') {
         my $water = thaw $ice;
-        defined($water) or do {
-            require Carp;
-            Carp::croak "Munged shared memory segment (size exceeded?)";
-        };
+        if (! defined($water)){
+            croak "Munged shared memory segment (size exceeded?)";
+        }
         return $water;
     } else {
         return;
     }
 }
-
 sub _tie {
-    _trace @_                                                    if DEBUGGING;
-    my $type  = shift;
-    my $class = shift;
-    my $opts  = _parse_args(@_);
+    my ($type, $class, $key_str, $opts);
 
-    my $key      = _shm_key($opts);
-    my $flags    = _shm_flags($opts);
-    my $shm_size = $opts->{size};
+    if (scalar @_ == 4) {
+        ($type, $class, $key_str, $opts) = @_;
+        $opts->{key} = $key_str;
+    }
+    else {
+        ($type, $class, $opts) = @_;
+    }
 
-    my $s = IPC::Shareable::SharedMem->new($key, $shm_size, $flags);
-    defined $s or do {
-        require Carp;
-        Carp::croak "Could not create shared memory segment: $!\n";
+    $opts  = _parse_args($opts);
+
+    my $knot = bless { attributes => $opts }, $class;
+
+    my $key      = $knot->_shm_key;
+    my $flags    = $knot->_shm_flags;
+    my $shm_size = $knot->attributes('size');
+
+    if ($knot->attributes('limit') && $shm_size > SHMMAX_BYTES) {
+        croak
+            "Shared memory segment size '$shm_size' is larger than max size of " .
+            SHMMAX_BYTES;
+    }
+
+    my $seg;
+
+    if ($knot->attributes('graceful')) {
+        my $exclusive = eval {
+            $seg = IPC::Shareable::SharedMem->new($key, $shm_size, $flags);
+            1;
         };
-    _debug "shared memory id is", $s->id                         if DEBUGGING;
+
+        if (! defined $exclusive) {
+            if ($knot->attributes('warn')) {
+                my $key = lc(sprintf("0x%X", $knot->_shm_key));
+
+                warn "Process ID $$ exited due to exclusive shared memory collision at segment/semaphore key '$key'\n";
+            }
+            exit(0);
+        }
+    }
+    else {
+        $seg = IPC::Shareable::SharedMem->new($key, $shm_size, $flags);
+    }
+
+    if (! defined $seg) {
+        if ($! =~ /Cannot allocate memory/) {
+            croak "\nERROR: Could not create shared memory segment: $!\n\n" .
+                  "Are you using too large a size?";
+        }
+
+        if ($! =~ /No space left on device/) {
+            croak "\nERROR: Could not create shared memory segment: $!\n\n" .
+                "Are you spawning too many segments in a loop?";
+        }
+
+        if (! $knot->attributes('create')) {
+            confess "ERROR: Could not acquire shared memory segment... 'create' ".
+                  "option is not set, and the segment hasn't been created " .
+                  "yet:\n\n $!";
+        }
+        elsif ($knot->attributes('create') && $knot->attributes('exclusive')){
+            croak "ERROR: Could not create shared memory segment. 'create' " .
+                  "and 'exclusive' are set. Does the segment already exist? " .
+                  "\n\n$!";
+        }
+        else {
+            croak "ERROR: Could not create shared memory segment.\n\n$!";
+        }
+    }
 
     my $sem = IPC::Semaphore->new($key, 3, $flags);
-    defined $sem or do {
-        require Carp;
-        Carp::croak "Could not create semaphore set: $!\n";
-    };
-    _debug "semaphore id is", $sem->id                           if DEBUGGING;
+    if (! defined $sem){
+        croak "Could not create semaphore set: $!\n";
+    }
 
-    unless ( $sem->op(@{ $semop_args{(LOCK_SH)} }) ) {
-        require Carp;
-        Carp::croak "Could not obtain semaphore set lock: $!\n";
+    if (! $sem->op(@{ $semop_args{(LOCK_SH)} }) ) {
+        croak "Could not obtain semaphore set lock: $!\n";
     }
-    my $sh = {
-        _iterating => '',
+
+    %$knot = (
+        %$knot,
+        _iterating   => 0,
         _key         => $key,
         _lock        => 0,
-        _opts      => $opts,
-        _shm       => $s,
+        _shm         => $seg,
         _sem         => $sem,
         _type        => $type,
         _was_changed => 0,
-    };
-    $sh->{_data} = _thaw($s),
+    );
 
-    my $there = $sem->getval(SEM_MARKER);
-    if ($there == SHM_EXISTS) {
-        _debug "binding to existing segment on ", $s->id         if DEBUGGING;
-    } else {
-        _debug "brand new segment on ", $s->id                   if DEBUGGING;
-        $Proc_Reg{$sh->{_shm}->id} ||= $sh;
-        $sem->setval(SEM_MARKER, SHM_EXISTS) or do {
+    $knot->{_data} = _thaw($seg);
+
+    if ($sem->getval(SEM_MARKER) != SHM_EXISTS) {
+
+        if (! exists $global_register{$knot->seg->id}) {
+            $global_register{$knot->seg->id} = $knot;
+        }
+
+        $process_register{$knot->seg->id} ||= $knot;
+        if (! $sem->setval(SEM_MARKER, SHM_EXISTS)){
+            croak "Couldn't set semaphore during object creation: $!";
+        }
+    }
+
+    $sem->op(@{ $semop_args{(LOCK_SH|LOCK_UN)} });
+
+    return $knot;
+}
+sub _parse_args {
+    my ($opts) = @_;
+
+    $opts  = defined $opts  ? $opts  : { %default_options };
+
+    for my $k (keys %default_options) {
+        if (not defined $opts->{$k}) {
+            $opts->{$k} = $default_options{$k};
+        }
+        elsif ($opts->{$k} eq 'no') {
+            if ($^W) {
                 require Carp;
-            Carp::croak "Couldn't set semaphore during object creation: $!";
-          };
+                Carp::carp("Use of `no' in IPC::Shareable args is obsolete");
+            }
+
+            $opts->{$k} = 0;
+        }
+    }
+    $opts->{owner} = ($opts->{owner} or $$);
+    $opts->{magic} = ($opts->{magic} or 0);
+    return $opts;
+}
+sub _shm_key {
+    # Generates a 32-bit CRC on the key string. The $key_str parameter is used
+    # for testing only, for purposes of testing various key strings
+
+    my ($knot, $key_str) = @_;
+
+    $key_str //= ($knot->attributes('key') || '');
+
+    my $key;
+
+    if ($key_str eq '') {
+        $key = IPC_PRIVATE;
+    }
+    elsif ($key_str =~ /^\d+$/) {
+        $key = $key_str;
+    }
+    else {
+        $key = crc32($key_str);
+    }
+
+    $used_ids{$key}++;
+
+    if ($key > MAX_KEY_INT_SIZE) {
+        $key = $key - MAX_KEY_INT_SIZE;
+
+        if ($key == 0) {
+            croak "We've calculated a key which equals 0. This is a fatal error";
+        }
     }
 
-    $sem->op(@{ $semop_args{(LOCK_SH|LOCK_UN)} });
+    return $key;
+}
+sub _shm_key_rand {
+    my $key;
+
+    # Unfortunatly, the only way I know how to check if a segment exists is
+    # to actually create it. We must do that here, then remove it just to
+    # ensure the slot is available
+
+    my $verified_exclusive = 0;
+
+    my $check_count = 0;
+
+    while (! $verified_exclusive && $check_count < EXCLUSIVE_CHECK_LIMIT) {
+        $check_count++;
 
-    _debug "IPC::Shareable instance created:", $sh               if DEBUGGING;
+        $key = _shm_key_rand_int();
 
-    return bless $sh => $class;
-}
+        next if $used_ids{$key};
 
-sub _parse_args {
-    _trace @_                                                    if DEBUGGING;
-    my($proto, $opts) = @_;
+        my $flags;
+        $flags |= IPC_CREAT;
+        $flags |= IPC_EXCL;
 
-    $proto = defined $proto ? $proto :  0;
-    $opts  = defined $opts  ? $opts  : { %Def_Opts };
-    if (ref $proto eq 'HASH') {
-        $opts = $proto;
-    } else {
-        $opts->{key} = $proto;
+        my $seg;
+
+        my $shm_slot_available = eval {
+            $seg = IPC::Shareable::SharedMem->new($key, 1, $flags);
+            1;
+        };
+
+        if ($shm_slot_available) {
+            $verified_exclusive = 1;
+            $seg->remove if $seg;
         }
-    for my $k (keys %Def_Opts) {
-        if (not defined $opts->{$k}) {
-            $opts->{$k} = $Def_Opts{$k};
-        } elsif ($opts->{$k} eq 'no') {
-            if ($^W) {
-                require Carp;
-                Carp::carp("Use of `no' in IPC::Shareable args is obsolete");
     }
 
-            $opts->{$k} = '';
+    if (! $verified_exclusive) {
+        croak
+            "_shm_key_rand() can't get an available key after $check_count tries";
     }
-    }
-    $opts->{_owner} = ($opts->{_owner} or $$);
-    $opts->{_magic} = ($opts->{_magic} or '');
-    _debug "options are", $opts                                  if DEBUGGING;
-    return $opts;
-}
 
-sub _shm_key {
-    _trace @_                                                    if DEBUGGING;
-    my $hv = shift;
-    my $val = ($hv->{key} or '');
+    $used_ids{$key}++;
 
-    if ($val eq '') {
-        return IPC_PRIVATE;
-    } elsif ($val =~ /^\d+$/) {
-        return $val;
-    } else {
-        # XXX This only uses the first four characters
-        $val = pack   A4 => $val;
-        $val = unpack i  => $val;
-        return $val;
-    }
+    return $key;
+}
+sub _shm_key_rand_int {
+    srand();
+    return int(rand(1_000_000));
 }
-    
 sub _shm_flags {
     # --- Parses the anonymous hash passed to constructors; returns a list
     # --- of args suitable for passing to shmget
-    _trace @_                                                    if DEBUGGING;
-    my $hv = shift;
+    my ($knot) = @_;
+
     my $flags = 0;
 
-    $flags |= IPC_CREAT if $hv->{create};
-    $flags |= IPC_EXCL  if $hv->{exclusive};
-    $flags |= ($hv->{mode} or 0666);
+    $flags |= IPC_CREAT if $knot->attributes('create');
+    $flags |= IPC_EXCL  if $knot->attributes('exclusive');;
+    $flags |= ($knot->attributes('mode') or 0666);
 
     return $flags;
 }
-
 sub _mg_tie {
-    _trace @_                                                    if DEBUGGING;
-    my $dad = shift;
-    my $val = shift;
+    my ($parent, $val, $identifier) = @_;
 
-    # XXX How to generate a unique id ?
     my $key;
-    if ($dad->{_key} == IPC_PRIVATE) {
+
+    if ($parent->{_key} == IPC_PRIVATE) {
         $key = IPC_PRIVATE;
-    } else {
-        $key = int(rand(1_000_000));
     }
+    else {
+        $key = _shm_key_rand();
+    }
+
     my %opts = (
-                %{$dad->{_opts}},
+        %{ $parent->attributes },
         key       => $key,
-                exclusive => 'yes',
-                create    => 'yes',
-                _magic    => 'yes'
+        exclusive => 1,
+        create    => 1,
+        magic     => 1,
     );
 
     # XXX I wish I didn't have to take a copy of data here and copy it back in
     # XXX Also, have to peek inside potential objects to see their implementation
-    my $kid;
-    my $type = Scalar::Util::reftype( $val ) || '';
-    if ($type eq "SCALAR") {
-        my $copy = $$val;
-        $kid = tie $$val => 'IPC::Shareable', $key, { %opts } or do {
-            require Carp;
-            Carp::croak "Could not create inner tie";
-        };
-        $$val = $copy;
-    } elsif ($type eq "ARRAY") {
-        my @copy = @$val;
-        $kid = tie @$val => 'IPC::Shareable', $key, { %opts } or do {
-            require Carp;
-            Carp::croak "Could not create inner tie";
-        };
-        @$val = @copy;
-    } elsif ($type eq "HASH") {
+    my $child;
+    my $type = Scalar::Util::reftype($val) || '';
+
+    if ($type eq "HASH") {
         my %copy = %$val;
-        $kid = tie %$val => 'IPC::Shareable', $key, { %opts } or do {
-            require Carp;
-            Carp::croak "Could not create inner tie";
-        };
+        $child = tie %$val, 'IPC::Shareable', $key, { %opts };
+        croak "Could not create inner tie" if ! $child;
+
+        _reset_segment($parent, $identifier) if $opts{tidy};
+
         %$val = %copy;
-    } else {
-        require Carp;
-        Carp::croak "Variables of type $type not implemented";
     }
+    elsif ($type eq "ARRAY") {
+        my @copy = @$val;
+        $child = tie @$val, 'IPC::Shareable', $key, { %opts };
+        croak "Could not create inner tie" if ! $child;
 
-    return $kid;
-}
+        _reset_segment($parent, $identifier) if $opts{tidy};
+
+        @$val = @copy;
+    }
+    elsif ($type eq "SCALAR") {
+        my $copy = $$val;
+        $child = tie $$val, 'IPC::Shareable', $key, { %opts };
+        croak "Could not create inner tie" if ! $child;
+
+        $$val = $copy;
+    }
+    else {
+        croak "Variables of type $type not implemented";
+    }
 
+    return $child;
+}
 sub _is_kid {
     my $data = shift or return;
 
@@ -733,34 +979,59 @@ sub _is_kid {
     return unless $type;
 
     my $obj;
+
     if ($type eq "HASH") {
         $obj = tied %$data;
-    } elsif ($type eq "ARRAY") { 
+    }
+    elsif ($type eq "ARRAY") {
         $obj = tied @$data;
-    } elsif ($type eq "SCALAR") {
+    }
+    elsif ($type eq "SCALAR") {
         $obj = tied $$data;
     }
 
     if (ref $obj eq 'IPC::Shareable') {
         return $obj;
-    } else {
+    }
+
     return;
+}
+sub _need_tie {
+    my ($knot, $val, $identifier) = @_;
+
+    my $type = Scalar::Util::reftype($val);
+    return 0 if ! $type;
+
+    my $need_tie;
+
+    if ($type eq "HASH") {
+        $need_tie = !(tied %$val);
+    }
+    elsif ($type eq "ARRAY") {
+        $need_tie = !(tied @$val);
     }
+    elsif ($type eq "SCALAR") {
+        $need_tie = !(tied $$val);
+    }
+
+    return $need_tie ? 1 : 0;
 }
+sub _reset_segment {
+    my ($parent, $id) = @_;
 
-sub _need_tie {
-    my $val = shift;
+    my $parent_type = Scalar::Util::reftype($parent->{_data}) || '';
 
-    my $type = Scalar::Util::reftype( $val );
-    return unless $type;
-    if ($type eq "SCALAR") {
-        return !(tied $$val);
-    } elsif ($type eq "ARRAY") {
-        return !(tied @$val);
-    } elsif ($type eq "HASH") {
-        return !(tied %$val);
-    } else {
-        return;
+    if ($parent_type eq 'HASH') {
+        my $data = $parent->{_data};
+        if (exists $data->{$id} && keys %{ $data->{$id} } && tied %{ $data->{$id} }) {
+            (tied %{ $parent->{_data}{$id} })->remove;
+        }
+    }
+    elsif ($parent_type eq 'ARRAY') {
+        my $data = $parent->{_data};
+        if (exists $data->[$id] && tied @{ $data->[$id] }) {
+            (tied @{ $parent->{_data}[$id] })->remove;
+        }
     }
 }
 
@@ -774,14 +1045,13 @@ sub _trace {
         my $obj;
         if (ref eq 'IPC::Shareable') {
             '        ' . "\$_[$i] = $_: shmid: $_->{_shm}->{_id}; " .
-                Data::Dumper->Dump([ $_->{_opts} ], [ 'opts' ]);
+                Data::Dumper->Dump([ $_->attributes ], [ 'opts' ]);
         } else {
             '        ' . Data::Dumper->Dump( [ $_ ] => [ "\_[$i]" ]);
         }
     }  @_;
     Carp::carp "IPC::Shareable ($$) debug:\n", $caller, @msg;
 }
-
 sub _debug {
     require Carp;
     require Data::Dumper;
@@ -791,13 +1061,15 @@ sub _debug {
         my $obj;
         if (ref eq 'IPC::Shareable') {
             '        ' . "$_: shmid: $_->{_shm}->{_id}; " .
-                Data::Dumper->Dump([ $_->{_opts} ], [ 'opts' ]);
-        } else {
+                Data::Dumper->Dump([ $_->attributes ], [ 'opts' ]);
+        }
+        else {
             '        ' . Data::Dumper::Dumper($_);
         }
     }  @_;
     Carp::carp "IPC::Shareable ($$) debug:\n", $caller, @msg;
-};
+}
+sub _placeholder {}
 
 1;
 
@@ -805,380 +1077,552 @@ __END__
 
 =head1 NAME
 
-IPC::Shareable - share Perl variables between processes
+IPC::Shareable - Use shared memory backed variables across processes
+
+=for html
+<a href="https://github.com/stevieb9/ipc-shareable/actions"><img src="https://github.com/stevieb9/ipc-shareable/workflows/CI/badge.svg"/></a>
+<a href='https://coveralls.io/github/stevieb9/ipc-shareable?branch=master'><img src='https://coveralls.io/repos/stevieb9/ipc-shareable/badge.svg?branch=master&service=github' alt='Coverage Status' /></a>
+
 
 =head1 SYNOPSIS
 
- use IPC::Shareable (':lock');
- tie SCALAR, 'IPC::Shareable', GLUE, OPTIONS;
- tie ARRAY,  'IPC::Shareable', GLUE, OPTIONS;
- tie HASH,   'IPC::Shareable', GLUE, OPTIONS;
+    use IPC::Shareable qw(:lock);
 
- (tied VARIABLE)->shlock;
- (tied VARIABLE)->shunlock;
+    my $href = IPC::Shareable->new(%options);
 
- (tied VARIABLE)->shlock(LOCK_SH|LOCK_NB) 
-        or print "resource unavailable\n";
+    # ...or
 
- (tied VARIABLE)->remove;
+    tie SCALAR, 'IPC::Shareable', OPTIONS;
+    tie ARRAY,  'IPC::Shareable', OPTIONS;
+    tie HASH,   'IPC::Shareable', OPTIONS;
 
- IPC::Shareable->clean_up;
- IPC::Shareable->clean_up_all;
+    tied(VARIABLE)->lock;
+    tied(VARIABLE)->unlock;
+
+    tied(VARIABLE)->lock(LOCK_SH|LOCK_NB)
+        or print "Resource unavailable\n";
+
+    my $segment   = tied(VARIABLE)->seg;
+    my $semaphore = tied(VARIABLE)->sem;
 
-=head1 CONVENTIONS
+    tied(VARIABLE)->remove;
 
-The occurrence of a number in square brackets, as in [N], in the text
-of this document refers to a numbered note in the L</NOTES>.
+    IPC::Shareable::clean_up;
+    IPC::Shareable::clean_up_all;
+    IPC::Shareable::clean_up_protected;
+
+    # Ensure only one instance of a script can be run at any time
+
+    IPC::Shareable->singleton('UNIQUE SCRIPT LOCK STRING');
+
+    # Get the actual IPC::Shareable tied object
+
+    my $knot = tied(VARIABLE); # Dereference first if using a tied reference
 
 =head1 DESCRIPTION
 
 IPC::Shareable allows you to tie a variable to shared memory making it
-easy to share the contents of that variable with other Perl processes.
-Scalars, arrays, and hashes can be tied.  The variable being tied may
-contain arbitrarily complex data structures - including references to
+easy to share the contents of that variable with other Perl processes and
+scripts.
+
+Scalars, arrays, hashes and even objects can be tied. The variable being
+tied may contain arbitrarily complex data structures - including references to
 arrays, hashes of hashes, etc.
 
 The association between variables in distinct processes is provided by
-GLUE.  This is an integer number or 4 character string[1] that serves
-as a common identifier for data across process space.  Hence the
-statement
+GLUE (aka "key").  This is any arbitrary string or integer that serves as a
+common identifier for data across process space.  Hence the statement:
 
- tie $scalar, 'IPC::Shareable', 'data';
+    tie my $scalar, 'IPC::Shareable', { key => 'GLUE STRING', create => 1 };
 
-in program one and the statement
+...in program one and the statement
 
- tie $variable, 'IPC::Shareable', 'data';
+    tie my $variable, 'IPC::Shareable', { key => 'GLUE STRING' };
 
-in program two will bind $scalar in program one and $variable in
-program two.
+...in program two will create and bind C<$scalar> the shared memory in program
+one and bind it to C<$variable> in program two.
 
 There is no pre-set limit to the number of processes that can bind to
 data; nor is there a pre-set limit to the complexity of the underlying
-data of the tied variables[2].  The amount of data that can be shared
+data of the tied variables.  The amount of data that can be shared
 within a single bound variable is limited by the system's maximum size
 for a shared memory segment (the exact value is system-dependent).
 
 The bound data structures are all linearized (using Raphael Manfredi's
-Storable module) before being slurped into shared memory.  Upon
-retrieval, the original format of the data structure is recovered.
+L<Storable> module or optionally L<JSON>) before being slurped into shared
+memory.  Upon retrieval, the original format of the data structure is recovered.
 Semaphore flags can be used for locking data between competing processes.
 
 =head1 OPTIONS
 
-Options are specified by passing a reference to a hash as the fourth
-argument to the tie() function that enchants a variable.
-Alternatively you can pass a reference to a hash as the third
-argument; IPC::Shareable will then look at the field named B<key> in
-this hash for the value of GLUE.  So,
+Options are specified by passing a reference to a hash as the third argument to
+the C<tie()> function that enchants a variable.
 
- tie $variable, 'IPC::Shareable', 'data', \%options;
+The following fields are recognized in the options hash:
 
-is equivalent to
+=head2 key
 
- tie $variable, 'IPC::Shareable', { key => 'data', ... };
+B<key> is the GLUE that is a direct reference to the shared memory segment
+that's to be tied to the variable.
 
-Boolean option values can be specified using a value that evaluates to
-either true or false in the Perl sense.
+If this option is missing, we'll default to using C<IPC_PRIVATE>. This
+default key will not allow sharing of the variable between processes.
 
-NOTE: Earlier versions allowed you to use the word B<yes> for true and
-the word B<no> for false, but support for this "feature" is being
-removed.  B<yes> will still act as true (since it is true, in the Perl
-sense), but use of the word B<no> now emits an (optional) warning and
-then converts to a false value.  This warning will become mandatory in a
-future release and then at some later date the use of B<no> will
-stop working altogether.
+Default: B<IPC_PRIVATE>
 
-The following fields are recognized in the options hash.
+=head2 create
 
-=over 4
+B<create> is used to control whether the process creates a new shared
+memory segment or not.  If B<create> is set to a true value,
+L<IPC::Shareable> will create a new binding associated with GLUE as
+needed.  If B<create> is false, L<IPC::Shareable> will not attempt to
+create a new shared memory segment associated with GLUE.  In this
+case, a shared memory segment associated with GLUE must already exist
+or we'll C<croak()>.
 
-=item B<key>
+Defult: B<false>
 
-The B<key> field is used to determine the GLUE when using the
-three-argument form of the call to tie().  This argument is then, in
-turn, used as the KEY argument in subsequent calls to shmget() and
-semget().
+=head2 exclusive
 
-The default value is IPC_PRIVATE, meaning that your variables cannot
-be shared with other processes.
+If B<exclusive> field is set to a true value, we will C<croak()> if the data
+binding associated with GLUE already exists.  If set to a false value, calls to
+C<tie()> will succeed even if a shared memory segment associated with GLUE
+already exists.
 
-=item B<create>
+See L</graceful> for a silent, non-exception exit if a second process attempts
+to obtain an in-use C<exclusive> segment.
 
-B<create> is used to control whether calls to tie() create new shared
-memory segments or not.  If B<create> is set to a true value,
-IPC::Shareable will create a new binding associated with GLUE as
-needed.  If B<create> is false, IPC::Shareable will not attempt to
-create a new shared memory segment associated with GLUE.  In this
-case, a shared memory segment associated with GLUE must already exist
-or the call to tie() will fail and return undef.  The default is
-false.
+Default: B<false>
+
+=head2 graceful
+
+If B<exclusive> is set to a true value, we normally C<croak()> if a second
+process attempts to obtain the same shared memory segment. Set B<graceful>
+to true and we'll C<exit> silently and gracefully. This option does nothing
+if C<exclusive> isn't set.
 
-=item B<exclusive>
+Useful for ensuring only a single process is running at a time.
 
-If B<exclusive> field is set to a true value, calls to tie() will fail
-(returning undef) if a data binding associated with GLUE already
-exists.  If set to a false value, calls to tie() will succeed even if
-a shared memory segment associated with GLUE already exists.  The
-default is false
+Default: B<false>
 
-=item B<mode>
+=head2 warn
 
-The I<mode> argument is an octal number specifying the access
+When set to a true value, B<graceful> will output a warning if there are
+process collisions.
+
+Default: B<false>
+
+=head2 mode
+
+The B<mode> argument is an octal number specifying the access
 permissions when a new data binding is being created.  These access
-permission are the same as file access permissions in that 0666 is
-world readable, 0600 is readable only by the effective UID of the
-process creating the shared variable, etc.  The default is 0666 (world
-readable and writable).
+permission are the same as file access permissions in that C<0666> is
+world readable, C<0600> is readable only by the effective UID of the
+process creating the shared variable, etc.
+
+Default: B<0666> (world read and writeable)
+
+=head2 size
+
+This field may be used to specify the size of the shared memory segment
+allocated.
+
+The maximum size we allow by default is ~1GB. See the L</limit> option to
+override this default.
+
+Default: C<IPC::Shareable::SHM_BUFSIZ()> (ie. B<65536>)
+
+=head2 protected
+
+If set, the C<clean_up()> and C<clean_up_all()> routines will not remove the
+segments or semaphores related to the tied object.
+
+Set this to a specific integer so we can pass the value to any child objects
+created under the main one.
+
+To clean up protected objects, call
+C<< (tied %object)->clean_up_protected(integer) >>, where 'integer' is the
+value you set the C<protected> option to. You can call this cleanup routine in
+the script you created the segment, or anywhere else, at any time.
 
-=item B<destroy>
+Default: B<0>
+
+=head2 limit
+
+This field will allow you to set a segment size larger than the default maximum
+which is 1,073,741,824 bytes (approximately 1 GB). If set, we will
+C<croak()> if a size specified is larger than the maximum. If it's set to a
+false value, we'll C<croak()> if you send in a size larger than the total
+system RAM.
+
+Default: B<true>
+
+=head2 destroy
 
 If set to a true value, the shared memory segment underlying the data
-binding will be removed when the process calling tie() exits
-(gracefully)[3].  Use this option with care.  In particular
-you should not use this option in a program that will fork
-after binding the data.  On the other hand, shared memory is
-a finite resource and should be released if it is not needed.
-The default is false 
+binding will be removed when the process that initialized the shared memory
+segment exits (gracefully)[1].
 
-=item B<size>
+Only those memory segments that were created by the current process will be
+removed.
 
-This field may be used to specify the size of the shared memory
-segment allocated.  The default is IPC::Shareable::SHM_BUFSIZ().
+Use this option with care. In particular you should not use this option in a
+program that will fork after binding the data.  On the other hand, shared memory
+is a finite resource and should be released if it is not needed.
 
-=back
+B<NOTE>: If the segment was created with its L</protected> attribute set,
+it will not be removed upon program completion, even if C<destroy> is set.
 
-Default values for options are
+Default: B<false>
 
- key       => IPC_PRIVATE,
+=head2 tidy
+
+For long running processes, set this to a true value to clean up unneeded
+segments from nested data structures. Comes with a slight performance hit.
+
+Default: B<false>
+
+=head2 serializer
+
+By default, we use L<Storable> as the data serializer when writing to or
+reading from the shared memory segments we create. For cross-platform and
+cross-language purposes, you can optionally use L<JSON> for this task.
+
+Send in either C<json> or C<storable> as the value to use the respective
+serializer.
+
+Default: B<storable>
+
+=head2 Default Option Values
+
+Default values for options are:
+
+    key         => IPC_PRIVATE, # 0
     create      => 0,
     exclusive   => 0,
+    mode        => 0666,
+    size        => IPC::Shareable::SHM_BUFSIZ(), # 65536
+    protected   => 0,
+    limit       => 1,
     destroy     => 0,
- mode      => 0,
- size      => IPC::Shareable::SHM_BUFSIZ(),
+    graceful    => 0,
+    warn        => 0,
+    tidy        => 0,
+    serializer  => 'storable',
+
+=head1 METHODS
+
+=head2 new
+
+Instantiates and returns a reference to a hash backed by shared memory.
+
+    my $href = IPC::Shareable->new(key => "testing", create => 1);
+
+    $href=>{a} = 1;
+
+    # Call tied() on the dereferenced variable to access object methods
+    # and information
+
+    tied(%$href)->ipcs;
+
+Parameters:
+
+Hash, Optional: See the L</OPTIONS> section for a list of all available options.
+Most often, you'll want to send in the B<key> and B<create> options.
+
+It is possible to get a reference to an array or scalar as well. Simply send in
+either C<< var = > 'ARRAY' >> or C<< var => 'SCALAR' >> to do so.
+
+Return: A reference to a hash (or array or scalar) which is backed by shared
+memory.
+
+=head2 singleton($glue, $warn)
+
+Class method that ensures that only a single instance of a script can be run
+at any given time.
+
+Parameters:
+
+    $glue
+
+Mandatory, String: The key/glue that identifies the shared memory segment.
+
+    $warn
+
+Optional, Bool: Send in a true value to have subsequent processes throw a
+warning that there's been a shared memory violation and that it will exit.
+
+Default: B<false>
+
+=head2 ipcs
+
+Returns the number of instantiated shared memory segments that currently exist
+on the system. This isn't precise; it simply does a C<wc -l> line count on your
+system's C<ipcs -m> call. It is guaranteed though to produce reliable results.
+
+Return: Integer
+
+=head2 lock($flags)
+
+Obtains a lock on the shared memory. C<$flags> specifies the type
+of lock to acquire.  If C<$flags> is not specified, an exclusive
+read/write lock is obtained.  Acceptable values for C<$flags> are
+the same as for the C<flock()> system call.
+
+Returns C<true> on success, and C<undef> on error. For non-blocking calls
+(see below), the method returns C<0> if it would have blocked.
+
+Obtain an exclusive lock like this:
+
+        tied(%var)->lock(LOCK_EX); # same as default
+
+Only one process can hold an exclusive lock on the shared memory at a given
+time.
+
+Obtain a shared (read) lock:
+
+        tied(%var)->lock(LOCK_SH);
+
+Multiple processes can hold a shared (read) lock at a given time.  If a process
+attempts to obtain an exclusive lock while one or more processes hold
+shared locks, it will be blocked until they have all finished.
+
+Either of the locks may be specified as non-blocking:
+
+        tied(%var)->lock( LOCK_EX|LOCK_NB );
+        tied(%var)->lock( LOCK_SH|LOCK_NB );
+
+A non-blocking lock request will return C<0> if it would have had to
+wait to obtain the lock.
+
+Note that these locks are advisory (just like flock), meaning that
+all cooperating processes must coordinate their accesses to shared memory
+using these calls in order for locking to work.  See the C<flock()> call for
+details.
+
+Locks are inherited through forks, which means that two processes actually
+can possess an exclusive lock at the same time. Don't do that.
+
+The constants C<LOCK_EX>, C<LOCK_SH>, C<LOCK_NB>, and C<LOCK_UN> are available
+for import using any of the following export tags:
+
+        use IPC::Shareable qw(:lock);
+        use IPC::Shareable qw(:flock);
+        use IPC::Shareable qw(:all);
+
+Or, just use the flock constants available in the Fcntl module.
+
+See L</LOCKING> for further details.
+
+=head2 unlock
+
+Removes a lock. Takes no parameters, returns C<true> on success.
+
+This is equivalent of calling C<shlock(LOCK_UN)>.
+
+See L</LOCKING> for further details.
+
+=head2 seg
+
+Called on either the tied variable or the tie object, returns the shared
+memory segment object currently in use.
+
+=head2 sem
+
+Called on either the tied variable or the tie object, returns the semaphore
+object related to the memory segment currently in use.
+
+=head2 attributes
+
+Retrieves the list of attributes that drive the L<IPC::Shareable> object.
+
+Parameters:
+
+    $attribute
+
+Optional, String: The name of the attribute. If sent in, we'll return the value
+of this specific attribute. Returns C<undef> if the attribute isn't found.
+
+Attributes are the C<OPTIONS> that were used to create the object.
+
+Returns: A hash reference of all attributes if C<$attributes> isn't sent in, the
+value of the specific attribute if it is.
+
+=head2 global_register
+
+Returns a hash reference of hashes of all in-use shared memory segments across
+all processes. The key is the memory segment ID, and the value is the segment
+and semaphore objects.
+
+=head2 process_register
+
+Returns a hash reference of hashes of all in-use shared memory segments created
+by the calling process. The key is the memory segment ID, and the value is the
+segment and semaphore objects.
 
 =head1 LOCKING
 
 IPC::Shareable provides methods to implement application-level
 advisory locking of the shared data structures.  These methods are
-called shlock() and shunlock().  To use them you must first get the
+called C<lock()> and C<unlock()>. To use them you must first get the
 object underlying the tied variable, either by saving the return
-value of the original call to tie() or by using the built-in tied()
+value of the original call to C<tie()> or by using the built-in C<tied()>
 function.
 
-To lock a variable, do this:
+To lock and subsequently unlock a variable, do this:
 
- $knot = tie $sv, 'IPC::Shareable', $glue, { %options };
- ...
- $knot->shlock;
-
-or equivalently
+    my $knot = tie my %hash, 'IPC::Shareable', { %options };
 
- tie($scalar, 'IPC::Shareable', $glue, { %options });
- (tied $scalar)->shlock;
-
-This will place an exclusive lock on the data of $scalar.  You can
-also get shared locks or attempt to get a lock without blocking.
-IPC::Shareable makes the constants LOCK_EX, LOCK_SH, LOCK_UN, and
-LOCK_NB exportable to your address space with the export tags
-C<:lock>, C<:flock>, or C<:all>.  The values should be the same as
-the standard C<flock> option arguments.
-
- if ( (tied $scalar)->shlock(LOCK_SH|LOCK_NB) ) {
-        print "The value is $scalar\n";
-        (tied $scalar)->shunlock;
- } else {
-        print "Another process has an exlusive lock.\n";
- }
+    $knot->lock;
+    $hash{a} = 'foo';
+    $knot->unlock;
 
+or equivalently, if you've decided to throw away the return of C<tie()>:
 
-If no argument is provided to C<shlock>, it defaults to LOCK_EX.  To
-unlock a variable do this:
+    tie my %hash, 'IPC::Shareable', { %options };
 
- $knot->shunlock;
+    tied(%hash)->lock;
+    $hash{a} = 'foo';
+    tied(%hash)->unlock;
 
-or
+This will place an exclusive lock on the data of C<$scalar>.  You can
+also get shared locks or attempt to get a lock without blocking.
 
- (tied $scalar)->shunlock;
+L<IPC::Shareable> makes the constants C<LOCK_EX>, C<LOCK_SH>, C<LOCK_UN>, and
+C<LOCK_NB> exportable to your address space with the export tags C<:lock>,
+C<:flock>, or C<:all>.  The values should be the same as the standard C<flock>
+option arguments.
 
-or
+    if (tied(%hash)->lock(LOCK_SH|LOCK_NB)){
+        print "The value is $hash{a}\n";
+        tied(%hash)->unlock;
+    } else {
+        print "Another process has an exclusive lock.\n";
+    }
 
- $knot->shlock(LOCK_UN);        # Same as calling shunlock
+If no argument is provided to C<lock>, it defaults to C<LOCK_EX>.
 
 There are some pitfalls regarding locking and signals about which you
 should make yourself aware; these are discussed in L</NOTES>.
 
-If you use the advisory locking, IPC::Shareable assumes that you know
-what you are doing and attempts some optimizations.  When you obtain
-a lock, either exclusive or shared, a fetch and thaw of the data is
-performed.  No additional fetch/thaw operations are performed until
-you release the lock and access the bound variable again.  During the
-time that the lock is kept, all accesses are perfomed on the copy in
-program memory.  If other processes do not honor the lock, and update
-the shared memory region unfairly, the process with the lock will not be in
-sync.  In other words, IPC::Shareable does not enforce the lock
-for you.  
-
-A similar optimization is done if you obtain an exclusive lock.
-Updates to the shared memory region will be postponed until you
-release the lock (or downgrade to a shared lock).
-
-Use of locking can significantly improve performance for operations
-such as iterating over an array, retrieving a list from a slice or 
-doing a slice assignment.
-
-=head1 REFERENCES
-
-When a reference to a non-tied scalar, hash, or array is assigned to a
-tie()d variable, IPC::Shareable will attempt to tie() the thingy being
-referenced[4].  This allows disparate processes to see changes to not
-only the top-level variable, but also changes to nested data.  This
-feature is intended to be transparent to the application, but there
-are some caveats to be aware of.
-
-First of all, IPC::Shareable does not (yet) guarantee that the ids
-shared memory segments allocated automagically are unique.  The more
-automagical tie()ing that happens, the greater the chance of a
-collision.
-
-Secondly, since a new shared memory segment is created for each thingy
-being referenced, the liberal use of references could cause the system
-to approach its limit for the total number of shared memory segments
-allowed.
-
-=head1 OBJECTS
-
-IPC::Shareable implements tie()ing objects to shared memory too.
-Since an object is just a reference, the same principles (and caveats)
-apply to tie()ing objects as other reference types.
+Note that in the background, we perform lock optimization when reading and
+writing to the shared storage even if the advisory locks aren't being used.
+
+Using the advisory locks can speed up processes that are doing several writes/
+reads at the same time.
 
 =head1 DESTRUCTION
 
 perl(1) will destroy the object underlying a tied variable when then
-tied variable goes out of scope.  Unfortunately for IPC::Shareable,
+tied variable goes out of scope.  Unfortunately for L<IPC::Shareable>,
 this may not be desirable: other processes may still need a handle on
-the relevant shared memory segment.  IPC::Shareable therefore provides
-an interface to allow the application to control the timing of removal
-of shared memory segments.  The interface consists of three methods -
-remove(), clean_up(), and clean_up_all() - and the B<destroy> option
-to tie().
+the relevant shared memory segment.
 
-=over 4
+L<IPC::Shareable> therefore provides several options to control the timing of
+removal of shared memory segments.
 
-=item B<destroy option>
+=head2 destroy Option
 
 As described in L</OPTIONS>, specifying the B<destroy> option when
-tie()ing a variable coerces IPC::Shareable to remove the underlying
-shared memory segment when the process calling tie() exits gracefully.
-Note that any related shared memory segments created automagically by
-the use of references will also be removed.
+C<tie()>ing a variable coerces L<IPC::Shareable> to remove the underlying
+shared memory segment when the process calling C<tie()> exits gracefully.
+
+B<NOTE>: The destruction is handled in an C<END> block. Only those memory
+segments that are tied to the current process will be removed.
 
-=item B<remove()>
+B<NOTE>: If the segment was created with its L</protected> attribute set,
+it will not be removed in the C<END> block, even if C<destroy> is set.
 
- (tied $var)->remove;
+=head2 remove
 
-Calling remove() on the object underlying a tie()d variable removes
-the associated shared memory segment.  The segment is removed
+    tied($var)->remove;
+
+    # or
+
+    $knot->remove;
+
+Calling C<remove()> on the object underlying a C<tie()>d variable removes
+the associated shared memory segments.  The segment is removed
 irrespective of whether it has the B<destroy> option set or not and
 irrespective of whether the calling process created the segment.
 
-=item B<clean_up()>
+=head2 clean_up
 
     IPC::Shareable->clean_up;
 
-This is a class method that provokes IPC::Shareable to remove all
+    # or
+
+    tied($var)->clean_up;
+
+    # or
+
+    $knot->clean_up;
+
+This is a class method that provokes L<IPC::Shareable> to remove all
 shared memory segments created by the process.  Segments not created
 by the calling process are not removed.
 
-=item B<clean_up_all()>
+This method will not clean up segments created with the C<protected> option.
+
+=head2 clean_up_all
 
     IPC::Shareable->clean_up_all;
 
-This is a class method that provokes IPC::Shareable to remove all
+    # or
+
+    tied($var)->clean_up_all;
+
+    # or
+
+    $knot->clean_up_all
+
+This is a class method that provokes L<IPC::Shareable> to remove all
 shared memory segments encountered by the process.  Segments are
 removed even if they were not created by the calling process.
 
-=back
+This method will not clean up segments created with the C<protected> option.
 
-=head1 EXAMPLES
+=head2 clean_up_protected($protect_key)
 
-In a file called B<server>:
+If a segment is created with the C<protected> option, it, nor its children will
+be removed during calls of C<clean_up()> or C<clean_up_all()>.
 
- #!/usr/bin/perl -w
- use strict;
- use IPC::Shareable;
- my $glue = 'data';
- my %options = (
-     create    => 'yes',
-     exclusive => 0,
-     mode      => 0644,
-     destroy   => 'yes',
- );
- my %colours;
- tie %colours, 'IPC::Shareable', $glue, { %options } or
-     die "server: tie failed\n";
- %colours = (
-     red => [
-         'fire truck',
-         'leaves in the fall',
-     ],
-     blue => [
-         'sky',
-         'police cars',
-     ],
- );
- ((print "server: there are 2 colours\n"), sleep 5)
-     while scalar keys %colours == 2;
- print "server: here are all my colours:\n";
- foreach my $c (keys %colours) {
-     print "server: these are $c: ",
-         join(', ', @{$colours{$c}}), "\n";
- }
- exit;
-
-In a file called B<client>
-
- #!/usr/bin/perl -w
- use strict;
- use IPC::Shareable;
- my $glue = 'data';
- my %options = (
-     create    => 0,
-     exclusive => 0,
-     mode      => 0644,
-     destroy   => 0,
-     );
- my %colours;
- tie %colours, 'IPC::Shareable', $glue, { %options } or
-     die "client: tie failed\n";
- foreach my $c (keys %colours) {
-     print "client: these are $c: ",
-         join(', ', @{$colours{$c}}), "\n";
- }
- delete $colours{'red'};
- exit;
-
-And here is the output (the sleep commands in the command line prevent
-the output from being interrupted by shell prompts):
-
- bash$ ( ./server & ) ; sleep 10 ; ./client ; sleep 10
- server: there are 2 colours
- server: there are 2 colours
- server: there are 2 colours
- client: these are blue: sky, police cars
- client: these are red: fire truck, leaves in the fall
- server: here are all my colours:
- server: these are blue: sky, police cars
+When setting L</protected>, you specified a lock key integer. When calling this
+method, you must send that integer in as a parameter so we know which segments
+to clean up.
+
+    my $protect_key = 93432;
+
+    IPC::Shareable->clean_up_protected($protect_key);
+
+    # or
+
+    tied($var)->clean_up_protected($protect_key;
+
+    # or
+
+    $knot->clean_up_protected($protect_key)
+
+Parameters:
+
+    $protect_key
+
+Mandatory, Integer: The integer protect key you assigned wit the C<protected>
+option
 
 =head1 RETURN VALUES
 
-Calls to tie() that try to implement IPC::Shareable will return true
-if successful, I<undef> otherwise.  The value returned is an instance
-of the IPC::Shareable class.
+Calls to C<tie()> that try to implement L<IPC::Shareable> will return an
+instance of C<IPC::Shareable> on success, and C<undef> otherwise.
 
 =head1 AUTHOR
 
 Benjamin Sugars <bsugars@canoe.ca>
 
+=head1 MAINTAINED BY
+
+Steve Bertrand <steveb@cpan.org>
+
 =head1 NOTES
 
 =head2 Footnotes from the above sections
@@ -1187,43 +1631,21 @@ Benjamin Sugars <bsugars@canoe.ca>
 
 =item 1
 
-If GLUE is longer than 4 characters, only the 4 most significant
-characters are used.  These characters are turned into integers by
-unpack()ing them.  If GLUE is less than 4 characters, it is space
-padded.
-
-=item 2
-
-IPC::Shareable provides no pre-set limits, but the system does.
-Namely, there are limits on the number of shared memory segments that
-can be allocated and the total amount of memory usable by shared
-memory.
-
-=item 3
-
-If the process has been smoked by an untrapped signal, the binding
-will remain in shared memory.  If you're cautious, you might try
+If the process has been smoked by an untrapped signal, the binding will remain
+in shared memory.  If you're cautious, you might try:
 
  $SIG{INT} = \&catch_int;
  sub catch_int {
      die;
  }
  ...
- tie $variable, IPC::Shareable, 'data', { 'destroy' => 'Yes!' };
+ tie $variable, IPC::Shareable, { key => 'GLUE', create => 1, 'destroy' => 1 };
 
 which will at least clean up after your user hits CTRL-C because
 IPC::Shareable's END method will be called.  Or, maybe you'd like to
 leave the binding in shared memory, so subsequent process can recover
 the data...
 
-=item 4
-
-This behaviour is markedly different from previous versions of
-IPC::Shareable.  Older versions would sometimes tie() referenced
-thingies, and sometimes not.  The new approach is more reliable (I
-think) and predictable (certainly) but uses more shared memory
-segments.
-
 =back
 
 =head2 General Notes
@@ -1232,20 +1654,21 @@ segments.
 
 =item o
 
-When using shlock() to lock a variable, be careful to guard against
-signals.  Under normal circumstances, IPC::Shareable's END method
+When using C<lock()> to lock a variable, be careful to guard against
+signals.  Under normal circumstances, C<IPC::Shareable>'s C<END> method
 unlocks any locked variables when the process exits.  However, if an
 untrapped signal is received while a process holds an exclusive lock,
-DESTROY will not be called and the lock may be maintained even though
+C<END> will not be called and the lock may be maintained even though
 the process has exited.  If this scares you, you might be better off
 implementing your own locking methods.
 
 One advantage of using C<flock> on some known file instead of the
-locking implemented with semaphores in IPC::Shareable is that when a
+locking implemented with semaphores in C<IPC::Shareable> is that when a
 process dies, it automatically releases any locks.  This only happens
-with IPC::Shareable if the process dies gracefully.  The alternative
-is to attempt to account for every possible calamitous ending for your
-process (robust signal handling in Perl is a source of much debate,
+with C<IPC::Shareable> if the process dies gracefully.
+
+The alternative is to attempt to account for every possible calamitous ending
+for your process (robust signal handling in Perl is a source of much debate,
 though it usually works just fine) or to become familiar with your
 system's tools for removing shared memory and semaphores.  This
 concern should be balanced against the significant performance
@@ -1254,15 +1677,37 @@ locking mechanism implemented in IPC::Shareable.
 
 =item o
 
-There is a program called ipcs(1/8) (and ipcrm(1/8)) that is
+There is a program called C<ipcs>(1/8) (and C<ipcrm>(1/8)) that is
 available on at least Solaris and Linux that might be useful for
 cleaning moribund shared memory segments or semaphore sets produced
-by bugs in either IPC::Shareable or applications using it.
+by bugs in either L<IPC::Shareable> or applications using it.
+
+Examples:
+
+    # List all semaphores and memory segments in use on the system
+
+    ipcs -a
+
+    # List all memory segments and semaphores along with each one's associated process ID
+
+    ipcs -ap
+
+    # List just the shared memory segments
+
+    ipcs -m
+
+    # List the details of an individual memory segment
+
+    ipcs -i 12345678
+
+    # Remove *all* semaphores and memory segments
+
+    ipcrm -a
 
 =item o
 
-This version of IPC::Shareable does not understand the format of
-shared memory segments created by versions prior to 0.60.  If you try
+This version of L<IPC::Shareable> does not understand the format of
+shared memory segments created by versions prior to C<0.60>.  If you try
 to tie to such segments, you will get an error.  The only work around
 is to clear the shared memory segments and start with a fresh set.
 
@@ -1270,8 +1715,10 @@ is to clear the shared memory segments and start with a fresh set.
 
 Iterating over a hash causes a special optimization if you have not
 obtained a lock (it is better to obtain a read (or write) lock before
-iterating over a hash tied to Shareable, but we attempt this
-optimization if you do not).  The fetch/thaw operation is performed
+iterating over a hash tied to L<IPC::Shareable>, but we attempt this
+optimization if you do not).
+
+For tied hashes, the C<fetch>/C<thaw> operation is performed
 when the first key is accessed.  Subsequent key and and value
 accesses are done without accessing shared memory.  Doing an
 assignment to the hash or fetching another value between key
@@ -1297,15 +1744,9 @@ Thanks to all those with comments or bug fixes, especially
     Raphael Manfredi    <Raphael_Manfredi@pobox.com>
     Lee Lindley         <Lee.Lindley@bigfoot.com>
     Dave Rolsky         <autarch@urth.org>
-
-=head1 BUGS
-
-Certainly; this is beta software. When you discover an anomaly, send
-an email to me at bsugars@canoe.ca.
+    Steve Bertrand      <steveb@cpan.org>
 
 =head1 SEE ALSO
 
-perl(1), perltie(1), Storable(3), shmget(2), ipcs(1), ipcrm(1)
-and other SysV IPC man pages.
-
-=cut
+L<perltie>, L<Storable>, C<shmget>, C<ipcs>, C<ipcrm> and other SysV IPC manual
+pages.

opt/thirdlane/perl_lib/local/dist/lib/perl5/IPC/Shareable/SharedMem.pm

 package IPC::Shareable::SharedMem;
 
+use warnings;
 use strict;
-use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0);
+
+use Carp qw(carp croak confess);
 use IPC::SysV qw(IPC_RMID);
 
-my $Def_Size = 1024;
-
-sub _trace {
-    require Carp;
-    require Data::Dumper;
-    my $caller = '    ' . (caller(1))[3] . " called with:\n";
-    my $i = -1;
-    my @msg = map {
-        ++$i;
-        '        ' . Data::Dumper->Dump( [ $_ ] => [ "\_[$i]" ]);
-    }  @_;
-    Carp::carp "IPC::SharedMem debug:\n", $caller, @msg;
-}
+our $VERSION = '1.13';
 
-sub _debug {
-    require Carp;
-    require Data::Dumper;
-    local $Data::Dumper::Terse = 1;
-    my $caller = '    ' . (caller(1))[3] . " tells us that:\n";
-    my @msg = map { '        ' . Data::Dumper::Dumper($_) } @_;
-    Carp::carp "IPC::SharedMem debug:\n", $caller, @msg;
-};
+use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0);
+
+my $default_size = 1024;
 
 sub default_size {
-    _trace @_                                                   if DEBUGGING;
     my $class = shift;
-    $Def_Size = shift if @_;
-    return $Def_Size;
+    $default_size = shift if @_;
+    return $default_size;
 }
 
 sub new {
-    _trace @_                                                   if DEBUGGING;
-    my($class, $key, $size, $flags) = @_;
+    my($class, $key, $size, $flags, $type) = @_;
+
     defined $key or do {
-        require Carp;
-        Carp::croak "usage: IPC::SharedMem->new(KEY, [ SIZE,  [ FLAGS ] ])";
+        confess "usage: IPC::SharedMem->new(KEY, [ SIZE,  [ FLAGS ] ])";
     };
-    $size  ||= $Def_Size;
+
+    $size  ||= $default_size;
     $flags ||= 0;
 
-    _debug "calling shmget() on ", $key, $size, $flags          if DEBUGGING;
     my $id = shmget($key, $size, $flags);
+
     defined $id or do {
-        require Carp;
-        Carp::carp "IPC::Shareable::SharedMem: shmget: $!\n";
+        if ($! =~ /File exists/){
+            croak "\nERROR: IPC::Shareable::SharedMem: shmget $key: $!\n\n" .
+                  "Are you using exclusive, but trying to create multiple " .
+                  "instances?\n\n";
+        }
         return undef;
     };
 
     my $sh = {
         _id    => $id,
+        _key   => $key,
         _size  => $size,
         _flags => $flags,
+        _type  => $type,
     };
 
     return bless $sh => $class;
 }
-
 sub id {
-    _trace @_                                                   if DEBUGGING;
     my $self = shift;
 
     $self->{_id} = shift if @_;
     return $self->{_id};
 }
+sub key {
+    my $self = shift;
 
+    $self->{_key} = shift if @_;
+    return $self->{_key};
+}
 sub flags {
-    _trace @_                                                   if DEBUGGING;
     my $self = shift;
 
     $self->{_flags} = shift if @_;
     return $self->{_flags};
 }
-
 sub size {
-    _trace @_                                                   if DEBUGGING;
     my $self = shift;
 
     $self->{_size} = shift if @_;
     return $self->{_size};
 }
+sub type {
+    my $self = shift;
 
+    $self->{_type} = shift if @_;
+    return $self->{_type};
+}
 sub shmwrite {
-    _trace @_                                                   if DEBUGGING;
     my($self, $data) = @_;
-
-    _debug "calling shmwrite() on ", $self->{_id}, $data,
-                                     0, $self->{_size}          if DEBUGGING;
     return shmwrite($self->{_id}, $data, 0, $self->{_size});
 }
-
 sub shmread {
-    _trace @_                                                   if DEBUGGING;
     my $self = shift;
 
     my $data = '';
-    _debug "calling shread() on ", $self->{_id}, $data,
-                                   0, $self->{_size}            if DEBUGGING;
     shmread($self->{_id}, $data, 0, $self->{_size}) or return;
-    _debug "got ", $data, " from shm segment $self->{_id}"      if DEBUGGING;
     return $data;
 }
-
 sub remove {
-    _trace @_                                                   if DEBUGGING;
-    my $self = shift;
-    my $op = shift;
+    my $to_remove = shift;
+
+    my $id;
+
+    if (ref $to_remove eq __PACKAGE__){
+        $id = $to_remove->{_id};
+    }
+
     my $arg = 0;
 
-    return shmctl($self->{_id}, IPC_RMID, $arg);
+    my $ret = shmctl($id, IPC_RMID, $arg);
+    return $ret;
 }
 
 1;
@@ -121,6 +111,11 @@ sub remove {
 
 IPC::Shareable::SharedMem - Object oriented interface to shared memory
 
+=for html
+<a href="https://github.com/stevieb9/ipc-shareable/actions"><img src="https://github.com/stevieb9/ipc-shareable/workflows/CI/badge.svg"/></a>
+<a href='https://coveralls.io/github/stevieb9/ipc-shareable?branch=master'><img src='https://coveralls.io/repos/stevieb9/ipc-shareable/badge.svg?branch=master&service=github' alt='Coverage Status' /></a>
+
+
 =head1 SYNOPSIS
 
  *** No public interface ***
@@ -128,9 +123,7 @@ IPC::Shareable::SharedMem - Object oriented interface to shared memory
 =head1 WARNING
 
 This module is not intended for public consumption.  It is used
-internally by IPC::Shareable to access shared memory.  It will
-probably be replaced soon by IPC::ShareLite or IPC::SharedMem (when
-someone writes it).
+internally by IPC::Shareable to access shared memory.
 
 =head1 DESCRIPTION
 
@@ -144,4 +137,4 @@ Ben Sugars (bsugars@canoe.ca)
 
 =head1 SEE ALSO
 
-IPC::Shareable, IPC::SharedLite
+L<IPC::Shareable>, L<IPC::ShareLite>

opt/thirdlane/perl_lib/local/dist/lib/perl5/IPC/ipc.pl

+use warnings;
+use strict;
+use feature 'say';
+
+use Script::Singleton warn => 1;
+
+sleep 10;

opt/thirdlane/perl_lib/local/dist/lib/perl5/Mock/Sub.pm

+package Mock::Sub;
+use 5.006;
+use strict;
+use warnings;
+
+use Carp qw(confess);
+use Mock::Sub::Child;
+use Scalar::Util qw(weaken);
+
+our $VERSION = '1.09';
+
+my %opts;
+
+sub import {
+    my ($class, %args) = @_;
+    %opts = %args;
+}
+sub new {
+    my $self = bless {}, shift;
+    %{ $self } = @_;
+
+    for (keys %opts){
+        $self->{$_} = $opts{$_};
+    }
+    return $self;
+}
+sub mock {
+    my ($self, $sub, %p) = @_;
+
+    if (ref($self) ne 'Mock::Sub'){
+        confess
+            "calling mock() on the Mock::Sub class is no longer permitted. " .
+            "create a new mock object with Mock::Sub->new;, then call mock " .
+            "with my \$sub_object = \$mock->mock('sub_name'); ";
+    }
+
+    if (! defined wantarray){
+        confess "\n\ncalling mock() in void context isn't allowed. ";
+    }
+
+    my $child = Mock::Sub::Child->new(no_warnings => $self->{no_warnings});
+
+    my $side_effect = defined $p{side_effect}
+        ? $p{side_effect}
+        : $self->{side_effect};
+
+    my $return_value = defined $p{return_value}
+        ? $p{return_value}
+        : $self->{return_value};
+
+    $child->side_effect($side_effect);
+    $child->return_value($return_value);
+
+    $self->{objects}{$sub}{obj} = $child;
+    $child->_mock($sub);
+
+    # remove the REFCNT to the child, or else DESTROY won't be called
+    weaken $self->{objects}{$sub}{obj};
+
+    return $child;
+}
+sub mocked_subs {
+    my $self = shift;
+
+    my @names;
+
+    for (keys %{ $self->{objects} }) {
+        if ($self->mocked_state($_)){
+            push @names, $_;
+        }
+    }
+    return @names;
+}
+sub mocked_objects {
+    my $self = shift;
+
+    my @mocked;
+    for (keys %{ $self->{objects} }){
+        push @mocked, $self->{objects}{$_}{obj};
+    }
+    return @mocked;
+}
+sub mocked_state {
+    my ($self, $sub) = @_;
+
+    if (! $sub){
+        confess "calling mocked_state() on a Mock::Sub object requires a sub " .
+              "name to be passed in as its only parameter. ";
+    }
+
+    eval {
+        my $test = $self->{objects}{$sub}{obj}->mocked_state();
+    };
+    if ($@){
+        confess "can't call mocked_state() on the class if the sub hasn't yet " .
+              "been mocked. ";
+    }
+    return $self->{objects}{$sub}{obj}->mocked_state;
+}
+sub DESTROY {
+}
+sub __end {}; # vim fold placeholder
+
+1;
+=head1 NAME
+
+Mock::Sub - Mock package, object and standard subroutines, with unit testing in mind.
+
+=for html
+<a href="http://travis-ci.org/stevieb9/mock-sub"><img src="https://secure.travis-ci.org/stevieb9/mock-sub.png"/>
+<a href='https://coveralls.io/github/stevieb9/mock-sub?branch=master'><img src='https://coveralls.io/repos/stevieb9/mock-sub/badge.svg?branch=master&service=github' alt='Coverage Status' /></a>
+
+=head1 SYNOPSIS
+
+    # see EXAMPLES for a full use case and caveats
+
+    use Mock::Sub;
+
+    # disable warnings about mocking non-existent subs
+
+    use Mock::Sub no_warnings => 1
+
+    # create the parent mock object
+
+    my $mock = Mock::Sub->new;
+
+    # mock some subs...
+
+    my $foo = $mock->mock('Package::foo');
+    my $bar = $mock->mock('Package::bar');
+
+    # wait until a mocked sub is called
+
+    Package::foo();
+
+    # then...
+
+    $foo->name;         # name of sub that's mocked
+    $foo->called;       # was the sub called?
+    $foo->called_count; # how many times was it called?
+    $foo->called_with;  # array of params sent to sub
+
+    # have the mocked sub return something when it's called (list or scalar).
+
+    $foo->return_value(1, 2, {a => 1});
+    my @return = Package::foo;
+
+    # have the mocked sub perform an action
+
+    $foo->side_effect( sub { die "eval catch" if @_; } );
+
+    eval { Package::foo(1); };
+    like ($@, qr/eval catch/, "side_effect worked with params");
+
+    # extract the parameters the sub was called with (if return_value or
+    # side_effect is not used, we will return the parameters that were sent into
+    # the mocked sub (list or scalar context)
+
+    my @args = $foo->called_with;
+
+    # reset the mock object for re-use within the same scope
+
+    $foo->reset;
+
+    # restore original functionality to the sub
+
+    $foo->unmock;
+
+    # re-mock a previously unmock()ed sub
+
+    $foo->remock;
+
+    # check if a sub is mocked
+
+    my $state = $foo->mocked_state;
+
+    # mock out a CORE:: function. Be warned that this *must* be done within
+    # compile stage (BEGIN), and the function can NOT be unmocked prior
+    # to the completion of program execution
+
+    my ($mock, $caller);
+
+    BEGIN {
+        $mock = Mock::Sub->new;
+        $caller = $mock->mock('caller');
+    };
+
+    $caller->return_value(55);
+    caller(); # mocked caller() called
+
+=head1 DESCRIPTION
+
+Easy to use and very lightweight module for mocking out sub calls.
+Very useful for testing areas of your own modules where getting coverage may
+be difficult due to nothing to test against, and/or to reduce test run time by
+eliminating the need to call subs that you really don't want or need to test.
+
+=head1 EXAMPLE
+
+Here's a full example to get further coverage where it's difficult if not
+impossible to test certain areas of your code (eg: you have if/else statements,
+but they don't do anything but call other subs. You don't want to test the
+subs that are called, nor do you want to add statements to your code).
+
+Note that if the end subroutine you're testing is NOT Object Oriented (and
+you're importing them into your module that you're testing), you have to mock
+them as part of your own namespace (ie. instead of Other::first, you'd mock
+MyModule::first).
+
+   # module you're testing:
+
+    package MyPackage;
+    
+    use Other;
+    use Exporter qw(import);
+    @EXPORT_OK = qw(test);
+   
+    my $other = Other->new;
+
+    sub test {
+        my $arg = shift;
+        
+        if ($arg == 1){
+            # how do you test this?... there's no return etc.
+            $other->first();        
+        }
+        if ($arg == 2){
+            $other->second();
+        }
+    }
+
+    # your test file
+
+    use MyPackage qw(test);
+    use Mock::Sub;
+    use Test::More tests => 2;
+
+    my $mock = Mock::Sub->new;
+
+    my $first = $mock->mock('Other::first');
+    my $second = $mock->mock('Other::second');
+
+    # coverage for first if() in MyPackage::test
+    test(1);
+    is ($first->called, 1, "1st if() statement covered");
+
+    # coverage for second if()
+    test(2);
+    is ($second->called, 1, "2nd if() statement covered");
+
+=head1 MOCK OBJECT METHODS
+
+=head2 C<new(%opts)>
+
+Instantiates and returns a new C<Mock::Sub> object, ready to be used to start
+creating mocked sub objects.
+
+Optional options:
+
+=over 4
+
+=item C<return_value =E<gt> $scalar>
+
+Set this to have all mocked subs created with this mock object return anything
+you wish (accepts a single scalar only. See C<return_value()> method to return
+a list and for further information). You can also set it in individual mocks
+only (see C<return_value()> method).
+
+=item C<side_effect =E<gt> $cref>
+
+Set this in C<new()> to have the side effect passed into all child mocks
+created with this object. See C<side_effect()> method.
+
+=back
+
+=head2 C<mock('sub', %opts)>
+
+Instantiates and returns a new mock object on each call. 'sub' is the name of
+the subroutine to mock (requires full package name if the sub isn't in
+C<main::>).
+
+The mocked sub will return the parameters sent into the mocked sub if a return
+value isn't set, or a side effect doesn't return anything, if available. If
+in scalar context but a list was sent in, we'll return the first parameter in
+the list. In list context, we simply receive the parameters as they were sent
+in.
+
+Optional parameters:
+
+See C<new()> for a description of the parameters. Both the C<return_value> and
+C<side_effect> parameters can be set in this method to individualize each mock
+object, and will override the global configuration if set in C<new()>.
+
+There's also C<return_value()> and C<side_effect()> methods if you want to
+set, change or remove these values after instantiation of a child sub object.
+
+=head2 mocked_subs
+
+Returns a list of all the names of the subs that are currently mocked under
+the parent mock object.
+
+=head2 mocked_objects
+
+Returns a list of all sub objects underneath the parent mock object, regardless
+if its sub is currently mocked or not.
+
+=head2 mocked_state('Sub::Name')
+
+Returns 1 if the sub currently under the parent mock object is mocked or not,
+and 0 if not. Croaks if there hasn't been a child sub object created with this
+sub name.
+
+=head1 SUB OBJECT METHODS
+
+These methods are for the children mocked sub objects returned from the
+parent mock object. See L<MOCK OBJECT METHODS> for methods related
+to the parent mock object.
+
+=head2 C<unmock>
+
+Restores the original functionality back to the sub, and runs C<reset()> on
+the object.
+
+=head2 C<remock>
+
+Re-mocks the sub within the object after calling C<unmock> on it (accepts the
+side_effect and return_value parameters).
+
+=head2 C<called>
+
+Returns true (1) if the sub being mocked has been called, and false (0) if not.
+
+=head2 C<called_count>
+
+Returns the number of times the mocked sub has been called.
+
+=head2 C<called_with>
+
+Returns an array of the parameters sent to the subroutine. C<confess()s> if
+we're called before the mocked sub has been called.
+
+=head2 C<mocked_state>
+
+Returns true (1) if the sub the object refers to is currently mocked, and
+false (0) if not.
+
+=head2 C<name>
+
+Returns the name of the sub being mocked.
+
+=head2 C<side_effect($cref)>
+
+Add (or change/delete) a side effect after instantiation.
+
+Send in a code reference containing an action you'd like the
+mocked sub to perform.
+
+The side effect function will receive all parameters sent into the mocked sub.
+
+You can use both C<side_effect()> and C<return_value()> params at the same
+time. C<side_effect> will be run first, and then C<return_value>. Note that if
+C<side_effect>'s last expression evaluates to any value whatsoever
+(even false), it will return that and C<return_value> will be skipped.
+
+To work around this and have the side_effect run but still get the
+return_value thereafter, write your cref to evaluate undef as the last thing
+it does: C<sub { ...; undef; }>.
+
+=head2 C<return_value>
+
+Add (or change/delete) the mocked sub's return value after instantiation.
+Can be a scalar or list. Send in C<undef> to remove previously set values.
+
+=head2 C<reset>
+
+Resets the functional parameters (C<return_value>, C<side_effect>), along
+with C<called()> and C<called_count()> back to undef/false. Does not restore
+the sub back to its original state.
+
+=head1 NOTES
+
+This module has a backwards parent-child relationship. To use, you create a
+mock object using L</MOCK OBJECT METHODS> C<new> and C<mock> methods,
+thereafter, you use the returned mocked sub object L</SUB OBJECT METHODS> to
+perform the work.
+
+The parent mock object retains certain information and statistics of the child
+mocked objects (and the subs themselves).
+
+To mock CORE::GLOBAL functions, you *must* initiate within a C<BEGIN> block
+(see C<SYNOPSIS> for details). It is important that if you mock a CORE sub,
+it can't and won't be returned to its original state until after the entire
+program process tree exists. Period.
+
+I didn't make this a C<Test::> module (although it started that way) because
+I can see more uses than placing it into that category.
+
+=head1 AUTHOR
+
+Steve Bertrand, C<< <steveb at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or requests at
+L<https://github.com/stevieb9/mock-sub/issues>
+
+=head1 REPOSITORY
+
+L<https://github.com/stevieb9/mock-sub>
+
+=head1 BUILD RESULTS
+
+CPAN Testers: L<http://matrix.cpantesters.org/?dist=Mock-Sub>
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc Mock::Sub
+
+=head1 ACKNOWLEDGEMENTS
+
+Python's MagicMock module.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2016 Steve Bertrand.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See L<http://dev.perl.org/licenses/> for more information.
+
+
+=cut
+
+1; # End of Mock::Sub
+

opt/thirdlane/perl_lib/local/dist/lib/perl5/Mock/Sub/Child.pm

+package Mock::Sub::Child;
+use 5.006;
+use strict;
+use warnings;
+
+use Carp qw(confess);
+use Scalar::Util qw(weaken);
+
+our $VERSION = '1.09';
+
+sub new {
+    my $self = bless {}, shift;
+    %{ $self } = @_;
+
+    if ($self->{side_effect}){
+        $self->_check_side_effect($self->{side_effect});
+    }
+    return $self;
+}
+sub _mock {
+    my $self = shift;
+
+    # throw away the sub name if it's sent in and we're not called
+    # by Mock::Sub::mock()
+
+    my $sub_passed_in;
+    if ($_[0] && $_[0] =~ /::/){
+        $sub_passed_in = 1;
+    }
+
+    my $caller = (caller(1))[3] || '';
+    
+    if ($caller ne 'Mock::Sub::mock' && $sub_passed_in){
+        undef @_;
+        if(ref($self) eq 'Mock::Sub::Child' && ! $self->{name}){
+            confess "can't call mock() on a child object before it is already " .
+                  "initialized with the parent mock object. ";
+        }
+    }
+
+    if ($caller ne 'Mock::Sub::mock' && $caller ne 'Mock::Sub::Child::remock'){
+        confess "the _mock() method is not a public API call. For re-mocking " .
+              "an existing sub in an existing sub object, use remock().\n";
+    }
+
+    my $sub = $self->name || shift;
+
+    my %p = @_;
+    for (keys %p){
+        $self->{$_} = $p{$_};
+    }
+
+    if ($sub !~ /::/) {
+        my $core_sub = "CORE::" . $sub;
+
+        if (defined &$core_sub && ${^GLOBAL_PHASE} eq 'START') {
+            warn "WARNING! we're attempting to override a global core " .
+                 "function. You will NOT be able to restore functionality " .
+                 "to this function.";
+
+            $sub = "CORE::GLOBAL::" . $sub;
+        }
+        else {
+            $sub = "main::$sub" if $sub !~ /::/;
+        }
+    }
+
+    my $fake;
+
+    if (! exists &$sub && $sub !~ /CORE::GLOBAL/) {
+        $fake = 1;
+        if (! $self->_no_warn) {
+            warn "\n\nWARNING!: we've mocked a non-existent subroutine. ".
+                    "the specified sub does not exist.\n\n";
+        }
+    }
+
+    $self->_check_side_effect($self->{side_effect});
+
+    if (defined $self->{return_value}){
+        push @{ $self->{return} }, $self->{return_value};
+    }
+
+    $self->{name} = $sub;
+    $self->{orig} = \&$sub if ! $fake;
+
+    $self->{called_count} = 0;
+
+    {
+        no strict 'refs';
+        no warnings 'redefine';
+
+        my $mock = $self;
+        weaken $mock;
+
+        *$sub = sub {
+
+            @{ $mock->{called_with} } = @_;
+            ++$mock->{called_count};
+
+            if ($mock->{side_effect}) {
+                if (wantarray){
+                    my @effect = $mock->{side_effect}->(@_);
+                    return @effect if @effect;
+                }
+                else {
+                    my $effect = $mock->{side_effect}->(@_);
+                    return $effect if defined $effect;
+                }
+            }
+
+            return if ! defined $mock->{return};
+
+            if ($mock->{return}[0] && $mock->{return}[0] eq 'params'){
+                return ! wantarray ? $_[0] : @_;
+            }
+            else {
+                return ! wantarray && @{ $mock->{return} } == 1
+                    ? $mock->{return}[0]
+                    : @{ $mock->{return} };
+            }
+        };
+    }
+    $self->{state} = 1;
+
+    return $self;
+}
+sub remock {
+    shift->_mock(@_);
+}
+sub unmock {
+    my $self = shift;
+    my $sub = $self->{name};
+
+    {
+        no strict 'refs';
+        no warnings 'redefine';
+
+        if (defined $self->{orig} && $sub !~ /CORE::GLOBAL/) {
+            *$sub = \&{ $self->{orig} };
+        }
+        else {
+            undef *$sub if $self->{name};
+        }
+    }
+
+    $self->{state} = 0;
+    $self->reset;
+}
+sub called {
+    return shift->called_count ? 1 : 0;
+}
+sub called_count {
+    return shift->{called_count} || 0;
+}
+sub called_with {
+    my $self = shift;
+    if (! $self->called){
+        confess "\n\ncan't call called_with() before the mocked sub has " .
+            "been called. ";
+    }
+    return @{ $self->{called_with} };
+}
+sub name {
+    return shift->{name};  
+}
+sub reset {
+    for (qw(side_effect return_value return called called_count called_with)){
+        delete $_[0]->{$_};
+    }
+}
+sub return_value {
+    my $self = shift;
+    @{ $self->{return} } = @_;
+}
+sub side_effect {
+    $_[0]->_check_side_effect($_[1]);
+    $_[0]->{side_effect} = $_[1];
+}
+sub _check_side_effect {
+    if (defined $_[1] && ref $_[1] ne 'CODE') {
+        confess "\n\nside_effect parameter must be a code reference. ";
+    }
+}
+sub mocked_state {
+    return shift->{state};
+}
+sub _no_warn {
+    return $_[0]->{no_warnings};
+}
+sub DESTROY {
+    $_[0]->unmock;
+}
+sub _end {}; # vim fold placeholder
+
+__END__
+
+=head1 NAME
+
+Mock::Sub::Child - Provides for Mock::Sub
+
+=head1 METHODS
+
+Please refer to the C<Mock::Sub> parent module for full documentation. The
+descriptions here are just a briefing.
+
+=head2 new
+
+This method can only be called by the parent C<Mock::Sub> module.
+
+=head2 called
+
+Returns bool whether the mocked sub has been called yet.
+
+=head2 called_count
+
+Returns an integer representing the number of times the mocked sub has been
+called.
+
+=head2 called_with
+
+Returns a list of arguments the mocked sub was called with.
+
+=head2 mock
+
+This method should only be called by the parent mock object. You shouldn't be
+calling this.
+
+=head2 remock
+
+Re-mocks an unmocked sub back to the same subroutine it was originally mocked
+with.
+
+=head2 mocked_state
+
+Returns bool whether the sub the object represents is currently mocked or not.
+
+=head2 name
+
+Returns the name of the sub this object is mocking.
+
+=head2 return_value
+
+Send in any values (list or scalar) that you want the mocked sub to return when
+called.
+
+=head2 side_effect
+
+Send in a code reference with any actions you want the mocked sub to perform
+after it's been called.
+
+=head2 reset
+
+Resets all state of the object back to default (does not unmock the sub).
+
+=head2 unmock
+
+Restores original functionality of the mocked sub, and calls C<reset()> on the
+object.
+
+=cut
+1;
+

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent.pm

@@ -2,8 +2,8 @@
 
 AnyEvent - the DBI of event loop programming
 
-EV, Event, Glib, Tk, Perl, Event::Lib, Irssi, rxvt-unicode, IO::Async, Qt,
-FLTK and POE are various supported event loops/environments.
+EV, Event, Glib, Tk, UV, Perl, Event::Lib, Irssi, rxvt-unicode, IO::Async,
+Qt, FLTK and POE are various supported event loops/environments.
 
 =head1 SYNOPSIS
 
@@ -273,7 +273,7 @@ Example 2: fire an event after 0.5 seconds, then roughly every second.
 
    my $w = AnyEvent->timer (after => 0.5, interval => 1, cb => sub {
       warn "timeout\n";
-   };
+   });
 
 =head3 TIMING ISSUES
 
@@ -489,6 +489,10 @@ Example: fork a process and wait for it
 
    my $done = AnyEvent->condvar;
   
+   # this forks and immediately calls exit in the child. this
+   # normally has all sorts of bad consequences for your parent,
+   # so take this as an example only. always fork and exec,
+   # or call POSIX::_exit, in real code.
    my $pid = fork or exit 5;
   
    my $w = AnyEvent->child (
@@ -747,7 +751,7 @@ one call to C<begin>, so the condvar waits for all calls to C<end> before
 sending.
 
 The ping example mentioned above is slightly more complicated, as the
-there are results to be passwd back, and the number of tasks that are
+there are results to be passed back, and the number of tasks that are
 begun can potentially be zero:
 
    my $cv = AnyEvent->condvar;
@@ -765,6 +769,10 @@ begun can potentially be zero:
 
    $cv->end;
 
+   ...
+
+   my $results = $cv->recv;
+
 This code fragment supposedly pings a number of hosts and calls
 C<send> after results for all then have have been gathered - in any
 order. To achieve this, the code issues a call to C<begin> when it starts
@@ -809,11 +817,15 @@ In list context, all parameters passed to C<send> will be returned,
 in scalar context only the first one will be returned.
 
 Note that doing a blocking wait in a callback is not supported by any
-event loop, that is, recursive invocation of a blocking C<< ->recv
->> is not allowed, and the C<recv> call will C<croak> if such a
-condition is detected. This condition can be slightly loosened by using
-L<Coro::AnyEvent>, which allows you to do a blocking C<< ->recv >> from
-any thread that doesn't run the event loop itself.
+event loop, that is, recursive invocation of a blocking C<< ->recv >> is
+not allowed and the C<recv> call will C<croak> if such a condition is
+detected. This requirement can be dropped by relying on L<Coro::AnyEvent>
+, which allows you to do a blocking C<< ->recv >> from any thread
+that doesn't run the event loop itself. L<Coro::AnyEvent> is loaded
+automatically when L<Coro> is used with L<AnyEvent>, so code does not need
+to do anything special to take advantage of that: any code that would
+normally block your program because it calls C<recv>, be executed in an
+C<async> thread instead without blocking other threads.
 
 Not all event models support a blocking wait - some die in that case
 (programs might want to do that to stay interactive), so I<if you are
@@ -835,8 +847,8 @@ C<croak> have been called.
 
 =item $cb = $cv->cb ($cb->($cv))
 
-This is a mutator function that returns the callback set and optionally
-replaces it before doing so.
+This is a mutator function that returns the callback set (or C<undef> if
+not) and optionally replaces it before doing so.
 
 The callback will be called when the condition becomes "true", i.e. when
 C<send> or C<croak> are called, with the only argument being the
@@ -844,11 +856,16 @@ condition variable itself. If the condition is already true, the
 callback is called immediately when it is set. Calling C<recv> inside
 the callback or at any later time is guaranteed not to block.
 
+Additionally, when the callback is invoked, it is also removed from the
+condvar (reset to C<undef>), so the condvar does not keep a reference to
+the callback after invocation.
+
 =back
 
 =head1 SUPPORTED EVENT LOOPS/BACKENDS
 
-The available backend classes are (every class has its own manpage):
+The following backend classes are part of the AnyEvent distribution (every
+class has its own manpage):
 
 =over 4
 
@@ -873,6 +890,7 @@ create watchers. Nothing special needs to be done by the main program.
    AnyEvent::Impl::Event     based on Event, very stable, few glitches.
    AnyEvent::Impl::Glib      based on Glib, slow but very stable.
    AnyEvent::Impl::Tk        based on Tk, very broken.
+   AnyEvent::Impl::UV        based on UV, innovated square wheels.
    AnyEvent::Impl::EventLib  based on Event::Lib, leaks memory and worse.
    AnyEvent::Impl::POE       based on POE, very slow, some limitations.
    AnyEvent::Impl::Irssi     used when running within irssi.
@@ -907,6 +925,13 @@ AnyEvent knows about both L<Prima> and L<Wx>, however, and will try to
 load L<POE> when detecting them, in the hope that POE will pick them up,
 in which case everything will be automatic.
 
+=item Known event loops outside the AnyEvent distribution
+
+The following event loops or programs support AnyEvent by providing their
+own AnyEvent backend. They will be picked up automatically.
+
+   urxvt::anyevent           available to rxvt-unicode extensions
+
 =back
 
 =head1 GLOBAL VARIABLES AND FUNCTIONS
@@ -947,13 +972,12 @@ Arranges for the code block to be executed as soon as the event model is
 autodetected (or immediately if that has already happened).
 
 The block will be executed I<after> the actual backend has been detected
-(C<$AnyEvent::MODEL> is set), but I<before> any watchers have been
-created, so it is possible to e.g. patch C<@AnyEvent::ISA> or do
-other initialisations - see the sources of L<AnyEvent::Strict> or
+(C<$AnyEvent::MODEL> is set), so it is possible to do some initialisation
+only when AnyEvent is actually initialised - see the sources of
 L<AnyEvent::AIO> to see how this is used.
 
 The most common usage is to create some global watchers, without forcing
-event module detection too early, for example, L<AnyEvent::AIO> creates
+event module detection too early. For example, L<AnyEvent::AIO> creates
 and installs the global L<IO::AIO> watcher in a C<post_detect> block to
 avoid autodetecting the event module at load time.
 
@@ -980,9 +1004,15 @@ C<$WATCHER>, but do so only do so after the event loop is initialised.
 
 =item @AnyEvent::post_detect
 
-If there are any code references in this array (you can C<push> to it
-before or after loading AnyEvent), then they will be called directly
-after the event loop has been chosen.
+This is a lower level interface then C<AnyEvent::post_detect> (the
+function). This variable is mainly useful for modules that can do
+something useful when AnyEvent is used and thus want to know when it
+is initialised, but do not need to even load it by default. This array
+provides the means to hook into AnyEvent passively, without loading it.
+
+Here is how it works: If there are any code references in this array (you
+can C<push> to it before or after loading AnyEvent), then they will be
+called directly after the event loop has been chosen.
 
 You should check C<$AnyEvent::MODEL> before adding to this array, though:
 if it is defined then the event loop has already been detected, and the
@@ -991,11 +1021,6 @@ array will be ignored.
 Best use C<AnyEvent::post_detect { BLOCK }> when your application allows
 it, as it takes care of these details.
 
-This variable is mainly useful for modules that can do something useful
-when AnyEvent is used and thus want to know when it is initialised, but do
-not need to even load it by default. This array provides the means to hook
-into AnyEvent passively, without loading it.
-
 Example: To load Coro::AnyEvent whenever Coro and AnyEvent are used
 together, you could put this into Coro (this is the actual code used by
 Coro to accomplish this):
@@ -1023,7 +1048,7 @@ asynchronously does something for you and returns some transaction
 object or guard to let you cancel the operation. For example,
 C<AnyEvent::Socket::tcp_connect>:
 
-   # start a conenction attempt unless one is active
+   # start a connection attempt unless one is active
    $self->{connect_guard} ||= AnyEvent::Socket::tcp_connect "www.example.net", 80, sub {
       delete $self->{connect_guard};
       ...
@@ -1067,6 +1092,12 @@ creating a logger callback with the C<AnyEvent::Log::logger> function,
 which can reduce typing, codesize and can reduce the logging overhead
 enourmously.
 
+=item AnyEvent::fh_block $filehandle
+
+=item AnyEvent::fh_unblock $filehandle
+
+Sets blocking or non-blocking behaviour for the given filehandle.
+
 =back
 
 =head1 WHAT TO DO IN A MODULE
@@ -1141,24 +1172,24 @@ modules of the AnyEvent author himself :)
 
 =over 4
 
-=item L<AnyEvent::Util>
+=item L<AnyEvent::Util> (part of the AnyEvent distribution)
 
 Contains various utility functions that replace often-used blocking
 functions such as C<inet_aton> with event/callback-based versions.
 
-=item L<AnyEvent::Socket>
+=item L<AnyEvent::Socket> (part of the AnyEvent distribution)
 
 Provides various utility functions for (internet protocol) sockets,
 addresses and name resolution. Also functions to create non-blocking tcp
 connections or tcp servers, with IPv6 and SRV record support and more.
 
-=item L<AnyEvent::Handle>
+=item L<AnyEvent::Handle> (part of the AnyEvent distribution)
 
 Provide read and write buffers, manages watchers for reads and writes,
 supports raw and formatted I/O, I/O queued and fully transparent and
 non-blocking SSL/TLS (via L<AnyEvent::TLS>).
 
-=item L<AnyEvent::DNS>
+=item L<AnyEvent::DNS> (part of the AnyEvent distribution)
 
 Provides rich asynchronous DNS resolver capabilities.
 
@@ -1168,13 +1199,24 @@ Implement event-based interfaces to the protocols of the same name (for
 the curious, IGS is the International Go Server and FCP is the Freenet
 Client Protocol).
 
-=item L<AnyEvent::AIO>
+=item L<AnyEvent::AIO> (part of the AnyEvent distribution)
 
 Truly asynchronous (as opposed to non-blocking) I/O, should be in the
 toolbox of every event programmer. AnyEvent::AIO transparently fuses
 L<IO::AIO> and AnyEvent together, giving AnyEvent access to event-based
 file I/O, and much more.
 
+=item L<AnyEvent::Fork>, L<AnyEvent::Fork::RPC>, L<AnyEvent::Fork::Pool>, L<AnyEvent::Fork::Remote>
+
+These let you safely fork new subprocesses, either locally or
+remotely (e.g.v ia ssh), using some RPC protocol or not, without
+the limitations normally imposed by fork (AnyEvent works fine for
+example). Dynamically-resized worker pools are obviously included as well.
+
+And they are quite tiny and fast as well - "abusing" L<AnyEvent::Fork>
+just to exec external programs can easily beat using C<fork> and C<exec>
+(or even C<system>) in most programs.
+
 =item L<AnyEvent::Filesys::Notify>
 
 AnyEvent is good for non-blocking stuff, but it can't detect file or
@@ -1185,18 +1227,14 @@ some weird, without doubt broken, stuff on OS X to monitor files. It can
 fall back to blocking scans at regular intervals transparently on other
 platforms, so it's about as portable as it gets.
 
-(I haven't used it myself, but I haven't heard anybody complaining about
-it yet).
+(I haven't used it myself, but it seems the biggest problem with it is
+it quite bad performance).
 
 =item L<AnyEvent::DBI>
 
 Executes L<DBI> requests asynchronously in a proxy process for you,
 notifying you in an event-based way when the operation is finished.
 
-=item L<AnyEvent::HTTPD>
-
-A simple embedded webserver.
-
 =item L<AnyEvent::FastPing>
 
 The fastest ping in the west.
@@ -1223,20 +1261,14 @@ to simply invert the flow control - don't call us, we will call you:
 
 package AnyEvent;
 
-# basically a tuned-down version of common::sense
-sub common_sense {
-   # from common:.sense 3.5
-   local $^W;
-   ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x3c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00";
-   # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl)
-   $^H |= 0x00000600;
+BEGIN {
+   require "AnyEvent/constants.pl";
+   &AnyEvent::common_sense;
 }
 
-BEGIN { AnyEvent::common_sense }
-
 use Carp ();
 
-our $VERSION = '7.04';
+our $VERSION = 7.17;
 our $MODEL;
 our @ISA;
 our @REGISTRY;
@@ -1245,8 +1277,6 @@ our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
 our $MAX_SIGNAL_LATENCY = $ENV{PERL_ANYEVENT_MAX_SIGNAL_LATENCY} || 10; # executes after the BEGIN block below (tainting!)
 
 BEGIN {
-   require "AnyEvent/constants.pl";
-
    eval "sub TAINT (){" . (${^TAINT}*1) . "}";
 
    delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
@@ -1345,6 +1375,25 @@ if (length $ENV{PERL_ANYEVENT_LOG}) {
    require AnyEvent::Log; # AnyEvent::Log does the thing for us
 }
 
+BEGIN {
+   *_fh_nonblocking = AnyEvent::WIN32
+      ? sub($$) {
+          ioctl $_[0], 0x8004667e, pack "L", $_[1]; # FIONBIO
+        }
+      : sub($$) {
+          fcntl $_[0], AnyEvent::F_SETFL, $_[1] ? AnyEvent::O_NONBLOCK : 0;
+        }
+   ;
+}
+
+sub fh_block($) {
+   _fh_nonblocking shift, 0
+}
+
+sub fh_unblock($) {
+   _fh_nonblocking shift, 1
+}
+
 our @models = (
    [EV::                   => AnyEvent::Impl::EV::],
    [AnyEvent::Loop::       => AnyEvent::Impl::Perl::],
@@ -1357,6 +1406,7 @@ our @models = (
    # everything below here should not be autoloaded
    [Event::Lib::           => AnyEvent::Impl::EventLib::], # too buggy
    [Tk::                   => AnyEvent::Impl::Tk::],       # crashes with many handles
+   [UV::                   => AnyEvent::Impl::UV::],       # switched from libev, added back all bugs imaginable
    [Qt::                   => AnyEvent::Impl::Qt::],       # requires special main program
    [POE::Kernel::          => AnyEvent::Impl::POE::],      # lasciate ogni speranza
    [Wx::                   => AnyEvent::Impl::POE::],
@@ -2201,7 +2251,7 @@ list.
 
 This variable can effectively be used for denial-of-service attacks
 against local programs (e.g. when setuid), although the impact is likely
-small, as the program has to handle conenction and other failures anyways.
+small, as the program has to handle connection and other failures anyways.
 
 Examples: C<PERL_ANYEVENT_PROTOCOLS=ipv4,ipv6> - prefer IPv4 over IPv6,
 but support both and try to use both.  C<PERL_ANYEVENT_PROTOCOLS=ipv4>
@@ -2455,7 +2505,7 @@ anything about events.
       ...
    });
 
-   EV::loop;
+   EV::run;
 
 3b. The module user could use AnyEvent, too:
 
@@ -2923,6 +2973,16 @@ chosen event library does not come with a timing source of its own. The
 pure-perl event loop (L<AnyEvent::Loop>) will additionally load it to
 try to use a monotonic clock for timing stability.
 
+=item L<AnyEvent::AIO> (and L<IO::AIO>)
+
+The default implementation of L<AnyEvent::IO> is to do I/O synchronously,
+stopping programs while they access the disk, which is fine for a lot of
+programs.
+
+Installing AnyEvent::AIO (and its IO::AIO dependency) makes it switch to
+a true asynchronous implementation, so event processing can continue even
+while waiting for disk I/O.
+
 =back
 
 
@@ -2943,17 +3003,35 @@ is loaded).
 
 If you have to fork, you must either do so I<before> creating your first
 watcher OR you must not use AnyEvent at all in the child OR you must do
-something completely out of the scope of AnyEvent.
+something completely out of the scope of AnyEvent (see below).
 
 The problem of doing event processing in the parent I<and> the child
 is much more complicated: even for backends that I<are> fork-aware or
 fork-safe, their behaviour is not usually what you want: fork clones all
 watchers, that means all timers, I/O watchers etc. are active in both
-parent and child, which is almost never what you want. USing C<exec>
-to start worker children from some kind of manage rprocess is usually
+parent and child, which is almost never what you want. Using C<exec>
+to start worker children from some kind of manage prrocess is usually
 preferred, because it is much easier and cleaner, at the expense of having
 to have another binary.
 
+In addition to logical problems with fork, there are also implementation
+problems. For example, on POSIX systems, you cannot fork at all in Perl
+code if a thread (I am talking of pthreads here) was ever created in the
+process, and this is just the tip of the iceberg. In general, using fork
+from Perl is difficult, and attempting to use fork without an exec to
+implement some kind of parallel processing is almost certainly doomed.
+
+To safely fork and exec, you should use a module such as
+L<Proc::FastSpawn> that let's you safely fork and exec new processes.
+
+If you want to do multiprocessing using processes, you can
+look at the L<AnyEvent::Fork> module (and some related modules
+such as L<AnyEvent::Fork::RPC>, L<AnyEvent::Fork::Pool> and
+L<AnyEvent::Fork::Remote>). This module allows you to safely create
+subprocesses without any limitations - you can use X11 toolkits or
+AnyEvent in the children created by L<AnyEvent::Fork> safely and without
+any special precautions.
+
 
 =head1 SECURITY CONSIDERATIONS
 
@@ -3004,13 +3082,13 @@ L<AnyEvent::Debug> (interactive shell, watcher tracing).
 
 Supported event modules: L<AnyEvent::Loop>, L<EV>, L<EV::Glib>,
 L<Glib::EV>, L<Event>, L<Glib::Event>, L<Glib>, L<Tk>, L<Event::Lib>,
-L<Qt>, L<POE>, L<FLTK>.
+L<Qt>, L<POE>, L<FLTK>, L<Cocoa::EventLoop>, L<UV>.
 
 Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>,
 L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>,
 L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>,
-L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>, L<Anyevent::Impl::Irssi>,
-L<AnyEvent::Impl::FLTK>.
+L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>, L<AnyEvent::Impl::Irssi>,
+L<AnyEvent::Impl::FLTK>, L<AnyEvent::Impl::Cocoa>, L<AnyEvent::Impl::UV>.
 
 Non-blocking handles, pipes, stream sockets, TCP clients and
 servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>.

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/DNS.pm

@@ -47,14 +47,29 @@ our @DNS_FALLBACK; # some public dns servers as fallback
 
    my $ipv4 = $prep->(
       ["08080808", "08080404"], # 8.8.8.8, 8.8.4.4 - google public dns
-#      ["d1f40003", "d1f30004"], # v209.244.0.3/4 - resolver1/2.level3.net - status unknown
-      ["04020201", "04020203", "04020204", "04020205", "04020206"], # v4.2.2.1/3/4/5/6 - vnsc-pri.sys.gtei.net - effectively public
-      ["cdd22ad2", "4044c8c8"], # 205.210.42.205, 64.68.200.200 - cache1/2.dnsresolvers.com - verified public
-#      ["8d010101"], # 141.1.1.1 - cable&wireless - status unknown
+      ["01010101", "01000001"], # 1.1.1.1, 1.0.0.1 - cloudflare public dns
+      ["50505050", "50505151"], # 80.80.80.80, 80.80.81.81 - freenom.world
+##      ["d1f40003", "d1f30004"], # v209.244.0.3/4 - resolver1/2.level3.net - status unknown
+##      ["04020201", "04020203", "04020204", "04020205", "04020206"], # v4.2.2.1/3/4/5/6 - vnsc-pri.sys.gtei.net - effectively public
+##      ["cdd22ad2", "4044c8c8"], # 205.210.42.205, 64.68.200.200 - cache1/2.dnsresolvers.com - verified public
+#      ["8d010101"], # 141.1.1.1 - cable&wireless, now vodafone - status unknown
+# 84.200.69.80      # dns.watch
+# 84.200.70.40      # dns.watch
+# 37.235.1.174      # freedns.zone
+# 37.235.1.177      # freedns.zone
+# 213.73.91.35      # dnscache.berlin.ccc.de
+# 194.150.168.168   # dns.as250.net; Berlin/Frankfurt
+# 85.214.20.141     # FoeBud (digitalcourage.de)
+# 77.109.148.136    # privacyfoundation.ch
+# 77.109.148.137    # privacyfoundation.ch
+# 91.239.100.100    # anycast.censurfridns.dk
+# 89.233.43.71      # ns1.censurfridns.dk
+# 204.152.184.76    # f.6to4-servers.net, ISC, USA
    );
 
    my $ipv6 = $prep->(
       ["20014860486000000000000000008888", "20014860486000000000000000008844"], # 2001:4860:4860::8888/8844 - google ipv6
+      ["26064700470000000000000000001111", "26064700470000000000000000001001"], # 2606:4700:4700::1111/1001 - cloudflare dns
    );
 
    undef $ipv4 unless $AnyEvent::PROTOCOL{ipv4};
@@ -114,8 +129,9 @@ Example:
 
 =item AnyEvent::DNS::any $domain, $cb->(@rrs)
 
-Tries to resolve the given domain and passes all resource records found to
-the callback.
+Tries to resolve the given domain and passes all resource records found
+to the callback. Note that this uses a DNS C<ANY> query, which, as of RFC
+8482, are officially deprecated.
 
 =item AnyEvent::DNS::ptr $domain, $cb->(@hostnames)
 
@@ -385,11 +401,25 @@ our %type_id = (
    minfo =>  14,
    mx    =>  15,
    txt   =>  16,
+   sig   =>  24,
+   key   =>  25,
+   gpos  =>  27, # rfc1712
    aaaa  =>  28,
+   loc   =>  29, # rfc1876
    srv   =>  33,
    naptr =>  35, # rfc2915
    dname =>  39, # rfc2672
    opt   =>  41,
+   ds    =>  43, # rfc4034
+   sshfp =>  44, # rfc4255
+   rrsig =>  46, # rfc4034
+   nsec  =>  47, # rfc4034
+   dnskey=>  48, # rfc4034
+   smimea=>  53, # rfc8162
+   cds   =>  59, # rfc7344
+   cdnskey=> 60, # rfc7344
+   openpgpkey=> 61, # rfc7926
+   csync =>  62, # rfc7929
    spf   =>  99,
    tkey  => 249,
    tsig  => 250,
@@ -397,6 +427,8 @@ our %type_id = (
    axfr  => 252,
    mailb => 253,
    "*"   => 255,
+   uri   => 256,
+   caa   => 257, # rfc6844
 );
 
 our %type_str = reverse %type_id;
@@ -557,6 +589,7 @@ our %dec_rr = (
     },
     39 => sub { local $ofs = $ofs - length; _dec_name }, # dname
     99 => sub { unpack "(C/a*)*", $_ }, # spf
+   257 => sub { unpack "CC/a*a*", $_ }, # caa
 );
 
 sub _dec_rr {
@@ -605,7 +638,8 @@ Examples:
      'aa' => '',
      'an' => [],
      'rd' => 1,
-     'op' => 'query'
+     'op' => 'query',
+     '__' => '<original dns packet>',
    }
    
    # a successful reply
@@ -634,7 +668,8 @@ Examples:
                [ 'www.l.google.com', 'a', 'in', 3600, '66.249.93.147' ],
              ],
      'rd' => 1,
-     'op' => 0
+     'op' => 0,
+     '__' => '<original dns packet>',
    }
 
 =cut
@@ -647,6 +682,7 @@ sub dns_unpack($) {
    local $ofs = 6 * 2;
 
    {
+      __ => $pkt,
       id => $id,
       qr => ! ! ($flags & 0x8000),
       aa => ! ! ($flags & 0x0400),
@@ -669,6 +705,70 @@ sub dns_unpack($) {
 
 =back
 
+=head3 Extending DNS Encoder and Decoder
+
+This section describes an I<experimental> method to extend the DNS encoder
+and decoder with new opcode, rcode, class and type strings, as well as
+resource record decoders.
+
+Since this is experimental, it can change, as anything can change, but
+this interface is expe ctedc to be relatively stable and was stable during
+the whole existance of C<AnyEvent::DNS> so far.
+
+Note that, since changing the decoder or encoder might break existing
+code, you should either be sure to control for this, or only temporarily
+change these values, e.g. like so:
+
+   my $decoded = do {
+      local $AnyEvent::DNS::opcode_str{7} = "yxrrset";
+      AnyEvent::DNS::dns_unpack $mypkt
+   };
+
+=over 4
+
+=item %AnyEvent::DNS::opcode_id, %AnyEvent::DNS::opcode_str
+
+Two hashes that map lowercase opcode strings to numerical id's (For the
+encoder), or vice versa (for the decoder). Example: add a new opcode
+string C<notzone>.
+
+   $AnyEvent::DNS::opcode_id{notzone} = 10;
+   $AnyEvent::DNS::opcode_str{10} = 'notzone';
+
+=item %AnyEvent::DNS::rcode_id, %AnyEvent::DNS::rcode_str
+
+Same as above, for for rcode values.
+
+=item %AnyEvent::DNS::class_id, %AnyEvent::DNS::class_str
+
+Same as above, but for resource record class names/values.
+
+=item %AnyEvent::DNS::type_id, %AnyEvent::DNS::type_str
+
+Same as above, but for resource record type names/values.
+
+=item %AnyEvent::DNS::dec_rr
+
+This hash maps resource record type values to code references. When
+decoding, they are called with C<$_> set to the undecoded data portion and
+C<$ofs> being the current byte offset. of the record. You should have a
+look at the existing implementations to understand how it works in detail,
+but here are two examples:
+
+Decode an A record. A records are simply four bytes with one byte per
+address component, so the decoder simply unpacks them and joins them with
+dots in between:
+
+   $AnyEvent::DNS::dec_rr{1} = sub { join ".", unpack "C4", $_ };
+
+Decode a CNAME record, which contains a potentially compressed domain
+name.
+
+   package AnyEvent::DNS; # for %dec_rr, $ofsd and &_dec_name
+   $dec_rr{5} = sub { local $ofs = $ofs - length; _dec_name };
+
+=back
+
 =head2 THE AnyEvent::DNS RESOLVER CLASS
 
 This is the class which does the actual protocol work.
@@ -698,7 +798,7 @@ resolver object.
 The resolver is created with the following parameters:
 
    untaint          enabled
-   max_outstanding  $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
+   max_outstanding  $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS} (default 10)
 
 C<os_config> will be used for OS-specific configuration, unless
 C<$ENV{PERL_ANYEVENT_RESOLV_CONF}> is specified, in which case that file
@@ -722,7 +822,7 @@ sub resolver() {
    $RESOLVER || do {
       $RESOLVER = new AnyEvent::DNS
          untaint         => 1,
-         max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 1,
+         max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 10,
       ;
 
       $ENV{PERL_ANYEVENT_RESOLV_CONF}
@@ -812,7 +912,7 @@ sub new {
    if (socket my $fh4, AF_INET , Socket::SOCK_DGRAM(), 0) {
       ++$got_socket;
 
-      AnyEvent::Util::fh_nonblocking $fh4, 1;
+      AnyEvent::fh_unblock $fh4;
       $self->{fh4} = $fh4;
       $self->{rw4} = AE::io $fh4, 0, sub {
          if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
@@ -825,7 +925,7 @@ sub new {
       ++$got_socket;
 
       $self->{fh6} = $fh6;
-      AnyEvent::Util::fh_nonblocking $fh6, 1;
+      AnyEvent::fh_unblock $fh6;
       $self->{rw6} = AE::io $fh6, 0, sub {
          if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
             $wself->_recv ($pkt, $peer);
@@ -1106,7 +1206,7 @@ sub _recv {
 
    my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
 
-   return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
+   return unless $port == DOMAIN_PORT && grep $_ eq $host, @{ $self->{server} };
 
    $self->_feed ($pkt);
 }

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Debug.pm

@@ -46,7 +46,7 @@ our %STRCACHE;
 
 This function binds on the given host and service port and returns a
 shell object, which determines the lifetime of the shell. Any number
-of conenctions are accepted on the port, and they will give you a very
+of connections are accepted on the port, and they will give you a very
 primitive shell that simply executes every line you enter.
 
 All commands will be executed "blockingly" with the socket C<select>ed for
@@ -122,16 +122,37 @@ sub shell($$) {
 
          $logger_guard if 0; # reference it
 
-         if (defined $len ? $len == 0 : $! != Errno::EAGAIN) {
+         if (defined $len ? $len == 0 : ($! != Errno::EAGAIN && $! != Errno::EWOULDBLOCK)) {
             undef $rw;
          } else {
             while ($rbuf =~ s/^(.*)\015?\012//) {
                my $line = $1;
 
-               AnyEvent::Util::fh_nonblocking $fh, 0;
+               AnyEvent::fh_block $fh;
 
                if ($line =~ /^\s*exit\b/) {
                   syswrite $fh, "sorry, no... if you want to execute exit, try CORE::exit.\015\012";
+               } elsif ($line =~ /^\s*coro\b\s*(.*)/) {
+                  my $arg = $1;
+                  if (eval { require Coro; require Coro::Debug }) {
+                     if ($arg =~ /\S/) {
+                        Coro::async (sub {
+                           select $fh;
+                           Coro::Debug::command ($arg);
+                           local $| = 1; # older Coro versions do not flush
+                           syswrite $fh, "> ";
+                        });
+                        return;
+                     } else {
+                        undef $rw;
+                        syswrite $fh, "switching to Coro::Debug...\015\012";
+                        Coro::async (sub { Coro::Debug::session ($fh) });
+                        return;
+                     }
+                  } else {
+                     syswrite $fh, "Coro not available.\015\012";
+                  }
+
                } else {
                   package AnyEvent::Debug::shell;
 
@@ -154,7 +175,7 @@ sub shell($$) {
                }
 
                syswrite $fh, "> ";
-               AnyEvent::Util::fh_nonblocking $fh, 1;
+               AnyEvent::fh_unblock $fh;
             }
          }
       };
@@ -178,6 +199,8 @@ ut           disable tracing for newly created watchers
 t  id,...    enable tracing for the given watcher (enabled by default)
 ut id,...    disable tracing for the given watcher
 w id,...     converts the watcher ids to watcher objects (for scripting)
+coro xxx     run xxx as Coro::Debug shell command, if available
+coro         switch to Coro::Debug shell, if available
 EOF
    }
 
@@ -623,7 +646,7 @@ sub verbose {
 
    my $res = "type:    $self->{type} watcher\n"
            . "args:    " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh?
-           . "created: " . (AnyEvent::Log::ft $self->{now}) . " ($self->{now})\n"
+           . "created: " . (AnyEvent::Log::format_time $self->{now}) . " ($self->{now})\n"
            . "file:    ${ $self->{rfile} }\n"
            . "line:    $self->{line}\n"
            . "subname: $self->{sub}\n"
@@ -639,7 +662,7 @@ sub verbose {
    if (exists $self->{error}) {
       $res .= "errors:   " . @{$self->{error}} . "\n";
 
-      $res .= "error: " . (AnyEvent::Log::ft $_->[0]) . " ($_->[0]) $_->[1]\n"
+      $res .= "error: " . (AnyEvent::Log::format_time $_->[0]) . " ($_->[0]) $_->[1]\n"
          for @{$self->{error}};
    }
 

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Handle.pm

@@ -32,8 +32,10 @@ AnyEvent::Handle - non-blocking I/O on streaming handles via AnyEvent
 
 =head1 DESCRIPTION
 
-This is a helper module to make it easier to do event-based I/O on
-stream-based filehandles (sockets, pipes, and other stream things).
+This is a helper module to make it easier to do event-based I/O
+on stream-based filehandles (sockets, pipes, and other stream
+things). Specifically, it doesn't work as expected on files, packet-based
+sockets or similar things.
 
 The L<AnyEvent::Intro> tutorial contains some well-documented
 AnyEvent::Handle examples.
@@ -55,7 +57,7 @@ package AnyEvent::Handle;
 use Scalar::Util ();
 use List::Util ();
 use Carp ();
-use Errno qw(EAGAIN EINTR);
+use Errno qw(EAGAIN EWOULDBLOCK EINTR);
 
 use AnyEvent (); BEGIN { AnyEvent::common_sense }
 use AnyEvent::Util qw(WSAEWOULDBLOCK);
@@ -93,7 +95,7 @@ The constructor supports these arguments (all as C<< key => value >> pairs).
 
 The filehandle this L<AnyEvent::Handle> object will operate on.
 NOTE: The filehandle will be set to non-blocking mode (using
-C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
+C<AnyEvent::fh_unblock>) by the constructor and needs to stay in
 that mode.
 
 =item connect => [$host, $service]      [C<fh> or C<connect> MANDATORY]
@@ -134,9 +136,6 @@ parameters, together with a retry callback. At the time it is called the
 read and write queues, EOF status, TLS status and similar properties of
 the handle will have been reset.
 
-It is not allowed to use the read or write queues while the handle object
-is connecting.
-
 If, for some reason, the handle is not acceptable, calling C<$retry> will
 continue with the next connection target (in case of multi-homed hosts or
 SRV records there can be multiple connection endpoints). The C<$retry>
@@ -498,16 +497,43 @@ callback.
 This callback will only be called on TLS shutdowns, not when the
 underlying handle signals EOF.
 
-=item json => JSON or JSON::XS object
+=item json => L<JSON>, L<JSON::PP> or L<JSON::XS> object
 
 This is the json coder object used by the C<json> read and write types.
 
 If you don't supply it, then AnyEvent::Handle will create and use a
-suitable one (on demand), which will write and expect UTF-8 encoded JSON
-texts.
+suitable one (on demand), which will write and expect UTF-8 encoded
+JSON texts (either using L<JSON::XS> or L<JSON>). The written texts are
+guaranteed not to contain any newline character.
+
+For security reasons, this encoder will likely I<not> handle numbers and
+strings, only arrays and objects/hashes. The reason is that originally
+JSON was self-delimited, but Dougles Crockford thought it was a splendid
+idea to redefine JSON incompatibly, so this is no longer true.
+
+For protocols that used back-to-back JSON texts, this might lead to
+run-ins, where two or more JSON texts will be interpreted as one JSON
+text.
+
+For this reason, if the default encoder uses L<JSON::XS>, it will default
+to not allowing anything but arrays and objects/hashes, at least for the
+forseeable future (it will change at some point). This might or might not
+be true for the L<JSON> module, so this might cause a security issue.
+
+If you depend on either behaviour, you should create your own json object
+and pass it in explicitly.
+
+=item cbor => L<CBOR::XS> object
+
+This is the cbor coder object used by the C<cbor> read and write types.
+
+If you don't supply it, then AnyEvent::Handle will create and use a
+suitable one (on demand), which will write CBOR without using extensions,
+if possible.
 
-Note that you are responsible to depend on the JSON module if you want to
-use this functionality, as AnyEvent does not have a dependency itself.
+Note that you are responsible to depend on the L<CBOR::XS> module if you
+want to use this functionality, as AnyEvent does not have a dependency on
+it itself.
 
 =back
 
@@ -589,7 +615,7 @@ sub _start {
    Carp::croak "AnyEvent::Handle: only stream sockets supported, anything else will NOT work!"
       if Socket::SOCK_STREAM () != (unpack "I", $type) && defined $type;
 
-   AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
+   AnyEvent::fh_unblock $self->{fh};
 
    $self->{_activity}  =
    $self->{_ractivity} =
@@ -735,23 +761,6 @@ sub oobinline {
    };
 }
 
-=item $handle->keepalive ($boolean)
-
-Enables or disables the C<keepalive> setting (see constructor argument of
-the same name for details).
-
-=cut
-
-sub keepalive {
-   $_[0]{keepalive} = $_[1];
-
-   eval {
-      local $SIG{__DIE__};
-      setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
-         if $_[0]{fh};
-   };
-}
-
 =item $handle->on_starttls ($cb)
 
 Replace the current C<on_starttls> callback (see the C<on_starttls> constructor argument).
@@ -949,7 +958,7 @@ sub _drain_wbuf {
                   && $self->{on_drain};
 
             delete $self->{_ww} unless length $self->{wbuf};
-         } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
+         } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) {
             $self->_error ($!, 1);
          }
       };
@@ -1047,18 +1056,23 @@ Encodes the given hash or array reference into a JSON object. Unless you
 provide your own JSON object, this means it will be encoded to JSON text
 in UTF-8.
 
-JSON objects (and arrays) are self-delimiting, so you can write JSON at
-one end of a handle and read them at the other end without using any
-additional framing.
+The default encoder might or might not handle every type of JSON value -
+it might be limited to arrays and objects for security reasons. See the
+C<json> constructor attribute for more details.
+
+JSON objects (and arrays) are self-delimiting, so if you only use arrays
+and hashes, you can write JSON at one end of a handle and read them at the
+other end without using any additional framing.
 
-The generated JSON text is guaranteed not to contain any newlines: While
-this module doesn't need delimiters after or between JSON texts to be
-able to read them, many other languages depend on that.
+The JSON text generated by the default encoder is guaranteed not to
+contain any newlines: While this module doesn't need delimiters after or
+between JSON texts to be able to read them, many other languages depend on
+them.
 
-A simple RPC protocol that interoperates easily with others is to send
-JSON arrays (or objects, although arrays are usually the better choice as
-they mimic how function argument passing works) and a newline after each
-JSON text:
+A simple RPC protocol that interoperates easily with other languages is
+to send JSON arrays (or objects, although arrays are usually the better
+choice as they mimic how function argument passing works) and a newline
+after each JSON text:
 
    $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
    $handle->push_write ("\012");
@@ -1071,19 +1085,50 @@ rely on the fact that the newline will be skipped as leading whitespace:
 Other languages could read single lines terminated by a newline and pass
 this line into their JSON decoder of choice.
 
+=item cbor => $perl_scalar
+
+Encodes the given scalar into a CBOR value. Unless you provide your own
+L<CBOR::XS> object, this means it will be encoded to a CBOR string not
+using any extensions, if possible.
+
+CBOR values are self-delimiting, so you can write CBOR at one end of
+a handle and read them at the other end without using any additional
+framing.
+
+A simple nd very very fast RPC protocol that interoperates with
+other languages is to send CBOR and receive CBOR values (arrays are
+recommended):
+
+   $handle->push_write (cbor => ["method", "arg1", "arg2"]); # whatever
+ 
+An AnyEvent::Handle receiver would simply use the C<cbor> read type:
+
+   $handle->push_read (cbor => sub { my $array = $_[1]; ... });
+
 =cut
 
 sub json_coder() {
    eval { require JSON::XS; JSON::XS->new->utf8 }
-      || do { require JSON; JSON->new->utf8 }
+      || do { require JSON::PP; JSON::PP->new->utf8 }
 }
 
 register_write_type json => sub {
    my ($self, $ref) = @_;
 
-   my $json = $self->{json} ||= json_coder;
+   ($self->{json} ||= json_coder)
+      ->encode ($ref)
+};
+
+sub cbor_coder() {
+   require CBOR::XS;
+   CBOR::XS->new
+}
 
-   $json->encode ($ref)
+register_write_type cbor => sub {
+   my ($self, $scalar) = @_;
+
+   ($self->{cbor} ||= cbor_coder)
+      ->encode ($scalar)
 };
 
 =item storable => $reference
@@ -1487,11 +1532,13 @@ register_read_type line => sub {
    my ($self, $cb, $eol) = @_;
 
    if (@_ < 3) {
-      # this is more than twice as fast as the generic code below
+      # this is faster then the generic code below
       sub {
-         $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
+         (my $pos = index $_[0]{rbuf}, "\012") >= 0
+            or return;
 
-         $cb->($_[0], "$1", "$2");
+         (my $str = substr $_[0]{rbuf}, 0, $pos + 1, "") =~ s/(\015?\012)\Z// or die;
+         $cb->($_[0], $str, "$1");
          1
       }
    } else {
@@ -1510,7 +1557,8 @@ register_read_type line => sub {
 =item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
 
 Makes a regex match against the regex object C<$accept> and returns
-everything up to and including the match.
+everything up to and including the match. All the usual regex variables
+($1, %+ etc.) from the regex match are available in the callback.
 
 Example: read a single line terminated by '\n'.
 
@@ -1664,13 +1712,12 @@ register_read_type packstring => sub {
 Reads a JSON object or array, decodes it and passes it to the
 callback. When a parse error occurs, an C<EBADMSG> error will be raised.
 
-If a C<json> object was passed to the constructor, then that will be used
-for the final decode, otherwise it will create a JSON coder expecting UTF-8.
+If a C<json> object was passed to the constructor, then that will be
+used for the final decode, otherwise it will create a L<JSON::XS> or
+L<JSON::PP> coder object expecting UTF-8.
 
 This read type uses the incremental parser available with JSON version
-2.09 (and JSON::XS version 2.2) and above. You have to provide a
-dependency on your own: this module will load the JSON module, but
-AnyEvent does not depend on it itself.
+2.09 (and JSON::XS version 2.2) and above.
 
 Since JSON texts are fully self-delimiting, the C<json> read and write
 types are an ideal simple RPC protocol: just exchange JSON datagrams. See
@@ -1684,7 +1731,6 @@ register_read_type json => sub {
    my $json = $self->{json} ||= json_coder;
 
    my $data;
-   my $rbuf = \$self->{rbuf};
 
    sub {
       my $ref = eval { $json->incr_parse ($_[0]{rbuf}) };
@@ -1713,6 +1759,52 @@ register_read_type json => sub {
    }
 };
 
+=item cbor => $cb->($handle, $scalar)
+
+Reads a CBOR value, decodes it and passes it to the callback. When a parse
+error occurs, an C<EBADMSG> error will be raised.
+
+If a L<CBOR::XS> object was passed to the constructor, then that will be
+used for the final decode, otherwise it will create a CBOR coder without
+enabling any options.
+
+You have to provide a dependency to L<CBOR::XS> on your own: this module
+will load the L<CBOR::XS> module, but AnyEvent does not depend on it
+itself.
+
+Since CBOR values are fully self-delimiting, the C<cbor> read and write
+types are an ideal simple RPC protocol: just exchange CBOR datagrams. See
+the C<cbor> write type description, above, for an actual example.
+
+=cut
+
+register_read_type cbor => sub {
+   my ($self, $cb) = @_;
+
+   my $cbor = $self->{cbor} ||= cbor_coder;
+
+   my $data;
+
+   sub {
+      my (@value) = eval { $cbor->incr_parse ($_[0]{rbuf}) };
+
+      if (@value) {
+         $cb->($_[0], @value);
+
+         1
+      } elsif ($@) {
+         # error case
+         $cbor->incr_reset;
+
+         $_[0]->_error (Errno::EBADMSG);
+
+         ()
+      } else {
+         ()
+      }
+   }
+};
+
 =item storable => $cb->($handle, $ref)
 
 Deserialises a L<Storable> frozen representation as written by the
@@ -1766,9 +1858,9 @@ SSL2-compatible framing is supported).
 
 If it detects that the input data is likely TLS, it calls the callback
 with a true value for C<$detect> and the (on-wire) TLS version as second
-and third argument (C<$major> is C<3>, and C<$minor> is 0..3 for SSL
-3.0, TLS 1.0, 1.1 and 1.2, respectively).  If it detects the input to
-be definitely not TLS, it calls the callback with a false value for
+and third argument (C<$major> is C<3>, and C<$minor> is 0..4 for SSL
+3.0, TLS 1.0, 1.1, 1.2 and 1.3, respectively).  If it detects the input
+to be definitely not TLS, it calls the callback with a false value for
 C<$detect>.
 
 The callback could use this information to decide whether or not to start
@@ -1788,7 +1880,7 @@ accomodate protocol changes.
 This read type does not rely on L<AnyEvent::TLS> (and thus, not on
 L<Net::SSLeay>).
 
-=item tls_autostart => $tls[, $tls_ctx]
+=item tls_autostart => [$tls_ctx, ]$tls
 
 Tries to detect a valid SSL or TLS handshake. If one is detected, it tries
 to start tls by calling C<starttls> with the given arguments.
@@ -1802,7 +1894,7 @@ See C<tls_detect> above for more details.
 Example: give the client a chance to start TLS before accepting a text
 line.
 
-   $hdl->push_read (tls_detect => "accept");
+   $hdl->push_read (tls_autostart => "accept");
    $hdl->push_read (line => sub {
       print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n";
    });
@@ -1824,7 +1916,7 @@ register_read_type tls_detect => sub {
 
          # full match, valid TLS record
          my ($major, $minor) = unpack "CC", $1;
-         $cb->($self, "accept", $major + $minor * 0.1);
+         $cb->($self, "accept", $major, $minor);
       } else {
          # mismatch == guaranteed not TLS
          $cb->($self, undef);
@@ -1934,7 +2026,7 @@ sub start_read {
             $self->{_eof} = 1;
             $self->_drain_rbuf;
 
-         } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
+         } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) {
             return $self->_error ($!, 1);
          }
       };
@@ -1974,15 +2066,18 @@ sub _dotls {
 
    my $tmp;
 
-   if (length $self->{_tls_wbuf}) {
-      while (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
-         substr $self->{_tls_wbuf}, 0, $tmp, "";
-      }
-
+   while (length $self->{_tls_wbuf}) {
+      if (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) <= 0) {
          $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);
+
          return $self->_tls_error ($tmp)
             if $tmp != $ERROR_WANT_READ
                && ($tmp != $ERROR_SYSCALL || $!);
+
+         last;
+      }
+
+      substr $self->{_tls_wbuf}, 0, $tmp, "";
    }
 
    while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
@@ -2006,7 +2101,7 @@ sub _dotls {
       $self->{tls} or return; # tls session might have gone away in callback
    }
 
-   $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
+   $tmp = Net::SSLeay::get_error ($self->{tls}, -1); # -1 is not neccessarily correct, but Net::SSLeay doesn't tell us
    return $self->_tls_error ($tmp)
       if $tmp != $ERROR_WANT_READ
          && ($tmp != $ERROR_SYSCALL || $!);
@@ -2100,7 +2195,7 @@ sub starttls {
    # basically, this is deep magic (because SSL_read should have the same issues)
    # but the openssl maintainers basically said: "trust us, it just works".
    # (unfortunately, we have to hardcode constants because the abysmally misdesigned
-   # and mismaintained ssleay-module doesn't even offer them).
+   # and mismaintained ssleay-module didn't offer them for a decade or so).
    # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
    #
    # in short: this is a mess.
@@ -2109,10 +2204,10 @@ sub starttls {
    # we assume that most (but not all) of this insanity only applies to non-blocking cases,
    # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
    # have identity issues in that area.
-#   Net::SSLeay::CTX_set_mode ($ssl,
+#   Net::SSLeay::set_mode ($ssl,
 #      (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
 #      | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
-   Net::SSLeay::CTX_set_mode ($tls, 1|2);
+   Net::SSLeay::set_mode ($tls, 1|2);
 
    $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
    $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
@@ -2197,7 +2292,7 @@ sub DESTROY {
 
          if ($len > 0) {
             substr $wbuf, 0, $len, "";
-         } elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK)) {
+         } elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK)) {
             @linger = (); # end
          }
       };

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/IO.pm

@@ -6,7 +6,7 @@ AnyEvent::IO - the DBI of asynchronous I/O implementations
 
    use AnyEvent::IO;
 
-   # load /etc/passwd, call clalback with the file data when done.
+   # load /etc/passwd, call callback with the file data when done.
    aio_load "/etc/passwd", sub {
       my ($data) = @_
          or return AE::log error => "/etc/passwd: $!";
@@ -58,10 +58,11 @@ is to I/O the same as L<AnyEvent> is to event libraries - it only
 I<interfaces> to other implementations or to a portable pure-perl
 implementation (which does not, however, do asynchronous I/O).
 
-The only other implementation that is supported (or even known to
-the author) is L<IO::AIO>, which is used automatically when it can
-be loaded. If it is not available, L<AnyEvent::IO> falls back to its
-synchronous pure-perl implementation.
+The only other implementation that is supported (or even known to the
+author) is L<IO::AIO>, which is used automatically when it can be loaded
+(via L<AnyEvent::AIO>, which also needs to be installed). If it is not
+available, then L<AnyEvent::IO> falls back to its synchronous pure-perl
+implementation.
 
 Unlike L<AnyEvent>, which model to use is currently decided at module load
 time, not at first use. Future releases might change this.
@@ -162,8 +163,8 @@ the following import tags can be used:
 The functions in this module are not meant to be the most versatile or
 the highest-performers (they are not very slow either, of course). They
 are primarily meant to give users of your code the option to do the I/O
-asynchronously (by installing L<IO::AIO>), without adding a dependency on
-that module.
+asynchronously (by installing L<IO::AIO> and L<AnyEvent::AIO>),
+without adding a dependency on those modules.
 
 =head2 NAMING
 

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/Glib.pm

@@ -19,10 +19,22 @@ Glib is probably the most inefficient event loop that has ever seen the
 light of the world: Glib not only scans all its watchers (really, ALL of
 them, whether I/O-related, timer-related or what not) during each loop
 iteration, it also does so multiple times and rebuilds the poll list for
-the kernel each time again, dynamically even.
+the kernel each time again, dynamically even. Newer versions of libglib
+fortunately do not call malloc/free on every single watcher invocation,
+though.
 
-On the positive side, and most importantly, Glib generally works
-correctly, no quarrels there.
+Glib also enforces certain undocumented behaviours, for example, you
+cannot always remove active child watchers, and the conditions on when
+it is valid to do so are not documented. Of course, if you get it wrong,
+you get "GLib-CRITICAL" messages. This makes it extremely hard to write
+"correct" glib programs, as you have to study the source code to get it
+right, and hope future versions don't change any internals.
+
+AnyEvent implements the necessary workarounds, at a small performance
+cost.
+
+On the positive side, and most importantly, when it works, Glib generally
+works correctly, no quarrels there.
 
 If you create many watchers (as in: more than two), you might consider one
 of the L<Glib::EV>, L<EV::Glib> or L<Glib::Event> modules that map Glib to
@@ -70,9 +82,18 @@ sub timer {
                 remove Glib::Source $source;
                 $source = add Glib::Timeout $ival, sub { &$cb; 1 };
                 &$cb;
-                0
+                1 # already removed, should be a nop
               }
-            : sub { &$cb; 0 };
+            : sub {
+               # due to the braindamaged libglib API (it manages
+               # removed-but-active watchers internally, but forces
+               # users to # manage the same externally as well),
+               # we have to go through these contortions.
+               remove Glib::Source $source;
+               undef $source;
+               &$cb;
+               1 # already removed, should be a nop
+            };
 
    bless \\$source, $class
 }
@@ -87,7 +108,8 @@ sub idle {
 }
 
 sub DESTROY {
-   remove Glib::Source $${$_[0]};
+   remove Glib::Source $${$_[0]}
+      if defined $${$_[0]};
 }
 
 our %pid_w;
@@ -105,10 +127,16 @@ sub child {
    $pid_cb{$pid}{$cb+0} = $cb;
 
    $pid_w{$pid} ||= Glib::Child->watch_add ($pid, sub {
+      # the unbelievably braindamaged glib api ignores the return
+      # value and always removes the watcher (this is of course
+      # undocumented), so we need to go through these contortions to
+      # work around this, here and in DESTROY.
+      undef $pid_w{$pid};
+
       $_->($_[0], $_[1])
          for values %{ $pid_cb{$pid} };
 
-      1
+      1 # gets ignored
    });
 
    bless [$pid, $cb+0], "AnyEvent::Impl::Glib::child"
@@ -120,7 +148,8 @@ sub AnyEvent::Impl::Glib::child::DESTROY {
    delete $pid_cb{$pid}{$icb};
    unless (%{ $pid_cb{$pid} }) {
       delete $pid_cb{$pid};
-      remove Glib::Source delete $pid_w{$pid};
+      my $source = delete $pid_w{$pid};
+      remove Glib::Source if defined $source;
    }
 }
 

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/IOAsync.pm

@@ -19,6 +19,40 @@ I/O, timers, signals and child process watchers. Idle watchers are emulated.
 I/O watchers need to dup their fh because IO::Async only supports IO handles,
 not plain file descriptors.
 
+=head1 FUNCTIONS AND VARIABLES
+
+The only user-servicible part in this module is the C<set_loop> function
+and C<$LOOP> variable:
+
+=over 4
+
+=item AnyEvent::Impl::IOAsync::set_loop $new_loop
+
+Unfortunately, IO::Async has no concept of a default loop. Modules using
+IO::Async must be told by their caller which loop to use, which makes it
+impossible to transparently use IO::Async from a module.
+
+This module is no exception. It creates a new IO::Async::Loop object when
+it is loaded. This might not be the right loop object, though, and thus
+you can replace it by a call to this function with the loop object of your
+choice.
+
+Note that switching loops while watchers are already initialised can have
+unexpected effects, and is not supported unless you can live witht he
+consequences.
+
+=item $AnyEvent::Impl::IOAsync::LOOP
+
+This variable always contains the IO::Async::Loop object used by this
+AnyEvent backend. See above for more info.
+
+Storing the "default" loop makes this module a possible arbiter for other
+modules that want to use IO::Async transparently. It's advised to directly
+refer to this variable each time you want to use it, without making a
+local copy.
+
+=back
+
 =head1 PROBLEMS WITH IO::Async
 
 This section had a long list of problems and shortcomings that made it

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/Perl.pm

@@ -38,9 +38,9 @@ our $VERSION = $AnyEvent::VERSION;
 *AE::idle       = \&AnyEvent::Loop::idle;
 *_poll          = \&AnyEvent::Loop::one_event;
 *loop           = \&AnyEvent::Loop::run; # compatibility with AnyEvent < 6.0
+*now_update     = \&AnyEvent::Loop::now_update;
 
 sub now { $AnyEvent::Loop::NOW }
-sub now_update { AE::now_update       }
 
 sub AnyEvent::CondVar::Base::_wait {
    AnyEvent::Loop::one_event until exists $_[0]{_ae_sent};

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Log.pm

@@ -10,10 +10,10 @@ Simple uses:
 
    AE::log fatal => "No config found, cannot continue!"; # never returns
    AE::log alert => "The battery died!";
-   AE::log crit  => "The battery temperature is too hot!";
+   AE::log crit  => "The battery is too hot!";
    AE::log error => "Division by zero attempted.";
    AE::log warn  => "Couldn't delete the file.";
-   AE::log note  => "Wanted to create config, but config already exists.";
+   AE::log note  => "Attempted to create config, but config already exists.";
    AE::log info  => "File soandso successfully deleted.";
    AE::log debug => "the function returned 3";
    AE::log trace => "going to call function abc";
@@ -35,18 +35,27 @@ Log level overview:
 
    use AnyEvent::Log;
 
-   my $tracer = AnyEvent::Log::logger trace => \$my $trace;
+   my $tracer = AnyEvent::Log::logger trace => \my $trace;
 
    $tracer->("i am here") if $trace;
    $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
 
 Configuration (also look at the EXAMPLES section):
 
+   # set default logging level to suppress anything below "notice"
+   # i.e. enable logging at "notice" or above - the default is to
+   # to not log anything at all.
+   $AnyEvent::Log::FILTER->level ("notice");
+
    # set logging for the current package to errors and higher only
    AnyEvent::Log::ctx->level ("error");
 
-   # set logging level to suppress anything below "notice"
-   $AnyEvent::Log::FILTER->level ("notice");
+   # enable logging for the current package, regardless of global logging level
+   AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG);
+
+   # enable debug logging for module some::mod and enable logging by default
+   (AnyEvent::Log::ctx "some::mod")->level ("debug");
+   (AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG);
 
    # send all critical and higher priority messages to syslog,
    # regardless of (most) other settings
@@ -73,9 +82,9 @@ level at runtime with something like:
    $AnyEvent::Log::FILTER->level ("info");
 
 The design goal behind this module was to keep it simple (and small),
-but make it powerful enough to be potentially useful for any module, and
-extensive enough for the most common tasks, such as logging to multiple
-targets, or being able to log into a database.
+but make it powerful enough to be potentially useful for any module,
+and extensive enough for the most common tasks, such as logging to
+multiple targets, or being able to log into a database.
 
 The module is also usable before AnyEvent itself is initialised, in which
 case some of the functionality might be reduced.
@@ -155,7 +164,7 @@ our ($COLLECT, $FILTER, $LOG);
 our ($now_int, $now_str1, $now_str2);
 
 # Format Time, not public - yet?
-sub ft($) {
+sub format_time($) {
    my $i = int $_[0];
    my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
 
@@ -264,8 +273,8 @@ AnyEvent::post_detect {
 our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
 
 # time, ctx, level, msg
-sub _format($$$$) {
-   my $ts = ft $_[0];
+sub default_format($$$$) {
+   my $ts = format_time $_[0];
    my $ct = " ";
 
    my @res;
@@ -324,7 +333,7 @@ sub _log {
                # format msg
                my $str = $ctx->[4]
                   ? $ctx->[4]($now, $_[0], $level, $format)
-                  : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
+                  : ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
 
                $success = 1;
 
@@ -456,6 +465,41 @@ initialised, this switch will also decide whether to use C<CORE::time> or
 C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
 available.
 
+=item AnyEvent::Log::format_time $timestamp
+
+Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
+AnyEvent->time >> or many other functions in the same way as
+C<AnyEvent::Log> does.
+
+In your main program (as opposed to in your module) you can override
+the default timestamp display format by loading this module and then
+redefining this function.
+
+Most commonly, this function can be used in formatting callbacks.
+
+=item AnyEvent::Log::default_format $time, $ctx, $level, $msg
+
+Format a log message using the given timestamp, logging context, log level
+and log message.
+
+This is the formatting function used to format messages when no custom
+function is provided.
+
+In your main program (as opposed to in your module) you can override the
+default message format by loading this module and then redefining this
+function.
+
+=item AnyEvent::Log::fatal_exit()
+
+This is the function that is called after logging a C<fatal> log
+message. It must not return.
+
+The default implementation simply calls C<exit 1>.
+
+In your main program (as opposed to in your module) you can override
+the fatal exit function by loading this module and then redefining this
+function. Make sure you don't return.
+
 =back
 
 =head1 LOGGING CONTEXTS
@@ -552,7 +596,7 @@ something that logs to a file, or to attach additional logging targets
 
 This function creates or returns a logging context (which is an object).
 
-If a package name is given, then the context for that packlage is
+If a package name is given, then the context for that package is
 returned. If it is called without any arguments, then the context for the
 callers package is returned (i.e. the same context as a C<AE::log> call
 would use).
@@ -842,6 +886,7 @@ sub attach {
 
    $ctx->[2]{$_+0} = $_
       for map { AnyEvent::Log::ctx $_ } @_;
+   AnyEvent::Log::_reassess;
 }
 
 sub detach {
@@ -849,11 +894,13 @@ sub detach {
 
    delete $ctx->[2]{$_+0}
       for map { AnyEvent::Log::ctx $_ } @_;
+   AnyEvent::Log::_reassess;
 }
 
 sub slaves {
    undef $_[0][2];
    &attach;
+   AnyEvent::Log::_reassess;
 }
 
 =back
@@ -910,6 +957,20 @@ If, for some reason, you want to use C<caller> to find out more about the
 logger then you should walk up the call stack until you are no longer
 inside the C<AnyEvent::Log> package.
 
+To implement your own logging callback, you might find the
+C<AnyEvent::Log::format_time> and C<AnyEvent::Log::default_format>
+functions useful.
+
+Example: format the message just as AnyEvent::Log would, by letting
+AnyEvent::Log do the work. This is a good basis to design a formatting
+callback that only changes minor aspects of the formatting.
+
+   $ctx->fmt_cb (sub {
+      my ($time, $ctx, $lvl, $msg) = @_;
+
+      AnyEvent::Log::default_format $time, $ctx, $lvl, $msg
+   });
+
 Example: format just the raw message, with numeric log level in angle
 brackets.
 
@@ -1181,6 +1242,9 @@ Context names starting with a C<%> are anonymous contexts created when the
 name is first mentioned. The difference to package contexts is that by
 default they have no attached slaves.
 
+This makes it possible to create new log contexts that can be refered to
+multiple times by name within the same log specification.
+
 =item a perl package name
 
 Any other string references the logging context associated with the given
@@ -1449,6 +1513,12 @@ default.
 
 =back
 
+=head1 ASYNCHRONOUS DISK I/O
+
+This module uses L<AnyEvent::IO> to actually write log messages (in
+C<log_to_file> and C<log_to_path>), so it doesn't block your program when
+the disk is busy and a non-blocking L<AnyEvent::IO> backend is available.
+
 =head1 AUTHOR
 
  Marc Lehmann <schmorp@schmorp.de>

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Loop.pm

@@ -130,7 +130,7 @@ our ($NOW, $MNOW);
 sub MAXWAIT() { 3600 } # never sleep for longer than this many seconds
 
 BEGIN {
-   local $SIG{__DIE__};
+   local $SIG{__DIE__}; # protect us against the many broken __DIE__ handlers out there
    my $time_hires = eval "use Time::HiRes (); 1";
    my $clk_tck    = eval "use POSIX (); POSIX::sysconf (POSIX::_SC_CLK_TCK ())";
    my $round; # actual granularity
@@ -153,7 +153,7 @@ BEGIN {
 
          $next = (POSIX::times ())[0];
          # we assume 32 bit signed on wrap but 64 bit will never wrap
-         $last -= 4294967296 if $last > $next; # 0x100000000, but perl has probelsm with big hex constants
+         $last -= 4294967296 if $last > $next; # 0x100000000, but perl has problems with big hex constants
          $MNOW += ($next - $last) * $HZ1;
          $last = $next;
       };

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Socket.pm

@@ -40,7 +40,7 @@ use Errno ();
 use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
 
 use AnyEvent (); BEGIN { AnyEvent::common_sense }
-use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
+use AnyEvent::Util qw(guard AF_INET6);
 use AnyEvent::DNS ();
 
 use base 'Exporter';
@@ -104,12 +104,21 @@ Example:
    print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1";
    # => 2002534500000000000000000a000001
 
+   print unpack "H*", parse_ipv6 "192.89.98.1";
+   # => 00000000000000000000ffffc0596201
+
 =cut
 
 sub parse_ipv6($) {
    # quick test to avoid longer processing
    my $n = $_[0] =~ y/://;
-   return undef if $n < 2 || $n > 8;
+
+   if ($n < 2 || $n > 8) {
+      if (!$n && (my $ipn = parse_ipv4 $_[0])) {
+         return "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff$ipn";
+      }
+      return undef;
+   }
 
    my ($h, $t) = split /::/, $_[0], 2;
 
@@ -117,8 +126,8 @@ sub parse_ipv6($) {
       ($h, $t) = (undef, $h);
    }
 
-   my @h = split /:/, $h;
-   my @t = split /:/, $t;
+   my @h = split /:/, $h, -1;
+   my @t = split /:/, $t, -1;
 
    # check for ipv4 tail
    if (@t && $t[-1]=~ /\./) {
@@ -145,7 +154,7 @@ sub parse_ipv6($) {
 
 =item $token = parse_unix $hostname
 
-This fucntion exists mainly for symmetry to the other C<parse_protocol>
+This function exists mainly for symmetry to the other C<parse_protocol>
 functions - it takes a hostname and, if it is C<unix/>, it returns a
 special address token, otherwise C<undef>.
 
@@ -163,17 +172,19 @@ sub parse_unix($) {
 
 =item $ipn = parse_address $ip
 
-Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
-here refers to the host address (not socket address) in network form
-(binary).
+Combines C<parse_ipv4>, C<parse_ipv6> and C<parse_unix> in one
+function. The address here refers to the host address (not socket address)
+in network form (binary).
 
 If the C<$text> is C<unix/>, then this function returns a special token
 recognised by the other functions in this module to mean "UNIX domain
 socket".
 
-If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
-then it will be treated as an IPv4 address. If you don't want that, you
-have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
+If the C<$text> to parse is a plain IPv4 or mapped IPv4 in IPv6 address
+(:ffff::<ipv4>), then it will be treated as an IPv4 address and four
+octets will be returned. If you don't want that, you have to call
+C<parse_ipv4> and/or C<parse_ipv6> manually (the latter always returning a
+16 octet IPv6 address for mapped IPv4 addresses).
 
 Example:
 
@@ -191,9 +202,9 @@ sub parse_address($) {
    for (&parse_ipv6) {
       if ($_) {
          s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//;
-         return $_;
+         return $_
       } else {
-         return &parse_ipv4 || &parse_unix
+         return &parse_unix
       }
    }
 }
@@ -258,7 +269,7 @@ It also supports defaulting the service name in a simple way by using
 C<$default_service> if no service was detected. If neither a service was
 detected nor a default was specified, then this function returns the
 empty list. The same happens when a parse error was detected, such as a
-hostname with a colon in it (the function is rather conservative, though).
+hostname with a colon in it (the function is rather forgiving, though).
 
 Example:
 
@@ -271,7 +282,7 @@ Example:
   print join ",", parse_hostport "[::1]";
   # => "," (empty list)
 
-  print join ",", parse_host_port "/tmp/debug.sock";
+  print join ",", parse_hostport "/tmp/debug.sock";
   # => "unix/", "/tmp/debug.sock"
 
 =cut
@@ -418,8 +429,7 @@ sub format_ipv6($) {
    or $ip =~ s/(?:^|:)     0:0:0:0:0 (?:$|:)/::/x
    or $ip =~ s/(?:^|:)       0:0:0:0 (?:$|:)/::/x
    or $ip =~ s/(?:^|:)         0:0:0 (?:$|:)/::/x
-   or $ip =~ s/(?:^|:)           0:0 (?:$|:)/::/x
-   or $ip =~ s/(?:^|:)             0 (?:$|:)/::/x;
+   or $ip =~ s/(?:^|:)           0:0 (?:$|:)/::/x;
 
    $ip
 }
@@ -578,8 +588,14 @@ module (C<format_address> converts it to C<unix/>).
 # perl contains a bug (imho) where it requires that the kernel always returns
 # sockaddr_un structures of maximum length (which is not, AFAICS, required
 # by any standard). try to 0-pad structures for the benefit of those platforms.
+# unfortunately, the IO::Async author chose to break Socket again in version
+# 2.011 - it now contains a bogus length check, so we disable the workaround.
 
-my $sa_un_zero = eval { Socket::pack_sockaddr_un "" }; $sa_un_zero ^= $sa_un_zero;
+my $sa_un_zero = $Socket::VERSION >= 2.011
+   ? ""
+   : eval { Socket::pack_sockaddr_un "" };
+
+$sa_un_zero ^= $sa_un_zero;
 
 sub unpack_sockaddr($) {
    my $af = sockaddr_family $_[0];
@@ -595,7 +611,7 @@ sub unpack_sockaddr($) {
    }
 }
 
-=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
+=item AnyEvent::Socket::resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
 
 Tries to resolve the given nodename and service name into protocol families
 and sockaddr structures usable to connect to this node and service in a
@@ -662,9 +678,11 @@ sub _parse_hosts($) {
       next unless @aliases;
 
       if (my $ip = parse_ipv4 $addr) {
+         ($ip) = $ip =~ /^(.*)$/s if AnyEvent::TAINT;
          push @{ $HOSTS{$_}[0] }, $ip
             for @aliases;
       } elsif (my $ip = parse_ipv6 $addr) {
+         ($ip) = $ip =~ /^(.*)$/s if AnyEvent::TAINT;
          push @{ $HOSTS{$_}[1] }, $ip
             for @aliases;
       }
@@ -783,20 +801,18 @@ sub resolve_sockaddr($$$$$$) {
          } else {
             $node =~ y/A-Z/a-z/;
 
-            my $hosts = $HOSTS{$node};
-
             # a records
             if ($family != 6) {
                $cv->begin;
                AnyEvent::DNS::a $node, sub {
-                  push @res, [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, parse_ipv4 $_]]
+                  push @res, [$idx, "ipv4", [AF_INET, $type, $proton, pack_sockaddr $port, parse_ipv4 $_]]
                      for @_;
 
                   # dns takes precedence over hosts
                   _load_hosts_unless {
                      push @res,
-                        map [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, $_]],
-                           @{ $hosts->[0] };
+                        map [$idx, "ipv4", [AF_INET, $type, $proton, pack_sockaddr $port, $_]],
+                           @{ ($HOSTS{$node} || [])->[0] };
                   } $cv, @_;
                };
             }
@@ -811,7 +827,7 @@ sub resolve_sockaddr($$$$$$) {
                   _load_hosts_unless {
                      push @res,
                         map [$idx + 0.5, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $_]],
-                           @{ $hosts->[1] }
+                           @{ ($HOSTS{$node} || [])->[1] }
                   } $cv, @_;
                };
             }
@@ -904,9 +920,6 @@ in not-yet-connected state as only argument and must return the connection
 timeout value (or C<0>, C<undef> or the empty list to indicate the default
 timeout is to be used).
 
-Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
-socket (although only IPv4 is currently supported by this module).
-
 Note to the poor Microsoft Windows users: Windows (of course) doesn't
 correctly signal connection errors, so unless your event library works
 around this, failed connections will simply hang. The only event libraries
@@ -1004,7 +1017,7 @@ sub tcp_connect($$$;$) {
          socket $state{fh}, $domain, $type, $proto
             or return $state{next}();
 
-         fh_nonblocking $state{fh}, 1;
+         AnyEvent::fh_unblock $state{fh};
          
          my $timeout = $prepare && $prepare->($state{fh});
 
@@ -1100,12 +1113,16 @@ mode) as first, and the peer host and port as second and third arguments
 
 Croaks on any errors it can detect before the listen.
 
-If called in non-void context, then this function returns a guard object
-whose lifetime it tied to the TCP server: If the object gets destroyed,
-the server will be stopped (but existing accepted connections will
-not be affected).
+In non-void context, this function returns a guard object whose lifetime
+it tied to the TCP server: If the object gets destroyed, the server will
+be stopped and the listening socket will be cleaned up/unlinked (already
+accepted connections will not be affected).
+
+When called in void-context, AnyEvent will keep the listening socket alive
+internally. In this case, there is no guarantee that the listening socket
+will be cleaned up or unlinked.
 
-Regardless, when the function returns to the caller, the socket is bound
+In all cases, when the function returns to the caller, the socket is bound
 and in listening state.
 
 If you need more control over the listening socket, you can provide a
@@ -1141,82 +1158,115 @@ Example: bind a server on a unix domain socket.
       my ($fh) = @_;
    };
 
+=item $guard = AnyEvent::Socket::tcp_bind $host, $service, $done_cb[, $prepare_cb]
+
+Same as C<tcp_server>, except it doesn't call C<accept> in a loop for you
+but simply passes the listen socket to the C<$done_cb>. This is useful
+when you want to have a convenient set up for your listen socket, but want
+to do the C<accept>'ing yourself, for example, in another process.
+
+In case of an error, C<tcp_bind> either croaks, or passes C<undef> to the
+C<$done_cb>.
+
+In non-void context, a guard will be returned. It will clean up/unlink the
+listening socket when destroyed. In void context, no automatic clean up
+might be performed.
+
 =cut
 
-sub tcp_server($$$;$) {
-   my ($host, $service, $accept, $prepare) = @_;
+sub _tcp_bind($$$;$) {
+   my ($host, $service, $done, $prepare) = @_;
 
    $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
            ? "::" : "0"
       unless defined $host;
 
    my $ipn = parse_address $host
-      or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
+      or Carp::croak "tcp_bind: cannot parse '$host' as host address";
 
    my $af = address_family $ipn;
 
    my %state;
 
    # win32 perl is too stupid to get this right :/
-   Carp::croak "tcp_server/socket: address family not supported"
+   Carp::croak "tcp_bind: AF_UNIX address family not supported on win32"
       if AnyEvent::WIN32 && $af == AF_UNIX;
 
-   socket $state{fh}, $af, SOCK_STREAM, 0
-      or Carp::croak "tcp_server/socket: $!";
+   socket my $fh, $af, SOCK_STREAM, 0
+      or Carp::croak "tcp_bind: $!";
+
+   $state{fh} = $fh;
 
    if ($af == AF_INET || $af == AF_INET6) {
-      setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
-         or Carp::croak "tcp_server/so_reuseaddr: $!"
+      setsockopt $fh, SOL_SOCKET, SO_REUSEADDR, 1
+         or Carp::croak "tcp_bind: so_reuseaddr: $!"
             unless AnyEvent::WIN32; # work around windows bug
 
       unless ($service =~ /^\d*$/) {
          $service = (getservbyname $service, "tcp")[2]
-                    or Carp::croak "$service: service unknown"
+                    or Carp::croak "tcp_bind: unknown service '$service'"
       }
    } elsif ($af == AF_UNIX) {
       unlink $service;
    }
 
-   bind $state{fh}, pack_sockaddr $service, $ipn
-      or Carp::croak "bind: $!";
+   bind $fh, pack_sockaddr $service, $ipn
+      or Carp::croak "tcp_bind: $!";
 
-   if ($af == AF_UNIX) {
-      my $fh  = $state{fh};
-      my $ino = (stat $fh)[1];
-      $state{unlink} = guard {
+   if ($af == AF_UNIX and defined wantarray) {
       # this is racy, but is not designed to be foolproof, just best-effort
+      my $ino = (lstat $service)[1];
+      $state{unlink} = guard {
          unlink $service
-            if $ino == (stat $fh)[1];
+            if (lstat $service)[1] == $ino;
       };
    }
 
-   fh_nonblocking $state{fh}, 1;
+   AnyEvent::fh_unblock $fh;
 
    my $len;
 
    if ($prepare) {
-      my ($service, $host) = unpack_sockaddr getsockname $state{fh};
-      $len = $prepare && $prepare->($state{fh}, format_address $host, $service);
+      my ($service, $host) = unpack_sockaddr getsockname $fh;
+      $len = $prepare && $prepare->($fh, format_address $host, $service);
    }
    
    $len ||= 128;
 
-   listen $state{fh}, $len
-      or Carp::croak "listen: $!";
+   listen $fh, $len
+      or Carp::croak "tcp_bind: $!";
+
+   $done->(\%state);
+
+   defined wantarray
+      ? guard { %state = () } # clear fh, unlink
+      : ()
+}
+
+sub tcp_bind($$$;$) {
+   my ($host, $service, $done, $prepare) = @_;
+
+   _tcp_bind $host, $service, sub {
+      $done->(delete shift->{fh});
+   }, $prepare
+}
+
+sub tcp_server($$$;$) {
+   my ($host, $service, $accept, $prepare) = @_;
 
-   $state{aw} = AE::io $state{fh}, 0, sub {
+   _tcp_bind $host, $service, sub {
+      my $rstate = shift;
+
+      $rstate->{aw} = AE::io $rstate->{fh}, 0, sub {
          # this closure keeps $state alive
-      while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
-         fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
+         while ($rstate->{fh} && (my $peer = accept my $fh, $rstate->{fh})) {
+            AnyEvent::fh_unblock $fh; # POSIX requires inheritance, the outside world does not
 
             my ($service, $host) = unpack_sockaddr $peer;
             $accept->($fh, format_address $host, $service);
          }
       };
-
-   defined wantarray
-      ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
-      : ()
+   }, $prepare
 }
 
 =item tcp_nodelay $fh, $enable

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Strict.pm

@@ -24,10 +24,13 @@ L<AnyEvent>). However, this module can be loaded manually at any time.
 
 package AnyEvent::Strict;
 
-use Carp qw(croak);
+use Carp qw(confess);
 use Errno ();
 use POSIX ();
 
+$Carp::Internal{AE}               = 1;
+$Carp::Internal{AnyEvent::Strict} = 1;
+
 use AnyEvent (); BEGIN { AnyEvent::common_sense }
 
 AnyEvent::_isa_hook 1 => "AnyEvent::Strict", 1;
@@ -93,28 +96,28 @@ sub io {
    my (%arg, $fh, $cb, $fd) = @_;
 
    ref $arg{cb}
-      or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
+      or confess "AnyEvent->io called with illegal cb argument '$arg{cb}'";
    $cb = wrap delete $arg{cb};
  
    $arg{poll} =~ /^[rw]$/
-      or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
+      or confess "AnyEvent->io called with illegal poll argument '$arg{poll}'";
 
    $fh = delete $arg{fh};
 
    if ($fh =~ /^\s*\d+\s*$/) {
       $fd = $fh;
-      $fh = AnyEvent::_dupfh $arg{poll}, $fh;
+      ($fh) = AnyEvent::_dupfh $arg{poll}, $fh;
    } else {
       defined eval { $fd = fileno $fh }
-         or croak "AnyEvent->io called with illegal fh argument '$fh'";
+         or confess "AnyEvent->io called with illegal fh argument '$fh'";
    }
 
    -f $fh
-      and croak "AnyEvent->io called with fh argument pointing to a file";
+      and confess "AnyEvent->io called with fh argument pointing to a file";
 
    delete $arg{poll};
  
-   croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
+   confess "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
    ++$FD_INUSE[$fd];
@@ -134,18 +137,18 @@ sub timer {
    my %arg = @_;
 
    ref $arg{cb}
-      or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
+      or confess "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
    my $cb = wrap delete $arg{cb};
  
    exists $arg{after}
-      or croak "AnyEvent->timer called without mandatory 'after' parameter";
+      or confess "AnyEvent->timer called without mandatory 'after' parameter";
    delete $arg{after};
  
    !$arg{interval} or $arg{interval} > 0
-      or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
+      or confess "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
    delete $arg{interval};
  
-   croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
+   confess "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
    $class->SUPER::timer (@_, cb => $cb)
@@ -156,14 +159,14 @@ sub signal {
    my %arg = @_;
 
    ref $arg{cb}
-      or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
+      or confess "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
    my $cb = wrap delete $arg{cb};
  
    defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
-      or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
+      or confess "AnyEvent->signal called with illegal signal name '$arg{signal}'";
    delete $arg{signal};
  
-   croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
+   confess "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
    $class->SUPER::signal (@_, cb => $cb)
@@ -174,14 +177,14 @@ sub child {
    my %arg = @_;
 
    ref $arg{cb}
-      or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
+      or confess "AnyEvent->child called with illegal cb argument '$arg{cb}'";
    my $cb = wrap delete $arg{cb};
  
    $arg{pid} =~ /^-?\d+$/
-      or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
+      or confess "AnyEvent->child called with malformed pid value '$arg{pid}'";
    delete $arg{pid};
  
-   croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
+   confess "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
    $class->SUPER::child (@_, cb => $cb)
@@ -192,10 +195,10 @@ sub idle {
    my %arg = @_;
 
    ref $arg{cb}
-      or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
+      or confess "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
    my $cb = wrap delete $arg{cb};
  
-   croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
+   confess "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
    $class->SUPER::idle (@_, cb => $cb)
@@ -206,10 +209,10 @@ sub condvar {
    my %arg = @_;
 
    !exists $arg{cb} or ref $arg{cb}
-      or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
+      or confess "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
    my @cb = exists $arg{cb} ? (cb => wrap delete $arg{cb}) : ();
  
-   croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
+   confess "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
    $class->SUPER::condvar (@cb);
@@ -219,7 +222,7 @@ sub time {
    my $class = shift;
 
    @_
-      and croak "AnyEvent->time wrongly called with paramaters";
+      and confess "AnyEvent->time wrongly called with paramaters";
 
    $class->SUPER::time (@_)
 }
@@ -228,7 +231,7 @@ sub now {
    my $class = shift;
 
    @_
-      and croak "AnyEvent->now wrongly called with paramaters";
+      and confess "AnyEvent->now wrongly called with paramaters";
 
    $class->SUPER::now (@_)
 }

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/TLS.pm

@@ -119,6 +119,14 @@ our %DH_PARAMS = (
    schmorp2048 => "MIIBCAKCAQEAhR5Fn9h3Tgnc+q4o3CMkZtre3lLUyDT+1bf3aiVOt22JdDQndZLc|FeKz8AqliB3UIgNExc6oDtuG4znKPgklfOnHv/a9tl1AYQbV+QFM/E0jYl6oG8tF|Epgxezt1GCivvtu64ql0s213wr64QffNMt3hva8lNqK1PXfqp13PzzLzAVsfghrv|fMAX7/bYm1T5fAJdcah6FeZkKof+mqbs8HtRjfvrUF2npEM2WdupFu190vcwABnN|TTJheXCWv2BF2f9EEr61q3OUhSNWIThtZP+NKe2bACm1PebT0drAcaxKoMz9LjKr|y5onGs0TOuQ7JmhtZL45Zr4LwBcyTucLUwIBAg==",
    schmorp4096 => "MIICCAKCAgEA5WwA5lQg09YRYqc/JILCd2AfBmYBkF19wmCEJB8G3JhTxv8EGvYk|xyP2ecKVUvHTG8Xw/qpW8nRqzPIyV8QRf6YFYSf33Qnx2xYhcnqOumU3nfC0SNOL|/w2q1BA9BbHtW4574P+6hOQx9ftRtbtZ2HPKBMRcAKGjpYZiKopv0+UAM4NpEC2p|bfajp7pyVLeb/Aqm/oWP3L63wPlY1SDp+XRzrOAKB+/uLGqEwV0bBaxxGL29BpOp|O2z1ALGXiDCcLs9WTn9WqUhWDzUN6fahm53rd7zxwpFCb6K2YhaK0peG95jzSUJ8|aoL0KgWuC6v5+gPJHRu0HrQIdfAdN4VchqYOKE46uNNkQl8VJGu4RjYB7lFBpRwO|g2HCsGMo2X7BRmA1st66fh+JOd1smXMZG/2ozTOooL+ixcx4spNneg4aQerWl5cb|nWXKtPCp8yPzt/zoNzL3Fon2Ses3sNgMos0M/ZbnigScDxz84Ms6V/X8Z0L4m/qX|mL42dP40tgvmgqi6BdsBzcIWeHlEcIhmGcsEBxxKEg7gjb0OjjvatpUCJhmRrGjJ|LtMkBR68qr42OBMN/PBB4KPOWNUqTauXZajfCwYdbpvV24ZhtkcRdw1zisyARBSh|aTKW/GV8iLsUzlYN27LgVEwMwnWQaoecW6eOTNKGUURC3In6XZSvVzsCAQI=",
    schmorp8192 => "MIIECAKCBAEA/SAEbRSSLenVxoInHiltm/ztSwehGOhOiUKfzDcKlRBZHlCC9jBl|S/aeklM6Ucg8E6J2bnfoh6CAdnE/glQOn6CifhZr8X/rnlL9/eP+r9m+aiAw4l0D|MBd8BondbEqwTZthMmLtx0SslnevsFAZ1Cj8WgmUNaSPOukvJ1N7aQ98U+E99Pw3|VG8ANBydXqLqW2sogS8FtZoMbVywcQuaGmC7M6i3Akxe3CCSIpR/JkEZIytREBSC|CH+x3oW/w+wHzq3w8DGB9hqz1iMXqDMiPIMSdXC0DaIPokLnd7X8u6N14yCAco2h|P0gspD3J8pS2FpUY8ZTVjzbVCjhNNmTryBZAxHSWBuX4xYcCHUtfGlUe/IGLSVE1|xIdFpZUfvlvAJjVq0/TtDMg3r2JSXrhQVlr8MPJwSApDVr5kOBHT/uABio4z+5yR|PAvundznfyo9GGAWhIA36GQqsxSQfoRTjWssFoR/cu+9aomRwwOLkvObu8nCVVLH|nLdKDk5cIR0TvNs9HZ6ZmkzL7ah7cPzEKl7U6eE6yZLVYMNecnPLS6PSAIG4gxcq|CVQrrZjQLfTDrJn0OGgpShX85RaDsuiRtp2bpDZ23YDqdwr4wRjvIargjqc2zcF+|jIb7dUS6ci7bVG/CGOQUuiMWAiXZ3a1f343SMf9A05/sf1xwnMeco6STBLZ3X+PA|4urU+grtpWaFtS/fPD2ILn8nrJ3WuSKKUeSnVM46mmJQsOkyn7z8l3jNLB17GYKo|qc+0UuU/2PM9qtZdZElSM/ACLV2vdCuaibop4B9UIP9z3F8kfZ72+zKxpGiE+Bo1|x8SfG8FQw90mYIx+qZzJ8MCvc2wh+l4wDX5KxrhwvcouE2tHQlwfDgv/DiIXp173|hAmUCV0+bPRW8IIJvBODdAWtJe9hNwxj1FFYmPA7l4wa3gXV4I6tb+iO1MbwVjZ/|116tD5MdCo3JuSisgPYCHfkQccwEO0FHEuBbmfN+fQimQ8H0dePP8XctwbkplsB+|aLT5hYKmva/j9smEswgyHglPwc3WvZ+2DgKk7A7DHi7a2gDwCRQlHaXtNWx3992R|dfNgkSeB1CvGSQoo95WpC9ZoqGmcSlVqdetDU8iglPmfYTKO8aIPA6TuTQ/lQ0IW|90LQmqP23FwnNFiyqX8+rztLq4KVkTyeHIQwig6vFxgD8N+SbZCW2PPiB72TVF2U|WePU8MRTv1OIGBUBajF49k28HnZPSGlILHtFEkYkbPvomcE5ENnoejwzjktOTS5d|/R3SIOvCauOzadtzwTYOXT78ORaR1KI1cm8DzkkwJTd/Rrk07Q5vnvnSJQMwFUeH|PwJIgWBQf/GZ/OsDHmkbYR2ZWDClbKw2mwIBAg==",
+
+   # finite field dhe parameters, some taken from firefox, some directly from RFC 7919
+   ffdhe2048 => "MIIBCAKCAQEA//////////+t+FRYortKmq/cViAnPTzx2LnFg84tNpWp4TZBFGQz+8yTnc4kmz75fS/jY2MMddj2gbICrsRhetPfHtXV/WVhJDP1H18GbtCFY2VVPe0a87VXE15/V8k1mE8McODmi3fipona8+/och3xWKE2rec1MKzKT0g6eXq8CrGCsyT7YdEIqUuyyOP7uWrat2DX9GgdT0Kj3jlN9K5W7edjcrsZCwenyO4KbXCeAvzhzffi7MA0BM0oNC9hkXL+nOmFg/+OTxIy7vKBg8P+OxtMb61zO7X8vC7CIAXFjvGDfRaD ssbzSibBsu/6iGtCOGEoXJf//////////wIBAg==",
+   ffdhe3072 => "MIIBiAKCAYEA//////////+t+FRYortKmq/cViAnPTzx2LnFg84tNpWp4TZBFGQz+8yTnc4kmz75fS/jY2MMddj2gbICrsRhetPfHtXV/WVhJDP1H18GbtCFY2VVPe0a87VXE15/V8k1mE8McODmi3fipona8+/och3xWKE2rec1MKzKT0g6eXq8CrGCsyT7YdEIqUuyyOP7uWrat2DX9GgdT0Kj3jlN9K5W7edjcrsZCwenyO4KbXCeAvzhzffi7MA0BM0oNC9hkXL+nOmFg/+OTxIy7vKBg8P+OxtMb61zO7X8vC7CIAXFjvGDfRaDssbzSibBsu/6iGtCOGEfz9zeNVs7ZRkDW7w09N75nAI4YbRvydbmyQd62R0mkff37lmMsPrBhtkcrv4TCYUTknC0EwyTvEN5RPT9RFLi103TZPLiHnH1S/9croKrnJ32nuhtK8UiNjoNq8Uhl5sN6todv5pC1cRITgq80Gv6U93vPBsg7j/VnXwl5B0rZsYuN///////////AgEC",
+   ffdhe4096 => "MIICCAKCAgEA///////////JD9qiIWjCNMTGYouA3BzRKQJOCIpnzHQCC76mOxObIlFKCHmONATd75UZs806QxswKwpt8l8UN0/hNW1tUcJF5IW1dmJefsb0TELppjftawv/XLb0Brft7jhr+1qJn6WunyQRfEsf5kkoZlHs5Fs9wgB8uKFjvwWY2kg2HFXTmmkWP6j9JM9fg2VdI9yjrZYcYvNWIIVSu57VKQdwlpZtZww1Tkq8mATxdGwIyhghfDKQXkYuNs474553LBgOhgObJ4Oi7Aeij7XFXfBvTFLJ3ivL9pVYFxg5lUl86pVq5RXSJhiY+gUQFXKOWoqqxC2tMxcNBFB6M6hVIavfHLpk7PuFBFjb7wqK6nFXXQYMfbOXD4Wm4eTHq/WujNsJM9cejJTgSiVhnc7j0iYa0u5r8S/6BtmKCGTYdgJzPshqZFIfKxgXeyAMu+EXV3phXWx3CYjAutlG4gjiT6B05asxQ9tb/OD9EI5LgtEgqSEIARpyPBKnh+bXiHGaEL26WyaZwycYavTiPBqUaDS2FQvaJYPpyirUTOjbu8LbBN6O+S6O/BQfvsqmKHxZR05rwF2ZspZPoJDDoiM7oYZRW+ftH2EpcM7i16+4G912IXBIHNAGkSfVsFqpk7TqmI2P3cGG/7fckKbAj030Nck0BjGZ//////////8CAQI=",
+   ffdhe6144 =>
+   "MIIDCAKCAwEA//////////+t+FRYortKmq/cViAnPTzx2LnFg84tNpWp4TZBFGQz+8yTnc4kmz75fS/jY2MMddj2gbICrsRhetPfHtXV/WVhJDP1H18GbtCFY2VVPe0a87VXE15/V8k1mE8McODmi3fipona8+/och3xWKE2rec1MKzKT0g6eXq8CrGCsyT7YdEIqUuyyOP7uWrat2DX9GgdT0Kj3jlN9K5W7edjcrsZCwenyO4KbXCeAvzhzffi7MA0BM0oNC9hkXL+nOmFg/+OTxIy7vKBg8P+OxtMb61zO7X8vC7CIAXFjvGDfRaDssbzSibBsu/6iGtCOGEfz9zeNVs7ZRkDW7w09N75nAI4YbRvydbmyQd62R0mkff37lmMsPrBhtkcrv4TCYUTknC0EwyTvEN5RPT9RFLi103TZPLiHnH1S/9croKrnJ32nuhtK8UiNjoNq8Uhl5sN6todv5pC1cRITgq80Gv6U93vPBsg7j/VnXwl5B0rZp4e8W5vUsMWTfT7eTDp5OWIV7asfV9C1p9tGHdjzx1VA0AEh/VbpX4xzHpxNciG77Qxiu1qHgEtnmgyqQdgCpGBMMRtx3j5ca0AOAkpmaMzy4t6Gh25PXFAADwqTs6p+Y0KzAqCkc3OyX3Pjsm1Wn+IpGtNtahR9EGC4caKAH5eDdkCC/1ktkUDbHpOZ30sOFMqOiO6RELK9T6mO7RUMpt2JMiRe91kscD9TLOOjDNMcBw6za0GV/zP7HGbH1w+TkYEHziBR/tM/bR3pSRx96mpaRC4VTIu22NA2KAO8JI1BRHjCr7B//njom5/sp+MGDAjw1h+ONoAd9m0dj5OS5Syu8GUxmUed8r5ku6qwCMqKBv2s6c5wSJhFoIK6NtYR6Z8vvnJCRtGLVOM1ysDdGrnf15iKSwxFWKoRlBdyC24VDOK5J9SNclbkReMzy3Vys70A+ydGBDGJysEWztx+dxrgNY/3UqOmtseaWKmlSbUMWHBpB1XDXk42tSkDjKc0OQOZf//////////AgEC",
+   ffdhe8192 => "MIIECAKCBAEA//////////+t+FRYortKmq/cViAnPTzx2LnFg84tNpWp4TZBFGQz+8yTnc4kmz75fS/jY2MMddj2gbICrsRhetPfHtXV/WVhJDP1H18GbtCFY2VVPe0a87VXE15/V8k1mE8McODmi3fipona8+/och3xWKE2rec1MKzKT0g6eXq8CrGCsyT7YdEIqUuyyOP7uWrat2DX9GgdT0Kj3jlN9K5W7edjcrsZCwenyO4KbXCeAvzhzffi7MA0BM0oNC9hkXL+nOmFg/+OTxIy7vKBg8P+OxtMb61zO7X8vC7CIAXFjvGDfRaDssbzSibBsu/6iGtCOGEfz9zeNVs7ZRkDW7w09N75nAI4YbRvydbmyQd62R0mkff37lmMsPrBhtkcrv4TCYUTknC0EwyTvEN5RPT9RFLi103TZPLiHnH1S/9croKrnJ32nuhtK8UiNjoNq8Uhl5sN6todv5pC1cRITgq80Gv6U93vPBsg7j/VnXwl5B0rZp4e8W5vUsMWTfT7eTDp5OWIV7asfV9C1p9tGHdjzx1VA0AEh/VbpX4xzHpxNciG77Qxiu1qHgEtnmgyqQdgCpGBMMRtx3j5ca0AOAkpmaMzy4t6Gh25PXFAADwqTs6p+Y0KzAqCkc3OyX3Pjsm1Wn+IpGtNtahR9EGC4caKAH5eDdkCC/1ktkUDbHpOZ30sOFMqOiO6RELK9T6mO7RUMpt2JMiRe91kscD9TLOOjDNMcBw6za0GV/zP7HGbH1w+TkYEHziBR/tM/bR3pSRx96mpaRC4VTIu22NA2KAO8JI1BRHjCr7B//njom5/sp+MGDAjw1h+ONoAd9m0dj5OS5Syu8GUxmUed8r5ku6qwCMqKBv2s6c5wSJhFoIK6NtYR6Z8vvnJCRtGLVOM1ysDdGrnf15iKSwxFWKoRlBdyC24VDOK5J9SNclbkReMzy3Vys70A+ydGBDGJysEWztx+dxrgNY/3UqOmtseaWKmlSbUMWHBpB1XDXk42tSkDjKcz/RqqjatAEz2AMg4HkJaMdlRrmT9sj/OyVCdQ2h/62nt0cxeC4zDvfZLEO+GtjFCo6uIKVVbL3R8kyZlyywPHMAb1wIpOIg50q8F5FRQSseLdYKCKEbAujXDX1xZFgzARv2CUVQfxoychrAiu3CZh2pGDnRRqKkxCXA/7hwhfmw4JuUsUappHg5CPPyZ6eMWUMEhe2JIFs2tmpX51bgBlIjZwKCh/jB1pXfiMYP4HUo/L6RXHvyM4LqKT+i2hV3+crCmbt7S+6v75Yow+vq+HF1xqH4vdB74wf6G/qa7/eUwZ38Nl9EdSfeoRD0IIuUGqfRhTgEeKpSDj/iM1oyLt8XGQkz//////////wIBAg==",
 );
 
 =item $tls = new AnyEvent::TLS key => value...
@@ -127,12 +135,13 @@ The constructor supports these arguments (all as key => value pairs).
 
 =over 4
 
-=item method => "SSLv2" | "SSLv3" | "TLSv1" | "any"
+=item method => "SSLv2" | "SSLv3" | "TLSv1" | "TLSv1_1" | "TLSv1_2" | "any"
 
-The protocol parser to use. C<SSLv2>, C<SSLv3> and C<TLSv1> will use
-a parser for those protocols only (so will I<not> accept or create
-connections with/to other protocol versions), while C<any> (the
-default) uses a parser capable of all three protocols.
+The protocol parser to use. C<SSLv2>, C<SSLv3>, C<TLSv1>, C<TLSv1_1>
+and C<TLSv1_2> will use a parser for those protocols only (so will
+I<not> accept or create connections with/to other protocol versions),
+while C<any> (the default) uses a parser capable of all three
+protocols.
 
 The default is to use C<"any"> but disable SSLv2. This has the effect of
 sending a SSLv2 hello, indicating the support for SSLv3 and TLSv1, but not
@@ -141,11 +150,15 @@ actually negotiating an (insecure) SSLv2 connection.
 Specifying a specific version is almost always wrong to use for a server
 speaking to a wide variety of clients (e.g. web browsers), and often wrong
 for a client. If you only want to allow a specific protocol version, use
-the C<sslv2>, C<sslv3> or C<tlsv1> arguments instead.
+the C<sslv2>, C<sslv3>, C<tlsv1>, C<tlsv1_1> or C<tlsv1_2> arguments instead.
 
 For new services it is usually a good idea to enforce a C<TLSv1> method
 from the beginning.
 
+C<TLSv1_1> and C<TLSv1_2> require L<Net::SSLeay> >= 1.55 and OpenSSL
+>= 1.0.1. Check the L<Net::SSLeay> and OpenSSL documentations for more
+details.
+
 =item sslv2 => $enabled
 
 Enable or disable SSLv2 (normally I<disabled>).
@@ -158,6 +171,20 @@ Enable or disable SSLv3 (normally I<enabled>).
 
 Enable or disable TLSv1 (normally I<enabled>).
 
+=item tlsv1_1 => $enabled
+
+Enable or disable TLSv1_1 (normally I<enabled>).
+
+This requires L<Net::SSLeay> >= 1.55 and OpenSSL >= 1.0.1. Check the
+L<Net::SSLeay> and OpenSSL documentations for more details.
+
+=item tlsv1_2 => $enabled
+
+Enable or disable TLSv1_2 (normally I<enabled>).
+
+This requires L<Net::SSLeay> >= 1.55 and OpenSSL >= 1.0.1. Check the
+L<Net::SSLeay> and OpenSSL documentations for more details.
+
 =item verify => $enable
 
 Enable or disable peer certificate checking (default is I<disabled>, which
@@ -231,16 +258,11 @@ This RFC isn't very useful in determining how to do verification so it
 just assumes that subjectAltNames are possible, but no wildcards are
 possible anywhere.
 
-=item [$check_cn, $wildcards_in_alt, $wildcards_in_cn]
+=item [$wildcards_in_alt, $wildcards_in_cn, $check_cn]
 
 You can also specify a scheme yourself by using an array reference with
 three integers.
 
-C<$check_cn> specifies if and how the common name field is used: C<0>
-means it will be completely ignored, C<1> means it will only be used if
-no host names have been found in the subjectAltNames, and C<2> means the
-common name will always be checked against the peername.
-
 C<$wildcards_in_alt> and C<$wildcards_in_cn> specify whether and where
 wildcards (C<*>) are allowed in subjectAltNames and the common name,
 respectively. C<0> means no wildcards are allowed, C<1> means they
@@ -248,6 +270,11 @@ are allowed only as the first component (C<*.example.org>), and C<2>
 means they can be used anywhere (C<www*.example.org>), except that very
 dangerous matches will not be allowed (C<*.org> or C<*>).
 
+C<$check_cn> specifies if and how the common name field is checked: C<0>
+means it will be completely ignored, C<1> means it will only be used if
+no host names have been found in the subjectAltNames, and C<2> means the
+common name will always be checked against the peername.
+
 =back
 
 You can specify either the name of the parent protocol (recommended,
@@ -453,22 +480,23 @@ of course.
 =item dh => $string
 
 Specify the Diffie-Hellman parameters in PEM format directly as a string
-(see C<dh_file>), the default is C<schmorp1539> unless C<dh_file> was
+(see C<dh_file>), the default is C<ffdhe3072> unless C<dh_file> was
 specified.
 
 AnyEvent::TLS supports supports a number of precomputed DH parameters,
 since computing them is expensive. They are:
 
+   # from RFC 7919 - recommended
+   ffdhe2048, ffdhe3072, ffdhe4096, ffdhe6144, ffdhe8192
+
    # from "Assigned Number for SKIP Protocols"
    skip512, skip1024, skip2048, skip4096
 
    # from schmorp
    schmorp1024, schmorp1539, schmorp2048, schmorp4096, schmorp8192
 
-The default was chosen as a trade-off between security and speed, and
-should be secure for a few years. It is said that 2048 bit DH parameters
-are safe till 2030, and DH parameters shorter than 900 bits are totally
-insecure.
+It is said that 2048 bit DH parameters are safe till 2030, and DH
+parameters shorter than 900 bits are totally insecure.
 
 To disable DH protocols completely, specify C<undef> as C<dh> parameter.
 
@@ -553,6 +581,40 @@ sub init ();
 #   ocsp_request => 7,
 #);
 
+BEGIN {
+   eval 'sub _check_tls_gt_1 (){'
+      . (($Net::SSLeay::VERSION >= 1.55 && Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x1000100f) * 1)
+      . '}';
+
+   # as of this writing, Net::SSLeay (1.85-2) has not been ported to OpenSSL 1.1,
+   # but many distributions and users compile it against openssl 1.1, leading to
+   # many symbols not being defined because they are now enums instead of macros
+   # and have different prefixes.
+   # The only one we use is SSL_ST_OK, or TLS_ST_OK, which should be available
+   # as Net::SSLeay::ST_OK. If it is not callable, we define it to be 1, which
+   # hopefully will not change.
+   eval 'Net::SSLeay::ST_OK (); 1'
+      or *Net::SSLeay::ST_OK = sub () { 1 };
+}
+
+our %SSL_METHODS = (
+   any     => \&Net::SSLeay::CTX_new,
+   sslv23  => \&Net::SSLeay::CTX_new, # deliberately undocumented
+   sslv2   => \&Net::SSLeay::CTX_v2_new,
+   sslv3   => \&Net::SSLeay::CTX_v3_new,
+   tlsv1   => \&Net::SSLeay::CTX_tlsv1_new,
+);
+
+# Add TLSv1_1 and TLSv1_2 if Net::SSLeay and openssl allow them
+if (_check_tls_gt_1) {
+   $SSL_METHODS{tlsv1_1} = \&Net::SSLeay::CTX_tlsv1_1_new;
+   $SSL_METHODS{tlsv1_2} = \&Net::SSLeay::CTX_tlsv1_2_new;
+} else {
+   for my $method (qw(tlsv1_1 tlsv1_2)) {
+      $SSL_METHODS{$method} = sub { croak "AnyEvent::TLS method '$method' requires openssl v1.0.1 and Net::SSLeay 1.55 or higher" };
+   }
+}
+
 sub new {
    my ($class, %arg) = @_;
 
@@ -560,12 +622,8 @@ sub new {
 
    my $method = lc $arg{method} || "any";
 
-   my $ctx = $method eq "any"    ? Net::SSLeay::CTX_new       ()
-           : $method eq "sslv23" ? Net::SSLeay::CTX_new       () # deliberately undocumented
-           : $method eq "sslv2"  ? Net::SSLeay::CTX_v2_new    ()
-           : $method eq "sslv3"  ? Net::SSLeay::CTX_v3_new    ()
-           : $method eq "tlsv1"  ? Net::SSLeay::CTX_tlsv1_new ()
-           : croak "'$method' is not a valid AnyEvent::TLS method (must be one of SSLv2, SSLv3, TLSv1 or any)";
+   my $ctx = ($SSL_METHODS{$method}
+              || croak "'$method' is not a valid AnyEvent::TLS method (must be one of @{[ sort keys %SSL_METHODS ]})")->();
 
    my $self = bless { ctx => $ctx }, $class; # to make sure it's destroyed if we croak
 
@@ -574,6 +632,8 @@ sub new {
    $op |= Net::SSLeay::OP_NO_SSLv2      () unless $arg{sslv2};
    $op |= Net::SSLeay::OP_NO_SSLv3      () if exists $arg{sslv3} && !$arg{sslv3};
    $op |= Net::SSLeay::OP_NO_TLSv1      () if exists $arg{tlsv1} && !$arg{tlsv1};
+   $op |= Net::SSLeay::OP_NO_TLSv1_1    () if exists $arg{tlsv1_1} && !$arg{tlsv1_1} && _check_tls_gt_1;
+   $op |= Net::SSLeay::OP_NO_TLSv1_2    () if exists $arg{tlsv1_2} && !$arg{tlsv1_2} && _check_tls_gt_1;
    $op |= Net::SSLeay::OP_SINGLE_DH_USE () if !exists $arg{dh_single_use} || $arg{dh_single_use};
 
    Net::SSLeay::CTX_set_options ($ctx, $op);
@@ -590,7 +650,7 @@ sub new {
       $dh_bio = Net::SSLeay::BIO_new_file ($dh_file, "r")
          or croak "$dh_file: failed to open DH parameter file: $!";
    } else {
-      $arg{dh} = "schmorp1539" unless exists $arg{dh};
+      $arg{dh} = "ffdhe3072" unless exists $arg{dh};
 
       if (defined $arg{dh}) {
          $dh_file = "dh string";
@@ -598,7 +658,7 @@ sub new {
          if ($arg{dh} =~ /^\w+$/) {
             $dh_file = "dh params $arg{dh}";
             $arg{dh} = "-----BEGIN DH PARAMETERS-----\n"
-                     . $DH_PARAMS{$arg{dh}} . "\n"
+                     . (join "\n", unpack "(a74)*", $DH_PARAMS{$arg{dh}}) . "\n"
                      . "-----END DH PARAMETERS-----";
             $arg{dh} =~ s/\|/\n/g;
          }
@@ -786,6 +846,7 @@ sub verify {
 #=cut
 
 #our %REF_MAP;
+our $TLS_SNI_WARNED;
 
 sub _get_session($$;$$) {
    my ($self, $mode, $ref, $cn) = @_;
@@ -801,6 +862,15 @@ sub _get_session($$;$$) {
 
    } elsif ($mode eq "connect") {
       $session = Net::SSLeay::new ($self->{ctx});
+
+      if (defined &Net::SSLeay::set_tlsext_host_name) {
+         Net::SSLeay::set_tlsext_host_name ($session, $cn)
+            if length $cn;
+      } else {
+         AE::log 6 => "TLS SNI not supported by your Net::SSLeay module, connecting without"
+            unless $TLS_SNI_WARNED++;
+      }
+
       Net::SSLeay::set_connect_state ($session);
 
       Net::SSLeay::set_options ($session, eval { Net::SSLeay::OP_NO_TICKET () })
@@ -968,7 +1038,8 @@ sub verify_hostname($$$) {
    my @cert_alt = Net::SSLeay::X509_get_subjectAltNames ($cert);
 
    # rfc2460 - convert to network byte order
-   my $ip = AnyEvent::Socket::parse_address $cn;
+   require AnyEvent::Socket;
+   my $ip = AnyEvent::Socket::parse_address ($cn);
 
    my $alt_dns_count;
 
@@ -1061,7 +1132,7 @@ all...
 You can switch off verification. You still get an encrypted connection
 that is protected against eavesdropping and injection - you just lose
 protection against man in the middle attacks, i.e. somebody else with
-enough abilities to to intercept all traffic can masquerade herself as the
+enough abilities to intercept all traffic can masquerade herself as the
 other side.
 
 For many applications, switching off verification is entirely
@@ -1103,7 +1174,7 @@ on what to watch out for.
 
 =head1 BUGS
 
-To to the abysmal code quality of Net::SSLeay, this module will leak small
+Due to the abysmal code quality of Net::SSLeay, this module will leak small
 amounts of memory per TLS connection (currently at least one perl scalar).
 
 =head1 AUTHORS

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Util.pm

+=encoding utf-8
+
 =head1 NAME
 
 AnyEvent::Util - various utility functions.
@@ -191,7 +193,8 @@ windows, it is abysmally slow, do not expect more than 5..20 forks/s on
 that sucky platform (note this uses perl's pseudo-threads, so avoid those
 like the plague).
 
-Example: poor man's async disk I/O (better use L<IO::AIO>).
+Example: poor man's async disk I/O (better use L<AnyEvent::IO> together
+with L<IO::AIO>).
 
    fork_call {
       open my $fh, "</etc/passwd"
@@ -308,7 +311,7 @@ sub _fork_schedule {
          POSIX::_exit (0);
          exit 1;
          
-      } elsif (($! != &Errno::EAGAIN && $! != &Errno::ENOMEM) || !$forks) {
+      } elsif (($! != &Errno::EAGAIN && $! != &Errno::EWOULDBLOCK && $! != &Errno::ENOMEM) || !$forks) {
          # we ignore some errors as long as we can run at least one job
          # maybe we should wait a few seconds and retry instead
          die "fork_call: $!";
@@ -351,22 +354,18 @@ Sets the blocking state of the given filehandle (true == nonblocking,
 false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on
 broken (i.e. windows) platforms.
 
+Instead of using this function, you could use C<AnyEvent::fh_block> or
+C<AnyEvent::fh_unblock>.
+
 =cut
 
 BEGIN {
-   *fh_nonblocking = AnyEvent::WIN32
-      ? sub($$) {
-          ioctl $_[0], 0x8004667e, pack "L", $_[1]; # FIONBIO
-        }
-      : sub($$) {
-          fcntl $_[0], AnyEvent::F_SETFL, $_[1] ? AnyEvent::O_NONBLOCK : 0;
-        }
-   ;
+   *fh_nonblocking = \&AnyEvent::_fh_nonblocking;
 }
 
 =item $guard = guard { CODE }
 
-This function creates a special object that, when called, will execute
+This function creates a special object that, when destroyed, will execute
 the code block.
 
 This is often handy in continuation-passing style code to clean up some
@@ -469,7 +468,8 @@ when the program exits I<and> all redirected file descriptors have been
 exhausted.
 
 The C<$cmd> is either a single string, which is then passed to a shell, or
-an arrayref, which is passed to the C<execvp> function.
+an arrayref, which is passed to the C<execvp> function (the first array
+element is used both for the executable name and argv[0]).
 
 The key-value pairs can be:
 
@@ -485,6 +485,12 @@ Redirects program standard output into the specified filename, similar to C<<
 Appends program standard output to the referenced scalar. The condvar will
 not be signalled before EOF or an error is signalled.
 
+Specifying the same scalar in multiple ">" pairs is allowed, e.g. to
+redirect both stdout and stderr into the same scalar:
+
+    ">"  => \$output,
+    "2>" => \$output,
+
 =item ">" => $filehandle
 
 Redirects program standard output to the given filehandle (or actually its
@@ -544,7 +550,7 @@ subprocess after C<run_cmd> returns.
 
 Note the the PID might already have been recycled and used by an unrelated
 process at the time C<run_cmd> returns, so it's not useful to send
-signals, use a unique key in data structures and so on.
+signals, use as a unique key in data structures and so on.
 
 =back
 
@@ -801,7 +807,7 @@ sub idn_nameprep($;$) {
       # load the mapping data
       unless (defined $uts46_imap) {
          require Unicode::Normalize;
-         require "lib/AnyEvent/Util/uts46data.pl";
+         require "AnyEvent/Util/uts46data.pl";
       }
 
       # uts46 nameprep
@@ -821,7 +827,7 @@ sub idn_nameprep($;$) {
             # not in valid class, search for mapping
             utf8::encode $chr; # the imap table is in utf-8
             (my $rep = index $uts46_imap, "\x00$chr") >= 0
-               or Carp::croak "$_[0]: disallowed characters ($chr) during idn_nameprep" . unpack "H*", $chr;
+               or Carp::croak "$_[0]: disallowed characters (U+" . (unpack "H*", $chr) . ") during idn_nameprep";
 
             (substr $uts46_imap, $rep, 128) =~ /\x00 .[\x80-\xbf]* ([^\x00]*) \x00/x
                or die "FATAL: idn_nameprep imap table has unexpected contents";
@@ -868,7 +874,7 @@ sub idn_nameprep($;$) {
    if (/[^0-9a-z\-.]/) {
       # load the mapping data
       unless (defined $uts46_imap) {
-         require "lib/AnyEvent/Util/uts46data.pl";
+         require "AnyEvent/Util/uts46data.pl";
       }
 
       vec $uts46_valid, ord, 1

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/constants.pl

-# automatically generated from constants.pl.PL for perl 5.026003 built for x86_64-linux-thread-multi
+# automatically generated from constants.pl.PL
+sub AnyEvent::common_sense {
+   local $^W;
+   ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x0c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00\x00\x00\x0c\x00\x00";
+   $^H |= 0x7c0;
+}
+# generated for perl 5.026003 built for x86_64-linux-thread-multi
 package AnyEvent;
 sub CYGWIN(){0}
 sub WIN32(){0}
@@ -22,10 +28,15 @@ sub WSAEWOULDBLOCK(){-1e+99}
 sub WSAEINPROGRESS(){-1e+99}
 sub _AF_INET6(){10}
 package AnyEvent::Socket;
+sub MSG_DONTWAIT(){64}
+sub MSG_FASTOPEN(){536870912}
+sub MSG_MORE(){32768}
+sub MSG_NOSIGNAL(){16384}
 sub TCP_CONGESTION(){13}
 sub TCP_CONNECTIONTIMEOUT(){undef}
 sub TCP_CORK(){3}
 sub TCP_DEFER_ACCEPT(){9}
+sub TCP_FASTOPEN(){23}
 sub TCP_INFO(){11}
 sub TCP_INIT_CWND(){undef}
 sub TCP_KEEPALIVE(){undef}

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/auto/AnyEvent/.packlist

@@ -19,6 +19,7 @@
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/Perl.pm
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/Qt.pm
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/Tk.pm
+/opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Impl/UV.pm
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Intro.pod
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Log.pm
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/AnyEvent/Loop.pm

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/auto/IPC/Shareable/.packlist

 /opt/thirdlane/perl_lib/local/dist/lib/perl5/IPC/Shareable.pm
 /opt/thirdlane/perl_lib/local/dist/lib/perl5/IPC/Shareable/SharedMem.pm
+/opt/thirdlane/perl_lib/local/dist/lib/perl5/IPC/ipc.pl

opt/thirdlane/perl_lib/local/dist/lib/perl5/x86_64-linux-thread-multi/auto/Mock/Sub/.packlist

+/opt/thirdlane/perl_lib/local/dist/lib/perl5/Mock/Sub.pm
+/opt/thirdlane/perl_lib/local/dist/lib/perl5/Mock/Sub/Child.pm

usr/local/share/perl5/sitecustomize.pl

@@ -14,6 +14,10 @@ sub new {
     symlink ($self->{root}, "/usr/libexec/webmin/asterisk/perl_lib");
     $self->{force_libs} //= ['/usr/libexec/webmin', '/usr/libexec/webmin/asterisk', '/usr/libexec/webmin/asterisk/extlib', $ENV{HOME} . '/workspace/pbxmanager/server/extlib'];
 
+    $ENV{OPENSSL_PREFIX} = $self->{root} . '/local/usr';
+    $ENV{OPENSSL_INCLUDE} = $ENV{OPENSSL_PREFIX} . '/include';
+    $ENV{OPENSSL_LIB} = $ENV{OPENSSL_PREFIX} . '/lib';
+
     $ENV{LD_LIBRARY_PATH} = $self->{root} . '/local/usr/lib' . ($ENV{LD_LIBRARY_PATH} ? (':' . $ENV{LD_LIBRARY_PATH}) : '');
     $ENV{LD_RUN_PATH} = $self->{root} . '/local/usr/lib' . ($ENV{LD_RUN_PATH} ? (':' . $ENV{LD_RUN_PATH}) : '');
     $ENV{PKG_CONFIG_PATH} = $self->{root} . '/local/usr/lib/pkgconfig' . ($ENV{PKG_CONFIG_PATH} ? (':' . $ENV{PKG_CONFIG_PATH}) : '');