File manager - Edit - /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/x86_64-linux/Net/Curl/Compat.pm
Back
package Net::Curl::Compat; =head1 NAME Net::Curl::Compat -- compatibility layer for WWW::Curl =head1 SYNOPSIS --- old.pl +++ new.pl @@ -2,6 +2,8 @@ use strict; use warnings; +# support both Net::Curl (default) and WWW::Curl +BEGIN { eval { require Net::Curl::Compat; } } use WWW::Curl::Easy 4.15; use WWW::Curl::Multi; =head1 DESCRIPTION Net::Curl::Compat lets you use Net::Curl in applications and modules that normally use WWW::Curl. There are several ways to accomplish it: =head2 EXECUTION Execute an application through perl with C<-MNet::Curl::Compat> argument: perl -MNet::Curl::Compat APPLICATION [ARGUMENTS] =head2 CODE, use Net::Curl by default Add this line before including any WWW::Curl modules: BEGIN { eval { require Net::Curl::Compat; } } This will try to preload Net::Curl, but won't fail if it isn't available. =head2 CODE, use WWW::Curl by default Add those lines before all the others that use WWW::Curl: BEGIN { eval { require WWW::Curl; } require Net::Curl::Compat if $@; } This will try WWW::Curl first, but will fallback to Net::Curl if that fails. =head1 NOTE If you want to write compatible code, DO NOT USE Net::Curl::Compat during development. This module hides all the incompatibilities, but does not disable any of the features that are unique to Net::Curl. You could end up using methods that do not yet form part of official WWW::Curl distribution. =cut use strict; use warnings; use Carp qw(croak); our $VERSION = 4.15; =for Pod::Coverage VERSION =cut # Dirty hack so Test::ConsistentVersion passes sub VERSION { return (caller)[0] eq 'Test::ConsistentVersion' ? '0.57' : $VERSION; } my %packages = ( 'WWW/Curl.pm' => 0, 'WWW/Curl/Easy.pm' => 420, 'WWW/Curl/Form.pm' => 4289, 'WWW/Curl/Multi.pm' => 5193, 'WWW/Curl/Share.pm' => 6272, ); my $start = tell *DATA; unshift @INC, sub { my $pkg = $packages{ $_[1] }; return unless defined $pkg; ## no critic (RequireUseOfExceptions) open(my $fh, '<&', *DATA) or croak "can't read from __DATA__"; seek $fh, $start + $pkg, 0; return $fh; }; 1; =head1 COPYRIGHT Copyright (c) 2011-2015 Przemyslaw Iskra <sparky at pld-linux.org>. You may opt to use, copy, modify, merge, publish, distribute and/or sell copies of the Software, and permit persons to whom the Software is furnished to do so, under the terms of the MPL or the MIT/X-derivate licenses. You may pick one of these licenses. =cut __DATA__ package WWW::Curl; use strict; use warnings; use Net::Curl (); our $VERSION = 4.15; # copies constants to current namespace sub _copy_constants { my $EXPORT = shift; my $dest = (shift) . "::"; my $source = shift; no strict 'refs'; my @constants = grep /^CURL/, keys %{ "$source" }; push @$EXPORT, @constants; foreach my $name ( @constants ) { *{ $dest . $name } = \*{ $source . $name }; } } 1; __END__ package WWW::Curl::Easy; use strict; use warnings; use WWW::Curl (); use Net::Curl::Easy (); use Exporter (); our @ISA = qw(Net::Curl::Easy Exporter); our $VERSION = 4.15; our @EXPORT; BEGIN { # in WWW::Curl almost all the constants are thrown into WWW::Curl::Easy foreach my $pkg ( qw(Net::Curl:: Net::Curl::Easy:: Net::Curl::Form:: Net::Curl::Share:: Net::Curl::Multi::) ) { WWW::Curl::_copy_constants( \@EXPORT, __PACKAGE__, $pkg ); } } # what is that anyways ? $WWW::Curl::Easy::headers = ""; $WWW::Curl::Easy::content = ""; sub new { my $class = shift || __PACKAGE__; return $class->SUPER::new(); } *init = \&new; *errbuf = \&Net::Curl::Easy::error; *strerror = \&Net::Curl::Easy::strerror; *version = \&Net::Curl::version; sub cleanup { 0 }; sub internal_setopt { die }; sub duphandle { my ( $source ) = @_; my $clone = $source->SUPER::duphandle; bless $clone, "WWW::Curl::Easy" } sub const_string { my ( $self, $constant ) = @_; return constant( $constant ); } # this thing is weird ! sub constant { my $name = shift; undef $!; my $value = eval "$name()"; if ( $@ ) { require POSIX; $! = POSIX::EINVAL(); return undef; } return $value; } sub setopt { # convert options and provide wrappers for callbacks my ($self, $option, $value, $push) = @_; if ( $push ) { return $self->pushopt( $option, $value ); } if ( $option == CURLOPT_PRIVATE ) { # stringified $self->{private} = "$value"; return 0; } elsif ( $option == CURLOPT_ERRORBUFFER ) { # I don't even know how was that supposed to work, but it does $self->{errorbuffer} = $value; return 0; } # wrappers for callbacks if ( $option == CURLOPT_WRITEFUNCTION ) { my $sub = $value; $value = sub { my ( $easy, $data, $uservar ) = @_; return $sub->( $data, $uservar ); }; } elsif ( $option == CURLOPT_HEADERFUNCTION ) { my $sub = $value; $value = sub { my ( $easy, $data, $uservar ) = @_; return $sub->( $data, $uservar ); }; } elsif ( $option == CURLOPT_READFUNCTION ) { my $sub = $value; $value = sub { my ( $easy, $maxlen, $uservar ) = @_; return \( $sub->( $maxlen, $uservar ) ); }; } elsif ( $option == CURLOPT_PROGRESSFUNCTION ) { my $sub = $value; $value = sub { my ( $easy, $dltotal, $dlnow, $ultotal, $ulnow, $uservar ) = @_; return $sub->( $uservar, $dltotal, $dlnow, $ultotal, $ulnow ); }; } elsif ( $option == CURLOPT_DEBUGFUNCTION ) { my $sub = $value; $value = sub { my ( $easy, $type, $data, $uservar ) = @_; return $sub->( $data, $uservar, $type ); }; } eval { $self->SUPER::setopt( $option, $value ); }; return 0 unless $@; return 0+$@ if ref $@ eq "Net::Curl::Easy::Code"; die $@; } sub pushopt { my ($self, $option, $value) = @_; eval { $self->SUPER::pushopt( $option, $value ); }; return 0 unless $@; if ( ref $@ eq "Net::Curl::Easy::Code" ) { # WWW::Curl allows to use pushopt on non-slist arguments if ( $@ == CURLE_BAD_FUNCTION_ARGUMENT ) { return $self->setopt( $option, $value ); } return 0+$@; } die $@; } sub getinfo { my ($self, $option) = @_; my $ret; if ( $option == CURLINFO_PRIVATE ) { $ret = $self->{private}; } else { eval { $ret = $self->SUPER::getinfo( $option ); }; if ( $@ ) { return undef if ref $@ eq "Net::Curl::Easy::Code"; die $@; } } if ( @_ > 2 ) { $_[2] = $ret; } return $ret; } sub perform { my $self = shift; eval { $self->SUPER::perform( @_ ); }; if ( defined $self->{errorbuffer} ) { my $error = $self->error(); no strict 'refs'; # copy error message to specified global variable # not really sure where that should go *{ "main::" . $self->{errorbuffer} } = \$error; *{ "::" . $self->{errorbuffer} } = \$error; *{ $self->{errorbuffer} } = \$error; } return 0 unless $@; return 0+$@ if ref $@ eq "Net::Curl::Easy::Code"; die $@; } 1; __END__ package WWW::Curl::Form; use strict; use warnings; use WWW::Curl (); use Net::Curl::Form (); use Exporter (); our @ISA = qw(Net::Curl::Form Exporter); our $VERSION = 4.15; our @EXPORT; BEGIN { WWW::Curl::_copy_constants( \@EXPORT, __PACKAGE__, "Net::Curl::Form::" ); } # this thing is weird ! sub constant { my $name = shift; undef $!; my $value = eval "$name()"; if ( $@ ) { require POSIX; $! = POSIX::EINVAL(); return undef; } return $value; } sub new { my $class = shift || __PACKAGE__; return $class->SUPER::new(); } sub formadd { my ( $self, $name, $value ) = @_; eval { $self->add( CURLFORM_COPYNAME, $name, CURLFORM_COPYCONTENTS, $value ); }; } sub formaddfile { my ( $self, $filename, $description, $type ) = @_; eval { $self->add( CURLFORM_FILE, $filename, CURLFORM_COPYNAME, $description, CURLFORM_CONTENTTYPE, $type, ); }; } 1; __END__ package WWW::Curl::Multi; use strict; use warnings; use WWW::Curl (); use Net::Curl::Multi (); our @ISA = qw(Net::Curl::Multi); *strerror = \&Net::Curl::Multi::strerror; sub new { my $class = shift || __PACKAGE__; return $class->SUPER::new(); } sub add_handle { my ( $multi, $easy ) = @_; eval { $multi->SUPER::add_handle( $easy ); }; } sub remove_handle { my ( $multi, $easy ) = @_; eval { $multi->SUPER::remove_handle( $easy ); }; } sub info_read { my ( $multi ) = @_; my @ret; eval { @ret = $multi->SUPER::info_read(); }; return () unless @ret; my ( $msg, $easy, $result ) = @ret; $multi->remove_handle( $easy ); return ( $easy->{private}, $result ); } sub fdset { my ( $multi ) = @_; my @vec; eval { @vec = $multi->SUPER::fdset; }; my @out; foreach my $in ( @vec ) { my $max = 8 * length $in; my @o; foreach my $fn ( 0..$max ) { push @o, $fn if vec $in, $fn, 1; } push @out, \@o; } return @out; } sub perform { my ( $multi ) = @_; my $ret; eval { $ret = $multi->SUPER::perform; }; return $ret; } 1; __END__ package WWW::Curl::Share; use strict; use warnings; use WWW::Curl (); use Net::Curl::Share (); use Exporter (); our @ISA = qw(Net::Curl::Share Exporter); our @EXPORT; BEGIN { WWW::Curl::_copy_constants( \@EXPORT, __PACKAGE__, "Net::Curl::Share::" ); } *strerror = \&Net::Curl::Share::strerror; sub new { my $class = shift || __PACKAGE__; return $class->SUPER::new(); } # this thing is weird ! sub constant { my $name = shift; undef $!; my $value = eval "$name()"; if ( $@ ) { require POSIX; $! = POSIX::EINVAL(); return undef; } return $value; } sub setopt { my ($self, $option, $value) = @_; eval { $self->SUPER::setopt( $option, $value ); }; return 0 unless $@; return 0+$@ if ref $@ eq "Net::Curl::Share::Code"; die $@; } 1; __END__
| ver. 1.4 |
Github
|
.
| PHP 8.1.34 | Generation time: 0.02 |
proxy
|
phpinfo
|
Settings