File-RsyBak
view release on metacpan or search on metacpan
script/rsybak view on Meta::CPAN
#
#$SPEC{gen_getopt_long_spec_from_getopt_std_spec} = {
# v => 1.1,
# summary => 'Generate Getopt::Long spec from Getopt::Std spec',
# args => {
# spec => {
# summary => 'Getopt::Std spec string',
# schema => 'str*',
# req => 1,
# pos => 0,
# },
# is_getopt => {
# summary => 'Whether to assume spec is for getopt() or getopts()',
# description => <<'_',
#
#By default spec is assumed to be for getopts() instead of getopt(). This means
#that for a spec like `abc:`, `a` and `b` don't take argument while `c` does. But
#if `is_getopt` is true, the meaning of `:` is reversed: `a` and `b` take
#arguments while `c` doesn't.
#
#_
# schema => 'bool',
# },
# },
# result_naked => 1,
# result => {
# schema => 'hash*',
# },
#};
#sub gen_getopt_long_spec_from_getopt_std_spec {
# my %args = @_;
#
# my $is_getopt = $args{is_getopt};
# my $spec = {};
#
# while ($args{spec} =~ /(.)(:?)/g) {
# $spec->{$1 . ($is_getopt ? ($2 ? "" : "=s") : ($2 ? "=s" : ""))} =
# sub {};
# }
#
# $spec;
#}
#
#1;
#
#__END__
#
### HTTP/Tiny.pm ###
#package HTTP::Tiny;
#use strict;
#use warnings;
#
#our $VERSION = '0.070';
#
#sub _croak { require Carp; Carp::croak(@_) }
#
#
#my @attributes;
#BEGIN {
# @attributes = qw(
# cookie_jar default_headers http_proxy https_proxy keep_alive
# local_address max_redirect max_size proxy no_proxy
# SSL_options verify_SSL
# );
# my %persist_ok = map {; $_ => 1 } qw(
# cookie_jar default_headers max_redirect max_size
# );
# no strict 'refs';
# no warnings 'uninitialized';
# for my $accessor ( @attributes ) {
# *{$accessor} = sub {
# @_ > 1
# ? do {
# delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
# $_[0]->{$accessor} = $_[1]
# }
# : $_[0]->{$accessor};
# };
# }
#}
#
#sub agent {
# my($self, $agent) = @_;
# if( @_ > 1 ){
# $self->{agent} =
# (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
# }
# return $self->{agent};
#}
#
#sub timeout {
# my ($self, $timeout) = @_;
# if ( @_ > 1 ) {
# $self->{timeout} = $timeout;
# if ($self->{handle}) {
# $self->{handle}->timeout($timeout);
# }
# }
# return $self->{timeout};
#}
#
#sub new {
# my($class, %args) = @_;
#
# my $self = {
# max_redirect => 5,
# timeout => defined $args{timeout} ? $args{timeout} : 60,
# keep_alive => 1,
# verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0,
# no_proxy => $ENV{no_proxy},
# };
#
# bless $self, $class;
#
# $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
#
# for my $key ( @attributes ) {
# $self->{$key} = $args{$key} if exists $args{$key}
# }
#
# $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
#
# $self->_set_proxies;
#
# return $self;
#}
#
#sub _set_proxies {
# my ($self) = @_;
#
#
# if (! exists $self->{proxy} ) {
# $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
# }
#
# if ( defined $self->{proxy} ) {
# $self->_split_proxy( 'generic proxy' => $self->{proxy} );
# }
# else {
# delete $self->{proxy};
# }
#
# if (! exists $self->{http_proxy} ) {
# local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
# $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
# }
#
# if ( defined $self->{http_proxy} ) {
# $self->_split_proxy( http_proxy => $self->{http_proxy} );
# $self->{_has_proxy}{http} = 1;
# }
# else {
# delete $self->{http_proxy};
# }
#
# if (! exists $self->{https_proxy} ) {
# $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
# }
#
# if ( $self->{https_proxy} ) {
# $self->_split_proxy( https_proxy => $self->{https_proxy} );
# $self->{_has_proxy}{https} = 1;
# }
# else {
# delete $self->{https_proxy};
# }
#
# unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
script/rsybak view on Meta::CPAN
#}
#
#
#my %DefaultPort = (
# http => 80,
# https => 443,
#);
#
#sub _agent {
# my $class = ref($_[0]) || $_[0];
# (my $default_agent = $class) =~ s{::}{-}g;
# return $default_agent . "/" . $class->VERSION;
#}
#
#sub _request {
# my ($self, $method, $url, $args) = @_;
#
# my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
#
# my $request = {
# method => $method,
# scheme => $scheme,
# host => $host,
# port => $port,
# host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
# uri => $path_query,
# headers => {},
# };
#
# my $peer = $args->{peer} || $host;
#
# my $handle = delete $self->{handle};
# if ( $handle ) {
# unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) {
# $handle->close;
# undef $handle;
# }
# }
# $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer );
#
# $self->_prepare_headers_and_cb($request, $args, $url, $auth);
# $handle->write_request($request);
#
# my $response;
# do { $response = $handle->read_response_header }
# until (substr($response->{status},0,1) ne '1');
#
# $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
# my @redir_args = $self->_maybe_redirect($request, $response, $args);
#
# my $known_message_length;
# if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
# $known_message_length = 1;
# }
# else {
# my $cb_args = @redir_args ? +{} : $args;
# my $data_cb = $self->_prepare_data_cb($response, $cb_args);
# $known_message_length = $handle->read_body($data_cb, $response);
# }
#
# if ( $self->{keep_alive}
# && $known_message_length
# && $response->{protocol} eq 'HTTP/1.1'
# && ($response->{headers}{connection} || '') ne 'close'
# ) {
# $self->{handle} = $handle;
# }
# else {
# $handle->close;
# }
#
# $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
# $response->{url} = $url;
#
# if (@redir_args) {
# push @{$args->{_redirects}}, $response;
# return $self->_request(@redir_args, $args);
# }
#
# $response->{redirects} = delete $args->{_redirects}
# if @{$args->{_redirects}};
# return $response;
#}
#
#sub _open_handle {
# my ($self, $request, $scheme, $host, $port, $peer) = @_;
#
# my $handle = HTTP::Tiny::Handle->new(
# timeout => $self->{timeout},
# SSL_options => $self->{SSL_options},
# verify_SSL => $self->{verify_SSL},
# local_address => $self->{local_address},
# keep_alive => $self->{keep_alive}
# );
#
# if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
# return $self->_proxy_connect( $request, $handle );
# }
# else {
# return $handle->connect($scheme, $host, $port, $peer);
# }
#}
#
#sub _proxy_connect {
# my ($self, $request, $handle) = @_;
#
# my @proxy_vars;
# if ( $request->{scheme} eq 'https' ) {
# _croak(qq{No https_proxy defined}) unless $self->{https_proxy};
# @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
# if ( $proxy_vars[0] eq 'https' ) {
# _croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
# }
# }
# else {
# _croak(qq{No http_proxy defined}) unless $self->{http_proxy};
# @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
# }
#
# my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
#
# if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
# $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
# }
#
# $handle->connect($p_scheme, $p_host, $p_port, $p_host);
#
# if ($request->{scheme} eq 'https') {
# $self->_create_proxy_tunnel( $request, $handle );
# }
# else {
# $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
# }
#
# return $handle;
#}
#
#sub _split_proxy {
# my ($self, $type, $proxy) = @_;
#
# my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
#
# unless(
# defined($scheme) && length($scheme) && length($host) && length($port)
# && $path_query eq '/'
# ) {
# _croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
# }
#
# return ($scheme, $host, $port, $auth);
#}
#
#sub _create_proxy_tunnel {
# my ($self, $request, $handle) = @_;
#
# $handle->_assert_ssl;
#
# my $agent = exists($request->{headers}{'user-agent'})
# ? $request->{headers}{'user-agent'} : $self->{agent};
#
# my $connect_request = {
# method => 'CONNECT',
# uri => "$request->{host}:$request->{port}",
# headers => {
# host => "$request->{host}:$request->{port}",
# 'user-agent' => $agent,
# }
# };
#
# if ( $request->{headers}{'proxy-authorization'} ) {
# $connect_request->{headers}{'proxy-authorization'} =
# delete $request->{headers}{'proxy-authorization'};
# }
#
# $handle->write_request($connect_request);
# my $response;
# do { $response = $handle->read_response_header }
# until (substr($response->{status},0,1) ne '1');
#
# unless (substr($response->{status},0,1) eq '2') {
# die $response;
# }
#
# $handle->start_ssl( $request->{host} );
#
# return;
#}
#
#sub _prepare_headers_and_cb {
# my ($self, $request, $args, $url, $auth) = @_;
#
# for ($self->{default_headers}, $args->{headers}) {
# next unless defined;
# while (my ($k, $v) = each %$_) {
# $request->{headers}{lc $k} = $v;
# $request->{header_case}{lc $k} = $k;
# }
# }
#
# if (exists $request->{headers}{'host'}) {
# die(qq/The 'Host' header must not be provided as header option\n/);
# }
#
# $request->{headers}{'host'} = $request->{host_port};
# $request->{headers}{'user-agent'} ||= $self->{agent};
# $request->{headers}{'connection'} = "close"
# unless $self->{keep_alive};
#
# if ( defined $args->{content} ) {
# if (ref $args->{content} eq 'CODE') {
# $request->{headers}{'content-type'} ||= "application/octet-stream";
# $request->{headers}{'transfer-encoding'} = 'chunked'
# unless $request->{headers}{'content-length'}
# || $request->{headers}{'transfer-encoding'};
# $request->{cb} = $args->{content};
# }
# elsif ( length $args->{content} ) {
# my $content = $args->{content};
# if ( $] ge '5.008' ) {
# utf8::downgrade($content, 1)
# or die(qq/Wide character in request message body\n/);
# }
# $request->{headers}{'content-type'} ||= "application/octet-stream";
# $request->{headers}{'content-length'} = length $content
# unless $request->{headers}{'content-length'}
# || $request->{headers}{'transfer-encoding'};
# $request->{cb} = sub { substr $content, 0, length $content, '' };
# }
# $request->{trailer_cb} = $args->{trailer_callback}
# if ref $args->{trailer_callback} eq 'CODE';
# }
#
# if ( $self->{cookie_jar} ) {
# my $cookies = $self->cookie_jar->cookie_header( $url );
# $request->{headers}{cookie} = $cookies if length $cookies;
# }
#
# if ( length $auth && ! defined $request->{headers}{authorization} ) {
# $self->_add_basic_auth_header( $request, 'authorization' => $auth );
# }
#
# return;
#}
#
#sub _add_basic_auth_header {
# my ($self, $request, $header, $auth) = @_;
# require MIME::Base64;
# $request->{headers}{$header} =
# "Basic " . MIME::Base64::encode_base64($auth, "");
# return;
#}
#
#sub _prepare_data_cb {
# my ($self, $response, $args) = @_;
# my $data_cb = $args->{data_callback};
# $response->{content} = '';
#
# if (!$data_cb || $response->{status} !~ /^2/) {
# if (defined $self->{max_size}) {
# $data_cb = sub {
# $_[1]->{content} .= $_[0];
# die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
# if length $_[1]->{content} > $self->{max_size};
# };
# }
# else {
# $data_cb = sub { $_[1]->{content} .= $_[0] };
script/rsybak view on Meta::CPAN
#
#my $Printable = sub {
# local $_ = shift;
# s/\r/\\r/g;
# s/\n/\\n/g;
# s/\t/\\t/g;
# s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
# $_;
#};
#
#my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
#my $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;
#
#sub new {
# my ($class, %args) = @_;
# return bless {
# rbuf => '',
# timeout => 60,
# max_line_size => 16384,
# max_header_lines => 64,
# verify_SSL => 0,
# SSL_options => {},
# %args
# }, $class;
#}
#
#sub timeout {
# my ($self, $timeout) = @_;
# if ( @_ > 1 ) {
# $self->{timeout} = $timeout;
# if ( $self->{fh} && $self->{fh}->can('timeout') ) {
# $self->{fh}->timeout($timeout);
# }
# }
# return $self->{timeout};
#}
#
#sub connect {
# @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n");
# my ($self, $scheme, $host, $port, $peer) = @_;
#
# if ( $scheme eq 'https' ) {
# $self->_assert_ssl;
# }
# elsif ( $scheme ne 'http' ) {
# die(qq/Unsupported URL scheme '$scheme'\n/);
# }
# $self->{fh} = $SOCKET_CLASS->new(
# PeerHost => $peer,
# PeerPort => $port,
# $self->{local_address} ?
# ( LocalAddr => $self->{local_address} ) : (),
# Proto => 'tcp',
# Type => SOCK_STREAM,
# Timeout => $self->{timeout},
# ) or die(qq/Could not connect to '$host:$port': $@\n/);
#
# binmode($self->{fh})
# or die(qq/Could not binmode() socket: '$!'\n/);
#
# if ( $self->{keep_alive} ) {
# unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
# CORE::close($self->{fh});
# die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
# }
# }
#
# $self->start_ssl($host) if $scheme eq 'https';
#
# $self->{scheme} = $scheme;
# $self->{host} = $host;
# $self->{peer} = $peer;
# $self->{port} = $port;
# $self->{pid} = $$;
# $self->{tid} = _get_tid();
#
# return $self;
#}
#
#sub start_ssl {
# my ($self, $host) = @_;
#
# if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
# unless ( $self->{fh}->stop_SSL ) {
# my $ssl_err = IO::Socket::SSL->errstr;
# die(qq/Error halting prior SSL connection: $ssl_err/);
# }
# }
#
# my $ssl_args = $self->_ssl_args($host);
# IO::Socket::SSL->start_SSL(
# $self->{fh},
# %$ssl_args,
# SSL_create_ctx_callback => sub {
# my $ctx = shift;
# Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
# },
# );
#
# unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
# my $ssl_err = IO::Socket::SSL->errstr;
# die(qq/SSL connection failed for $host: $ssl_err\n/);
# }
#}
#
#sub close {
# @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
# my ($self) = @_;
# CORE::close($self->{fh})
# or die(qq/Could not close socket: '$!'\n/);
#}
#
#sub write {
# @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
# my ($self, $buf) = @_;
#
# if ( $] ge '5.008' ) {
# utf8::downgrade($buf, 1)
# or die(qq/Wide character in write()\n/);
# }
#
( run in 2.735 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )