File Coverage

blib/lib/Crypt/SSLeay/MainContext.pm
Criterion Covered Total %
statement n/a
branch n/a
condition n/a
subroutine n/a
pod n/a
total n/a


line stmt bran cond sub pod time code
1             package Crypt::SSLeay::MainContext;
2              
3             # maintains a single instance of the Crypt::SSLeay::CTX class
4              
5             use strict;
6             use Carp ();
7              
8             require Crypt::SSLeay::CTX;
9              
10             #my %CTX;
11             #for(2,3,23) {
12             # my $ctx = Crypt::SSLeay::CTX->new($_);
13             # $ctx->set_cipher_list($ENV{CRYPT_SSLEAY_CIPHER})
14             # if $ENV{CRYPT_SSLEAY_CIPHER};
15             # $CTX{$_} = $ctx;
16             #}
17             my $ctx = &main_ctx();
18              
19             sub main_ctx {
20                 my $ssl_version = shift || 23;
21              
22                 my $ctx = Crypt::SSLeay::CTX->new($ssl_version);
23                 $ctx->set_cipher_list($ENV{CRYPT_SSLEAY_CIPHER})
24                   if $ENV{CRYPT_SSLEAY_CIPHER};
25              
26             # $ctx = $CTX{$ssl_version};
27             # print STDERR "\n\nCTX $ctx version $ssl_version\n\n";
28              
29                 $ctx;
30             }
31              
32             my %sub_cache = ('main_ctx' => \&main_ctx );
33              
34             sub import
35             {
36                 my $pkg = shift;
37                 my $callpkg = caller();
38                 my @func = @_;
39                 for (@func) {
40                     s/^&//;
41                     Carp::croak("Can't export $_ from $pkg") if /\W/;;
42                     my $sub = $sub_cache{$_};
43                     unless ($sub) {
44                         my $method = $_;
45                         $method =~ s/^main_ctx_//; # optional prefix
46                         $sub = $sub_cache{$_} = sub { $ctx->$method(@_) };
47                     }
48                     no strict 'refs';
49                     *{"${callpkg}::$_"} = $sub;
50                 }
51             }
52              
53             1;
54              
55              
56              
57