Result:
found more than 265 distributions - search limited to the first 2001 files matching your query
( run in 1.972 )
AOLserver-CtrlPort
view release on metacpan or search on metacpan
lib/AOLserver/CtrlPort.pm view on Meta::CPAN
=back
=cut
############################################################
sub new {
############################################################
my ($class, @options) = @_;
my %options = (
Timeout => 10,
lib/AOLserver/CtrlPort.pm view on Meta::CPAN
and return the newline-separated response as a single string.
=cut
############################################################
sub send_cmds {
############################################################
my ($self, $lines) = @_;
my $output = "";
my $line_output;
API-Assembla
view release on metacpan or search on metacpan
lib/API/Assembla.pm view on Meta::CPAN
has '_client' => (
is => 'ro',
isa => 'LWP::UserAgent',
lazy => 1,
default => sub {
my $self = shift;
return LWP::UserAgent->new;
}
);
lib/API/Assembla.pm view on Meta::CPAN
has 'url' => (
is => 'ro',
isa => 'URI',
lazy => 1,
default => sub {
my $self = shift;
return URI->new('https://www.assembla.com/');
}
);
lib/API/Assembla.pm view on Meta::CPAN
isa => 'Str',
required => 1
);
sub get_space {
my ($self, $id) = @_;
my $req = $self->make_req('/spaces/'.$id);
my $resp = $self->_client->request($req);
lib/API/Assembla.pm view on Meta::CPAN
description => $space->findvalue('description').'',
);
}
sub get_spaces {
my ($self) = @_;
my $req = $self->make_req('/spaces/my_spaces');
my $resp = $self->_client->request($req);
lib/API/Assembla.pm view on Meta::CPAN
return \%objects;
}
sub get_ticket {
my ($self, $id, $number) = @_;
my $req = $self->make_req('/spaces/'.$id.'/tickets/'.$number);
my $resp = $self->_client->request($req);
lib/API/Assembla.pm view on Meta::CPAN
);
}
sub get_tickets {
my ($self, $id) = @_;
my $req = $self->make_req('/spaces/'.$id.'/tickets');
my $resp = $self->_client->request($req);
lib/API/Assembla.pm view on Meta::CPAN
}
return \%objects;
}
sub make_req {
my ($self, $path) = @_;
my $req = HTTP::Request->new(GET => $self->url.$path);
$req->header(Accept => 'application/xml');
$req->authorization_basic($self->username, $self->password);
API-Basecamp
view release on metacpan or search on metacpan
requires "API::Client" => "0.03";
requires "Data::Object" => "0.57";
requires "Mojolicious" => "6.22";
requires "perl" => "v5.14.0";
on 'test' => sub {
requires "perl" => "v5.14.0";
};
on 'configure' => sub {
requires "ExtUtils::MakeMaker" => "0";
};
API-BigBlueButton
view release on metacpan or search on metacpan
lib/API/BigBlueButton.pm view on Meta::CPAN
use_https
Use/not use https. Optional parameter.
=cut
sub new {
my $class = shift;
$class = ref $class || $class;
my $self = {
lib/API/BigBlueButton.pm view on Meta::CPAN
}
return bless $self, $class;
}
sub abstract_request {
my ( $self, $data ) = @_;
my $request = delete $data->{request};
my $checksum = delete $data->{checksum};
confess "Parameter request required!" unless $request;
lib/API/BigBlueButton.pm view on Meta::CPAN
$url .= 'checksum=' . $checksum;
return $self->request( $url );
}
sub request {
my ( $self, $url ) = @_;
my $ua = LWP::UserAgent->new;
$ua->ssl_opts(verify_hostname => 0) if $self->{use_https};
API-CLI
view release on metacpan or search on metacpan
lib/API/CLI.pm view on Meta::CPAN
use Moo;
has dir => ( is => 'ro' );
has openapi => ( is => 'ro' );
sub add_auth {
my ($self, $req) = @_;
my $appconfig = $self->read_appconfig;
my $token = $appconfig->{token};
$req->header(Authorization => "Bearer $token");
}
sub read_appconfig {
my ($self) = @_;
my $dir = $self->dir;
my $appconfig = YAML::XS::LoadFile("$dir/config.yaml");
}
sub apicall {
my ($self, $run) = @_;
my ($method, $path) = @{ $run->commands };
my $params = $run->parameters;
my $opt = $run->options;
if ($opt->{debug}) {
lib/API/CLI.pm view on Meta::CPAN
use API::CLI::App::Spec;
package API::CLI::MetaCPAN;
use base 'API::CLI';
sub add_auth {
}
package main;
my $appspec_file = "$Bin/../metacpancl-appspec.yaml";
API-CPanel
view release on metacpan or search on metacpan
lib/API/CPanel.pm view on Meta::CPAN
# Last raw answer from server
our $last_answer = '';
# Public!
sub is_ok {
my $answer = shift;
return 1 if $answer && ( ref $answer eq 'HASH' || ref $answer eq 'ARRAY' );
}
sub get_error {
my $answer = shift;
return '' if is_success( $answer ); # ok == no error
return Dumper( $answer->{statusmsg } );
}
# Get data from @_
sub get_params {
my @params = @_;
if (scalar @params == 1 && ref $params[0] eq 'HASH' ) {
return { %{ $params[0] } };
} else {
lib/API/CPanel.pm view on Meta::CPAN
}
}
# Make query string
# STATIC(HASHREF: params)
sub mk_query_string {
my $params = shift;
return '' unless $params &&
ref $params eq 'HASH' && %$params ;
lib/API/CPanel.pm view on Meta::CPAN
return $result;
}
# Kill slashes at start / end string
# STATIC(STRING:input_string)
sub kill_start_end_slashes {
my $str = shift;
for ($str) {
s/^\/+//sgi;
s/\/+$//sgi;
lib/API/CPanel.pm view on Meta::CPAN
# path
# allow_http
# param1
# param2
# ...
sub mk_full_query_string {
my $params = shift;
return '' unless
$params &&
ref $params eq 'HASH' &&
lib/API/CPanel.pm view on Meta::CPAN
}
# Make request to server and get answer
# STATIC (STRING: query_string)
sub mk_query_to_server {
my $auth_hash = shift;
my $query_string = shift;
return '' unless ( $query_string && $auth_hash );
warn "Auth hash: $auth_hash\nQuery string: $query_string\n" if $DEBUG;
lib/API/CPanel.pm view on Meta::CPAN
# Parse answer
# STATIC(HASHREF: params)
# params:
# STRING: answer
# HASHREF: xml_parser_params)
sub parse_answer {
my %params = @_;
my $answer_string =
$params{answer};
my $parser_params =
lib/API/CPanel.pm view on Meta::CPAN
return $deparsed ? $deparsed : '';
}
# Get + deparse
# STATIC(STRING: query_string)
sub process_query {
my %params = @_;
my $auth_hash = $params{auth_hash};
my $query_string = $params{query_string};
my $xml_parser_params = $params{parser_params} || '';
lib/API/CPanel.pm view on Meta::CPAN
}
# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
my ($hash, $allowed_keys) = @_;
return unless ref $hash eq 'HASH' &&
ref $allowed_keys eq 'ARRAY';
lib/API/CPanel.pm view on Meta::CPAN
# STATIC(HASHREF: params_hash)
# params_hash:
# - all elements from mk_full_query_string +
# - auth_user*
# - auth_passwd*
sub get_auth_hash {
my %params_raw = @_;
warn 'get_auth_hash params: ' . Dumper(\%params_raw) if $DEBUG;
my $params = filter_hash(
\%params_raw,
[ 'auth_user', 'auth_passwd' ]
);
# Check this sub params
unless ($params->{auth_user} && $params->{auth_passwd}) {
return '';
}
return "Basic " . MIME::Base64::encode( $params->{auth_user} . ":" . $params->{auth_passwd} );
}
# Wrapper for "ref" on undef value, without warnings :)
# Possible very stupid sub :)
# STATIC(REF: our_ref)
sub refs {
my $ref = shift;
return '' unless $ref;
return ref $ref;
}
# INTERNAL!!! Check server answer result
# STATIC(data_block)
sub is_success {
my $data_block = shift;
my $want_hash = shift;
if ( $data_block &&
ref $data_block eq 'HASH' &&
lib/API/CPanel.pm view on Meta::CPAN
return $want_hash ? {} : '';
}
}
# all params derived from get_auth_hash
sub query_abstract {
my %params = @_;
my $params_raw = $params{params};
my $func_name = $params{func};
my $container = $params{container};
lib/API/CPanel.pm view on Meta::CPAN
warn "auth_hash not found" if $DEBUG;
return '';
}
}
# Abstract sub for action methods
sub action_abstract {
my %params = @_;
my $result = query_abstract(
params => $params{params},
func => $params{func},
lib/API/CPanel.pm view on Meta::CPAN
);
return $params{want_hash} && is_success( $result, $params{want_hash} ) ? $result : is_success( $result );
}
# Abstract sub for fetch arrays
sub fetch_array_abstract {
my %params = @_;
my $result_field = $params{result_field} || '';
my $result_list = [ ];
my $result = query_abstract(
lib/API/CPanel.pm view on Meta::CPAN
};
return $result_list;
}
# Abstract sub for fetch hash
sub fetch_hash_abstract {
my %params = @_;
my $result = query_abstract(
params => $params{params},
func => $params{func},
API-Client
view release on metacpan or search on metacpan
lib/API/Client.pm view on Meta::CPAN
use Data::Object::Class;
extends 'API::Client';
sub auth {
['admin', 'secret']
}
sub headers {
[['Accept', '*/*']]
}
sub base {
['https://httpbin.org/get']
}
package main;
API-DeutscheBahn-Fahrplan
view release on metacpan or search on metacpan
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
Fetch information about locations matching the given name or name fragment.
=cut
sub location {
return shift->_request( 'location', @_ );
}
=head2 arrival_board
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
Fetch the arrival board at a given location at a given date and time. The date
parameter should be in the ISO-8601 format.
=cut
sub arrival_board {
return shift->_request( 'arrival_board', @_ );
}
=head2 departure_board
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
Fetch the departure board at a given location at a given date and time. The date
parameter should be in the ISO-8601 format.
=cut
sub departure_board {
return shift->_request( 'departure_board', @_ );
}
=head2 journey_details
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
Retrieve details of a journey for a given id.
=cut
sub journey_details {
my ( $self, %args ) = @_;
return $self->_request( 'journey_details',
# id needs to be uri encoded
id => uri_encode( $args{id} ) );
}
# PRIVATE METHODS
sub _request {
my ( $self, $name, %args ) = @_;
my ( $method, $uri ) = $self->_create_uri( $name, %args );
my $response = $self->_client->$method($uri);
return JSON::XS::decode_json $response->{content};
}
sub _create_uri {
my ( $self, $name, %args ) = @_;
my $uri = $self->_base_uri;
my $definition = $self->_api->{$name};
my ( $method, $path ) = @{$definition}{qw(method path)};
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
return ( lc $method, $uri );
}
sub _base_uri {
return URI->new(
$_[0]->access_token
? $_[0]->fahrplan_plus_url
: $_[0]->fahrplan_free_url
);
}
sub _api {
return {
location => {
method => 'GET',
path => '/location',
path_parameters => ['name'],
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
# BUILDERS
sub _build_client {
my $self = $_[0];
my @args;
push @args, 'Authorization' => sprintf( 'Bearer %s', $self->access_token )
if $self->access_token;
API-DirectAdmin
view release on metacpan or search on metacpan
lib/API/DirectAdmin.pm view on Meta::CPAN
dns => 'DNS',
ip => 'Ip',
);
# init
sub new {
my $class = shift;
$class = ref ($class) || $class;
my $self = {
auth_user => '',
lib/API/DirectAdmin.pm view on Meta::CPAN
return bless $self, $class;
}
# initialize components
sub init_components {
my ( %c ) = @_;
my $caller = caller;
for my $alias ( keys %c ) {
my $item = $c{$alias};
my $sub = sub {
my( $self ) = @_;
$self->{"_$alias"} ||= $self->load_component($item);
return $self->{"_$alias"} || confess "Not implemented!";
};
lib/API/DirectAdmin.pm view on Meta::CPAN
*{"$caller\::$alias"} = $sub;
}
}
# loads component package and creates object
sub load_component {
my ( $self, $item ) = @_;
my $pkg = ref($self) . '::' . $item;
my $module = "$pkg.pm";
lib/API/DirectAdmin.pm view on Meta::CPAN
}
# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
my ($self, $hash, $allowed_keys) = @_;
return {} unless defined $hash;
confess "Wrong params" unless ref $hash eq 'HASH' && ref $allowed_keys eq 'ARRAY';
lib/API/DirectAdmin.pm view on Meta::CPAN
return $new_hash;
}
# all params derived from get_auth_hash
sub query {
my ( $self, %params ) = @_;
my $command = delete $params{command};
my $fields = $params{allowed_fields} || '';
lib/API/DirectAdmin.pm view on Meta::CPAN
return $server_answer;
}
# Kill slashes at start / end string
# STATIC(STRING:input_string)
sub kill_start_end_slashes {
my ($self ) = @_;
for ( $self->{host} ) {
s/^\/+//sgi;
s/\/+$//sgi;
lib/API/DirectAdmin.pm view on Meta::CPAN
# host*
# port*
# param1
# param2
# ...
sub mk_full_query_string {
my ( $self, $params ) = @_;
confess "Wrong params: " . Dumper( $params ) unless ref $params eq 'HASH'
&& scalar keys %$params
&& $self->{host}
lib/API/DirectAdmin.pm view on Meta::CPAN
return $query_path . $self->mk_query_string($params);
}
# Make query string
# STATIC(HASHREF: params)
sub mk_query_string {
my ($self, $params) = @_;
return '' unless ref $params eq 'HASH' && scalar keys %$params;
my %params = %$params;
lib/API/DirectAdmin.pm view on Meta::CPAN
return $result;
}
# Get + deparse
# STATIC(STRING: query_string)
sub process_query {
my ( $self, %params ) = @_;
my $query_string = $params{query_string};
my $method = $params{method};
lib/API/DirectAdmin.pm view on Meta::CPAN
return $answer;
}
# Make request to server and get answer
# STATIC (STRING: query_string)
sub mk_query_to_server {
my ( $self, $method, $url, $params ) = @_;
unless ( $method ~~ [ qw( POST GET ) ] ) {
confess "Unknown request method: '$method'";
}
lib/API/DirectAdmin.pm view on Meta::CPAN
return $content if $params->{noparse};
return $self->parse_answer($content);
}
# Parse answer
sub parse_answer {
my ($self, $response) = @_;
return '' unless $response;
my %answer;
API-Drip-Request
view release on metacpan or search on metacpan
bin/drip_client.pl view on Meta::CPAN
p $@;
}
exit;
sub record_event {
my %OPT = @_;
$OPT{email} or $OPT{id} or pod2usage( "Either -email or -id is required for -event" );
$OPT{action} or pod2usage( "-action is required for -event" );
bin/drip_client.pl view on Meta::CPAN
my $result = $client->do_request( POST => 'events', { events => [ $content ] } );
p $result;
}
sub get_workflows {
my %OPT = @_;
my $result = $client->do_request( GET => 'workflows' );
p $result;
}
sub start_workflow {
my %OPT = @_;
$OPT{workflow} or pod2usage( "Required parameter -workflow missing for -startwork" );
my $subscriber = _build_hash( %OPT, keys => [qw( email id user_id time_zone prospect )] );
bin/drip_client.pl view on Meta::CPAN
my $result = $client->do_request( POST => $endpoint, { subscribers => [ $subscriber ] } );
p $result;
}
sub delete_subscribers {
my %OPT = @_;
my $id = $OPT{email} || $OPT{id};
die "email or id required in delete subscriber" unless $id;
my $result = $client->do_request( DELETE => "subscribers/$id" );
p $result;
}
sub add_subscribers {
my %OPT = @_;
my $subscriber = _build_hash( %OPT, keys => [qw( email id new_email user_id time_zone lifetime_value ip_address )] );
die "email or id required in add subscriber" unless $subscriber->{email} or $subscriber->{id};
my $result = $client->do_request( POST => 'subscribers', { subscribers => [ $subscriber ]});
p $result;
}
sub _build_hash {
my %OPT = @_;
my $build = {};
foreach my $key ( @{$OPT{keys}} ) {
next unless defined $OPT{$key};
$build->{$key} = $OPT{$key};
}
return $build;
}
sub get_subscribers {
my $result = $client->do_request( GET => 'subscribers' );
p $result;
}
API-Eulerian
view release on metacpan or search on metacpan
lib/API/Eulerian/EDW.pm view on Meta::CPAN
use strict;
use API::Eulerian::EDW::Peer::Rest();
sub new {
my $proto = shift();
my $class = ref($proto) || $proto;
return bless({}, $class);
}
sub get_csv_file {
my ($self, $rh_p, $query) = @_;
$rh_p ||= {};
$rh_p->{accept} = 'text/csv';
$rh_p->{hook} = 'API::Eulerian::EDW::Hook::Noop';
API-Facebook
view release on metacpan or search on metacpan
requires "API::Client" => "0.03";
requires "Data::Object" => "0.57";
requires "Mojolicious" => "6.22";
requires "perl" => "v5.14.0";
on 'test' => sub {
requires "perl" => "v5.14.0";
};
on 'configure' => sub {
requires "ExtUtils::MakeMaker" => "0";
};
API-GitForge
view release on metacpan or search on metacpan
lib/API/GitForge.pm view on Meta::CPAN
"github.com" => "API::GitForge::GitHub",
"salsa.debian.org" => "API::GitForge::GitLab",
);
sub new_from_domain {
my %opts = @_;
croak "unknown domain" unless exists $known_forges{ $opts{domain} };
$known_forges{ $opts{domain} }->new(%opts);
}
sub forge_access_token {
my $domain = shift;
my $root = $ENV{XDG_CONFIG_HOME} || catfile $ENV{HOME}, ".config";
my $file = catfile $root, "gitforge", "access_tokens", $domain;
-e $file and -r _ or croak "$file does not exist or is not readable";
open my $fh, "<", $file or die "failed to open $file for reading: $!";
chomp(my $key = <$fh>);
$key;
}
sub remote_forge_info {
my $remote = shift;
my $git = Git::Wrapper->new(getcwd);
my ($uri) = $git->remote("get-url", $remote);
$uri =~ m#^https?://([^:/@]+)/#
or $uri =~ m#^(?:\w+\@)?([^:/@]+):#
API-Github
view release on metacpan or search on metacpan
requires "API::Client" => "0.03";
requires "Data::Object" => "0.57";
requires "Mojolicious" => "6.22";
requires "perl" => "v5.14.0";
on 'test' => sub {
requires "perl" => "v5.14.0";
};
on 'configure' => sub {
requires "ExtUtils::MakeMaker" => "0";
};
API-Google
view release on metacpan or search on metacpan
lib/API/Google.pm view on Meta::CPAN
use Mojo::UserAgent;
use Config::JSON;
use Data::Dumper;
sub new {
my ($class, $params) = @_;
my $h = {};
if ($params->{tokensfile}) {
$h->{tokensfile} = Config::JSON->new($params->{tokensfile});
} else {
lib/API/Google.pm view on Meta::CPAN
return bless $h, $class;
}
sub refresh_access_token {
my ($self, $params) = @_;
warn "Attempt to refresh access_token with params: ".Dumper $params if $self->{debug};
$params->{grant_type} = 'refresh_token';
$self->{ua}->post('https://www.googleapis.com/oauth2/v4/token' => form => $params)->res->json; # tokens
};
sub client_id {
shift->{tokensfile}->get('gapi/client_id');
}
sub ua {
shift->{ua};
}
sub client_secret {
shift->{tokensfile}->get('gapi/client_secret');
}
sub refresh_access_token_silent {
my ($self, $user) = @_;
my $tokens = $self->refresh_access_token({
client_id => $self->client_id,
client_secret => $self->client_secret,
refresh_token => $self->get_refresh_token_from_storage($user)
lib/API/Google.pm view on Meta::CPAN
$res->{new} = $self->get_access_token_from_storage($user);
return $res;
};
sub get_refresh_token_from_storage {
my ($self, $user) = @_;
warn "get_refresh_token_from_storage(".$user.")" if $self->{debug};
return $self->{tokensfile}->get('gapi/tokens/'.$user.'/refresh_token');
};
sub get_access_token_from_storage {
my ($self, $user) = @_;
$self->{tokensfile}->get('gapi/tokens/'.$user.'/access_token');
};
sub set_access_token_to_storage {
my ($self, $user, $token) = @_;
$self->{tokensfile}->set('gapi/tokens/'.$user.'/access_token', $token);
};
sub build_headers {
my ($self, $user) = @_;
my $t = $self->get_access_token_from_storage($user);
my $headers = {};
$headers->{'Authorization'} = 'Bearer '.$t;
return $headers;
}
sub build_http_transaction {
my ($self, $params) = @_;
warn "build_http_transaction() params : ".Dumper $params if $self->{debug};
my $headers = $self->build_headers($params->{user});
lib/API/Google.pm view on Meta::CPAN
}
sub api_query {
my ($self, $params, $payload) = @_;
warn "api_query() params : ".Dumper $params if $self->{debug};
$payload = { payload => $payload };
API-Handle
view release on metacpan or search on metacpan
lib/API/Handle.pm view on Meta::CPAN
is => 'rw'
, isa => 'Nour::Config'
, handles => [ qw/config/ ]
, required => 1
, lazy => 1
, default => sub {
require Nour::Config;
return new Nour::Config ( -base => 'config' );
}
);
lib/API/Handle.pm view on Meta::CPAN
is => 'rw'
, isa => 'Nour::Printer'
, handles => [ qw/verbose debug info warn warning error fatal dumper/ ]
, required => 1
, lazy => 1
, default => sub {
my $self = shift;
my %conf = $self->config->{printer} ? %{ $self->config->{printer} } : (
timestamp => 1
, verbose => 1
, dumper => 1
lib/API/Handle.pm view on Meta::CPAN
has _database => (
is => 'rw'
, isa => 'Nour::Database'
, required => 1
, lazy => 1
, default => sub {
my $self = shift;
my %conf = $self->config->{database} ? %{ $self->config->{database} } : (
# default options here
);
%conf = ();
lib/API/Handle.pm view on Meta::CPAN
has _json => (
is => 'rw'
, isa => 'JSON::XS'
, lazy => 1
, required => 1
, default => sub {
require JSON::XS;
return JSON::XS->new->utf8->ascii->relaxed;
}
);
has _xml => (
is => 'rw'
, isa => 'XML::TreePP'
, lazy => 1
, required => 1
, default => sub {
require XML::TreePP;
return new XML::TreePP (
output_encoding => 'UTF-8'
, utf8_flag => 1
, attr_prefix => '-'
lib/API/Handle.pm view on Meta::CPAN
has ua => (
is => 'rw'
, isa => 'LWP::UserAgent'
, lazy => 1
, required => 1
, default => sub {
require LWP::UserAgent;
return new LWP::UserAgent;
}
);
has uri => (
is => 'rw'
, isa => 'Str'
, required => 1
, lazy => 1
, default => sub { '' }
);
sub BUILD {
my $self = shift;
# Initialize attributes like 'uri' that may be set
# in the configuration YAML.
for my $attr ( keys %{ $self->config } ) {
lib/API/Handle.pm view on Meta::CPAN
if $self->can( $attr );
}
# Add request wrapper.
$self->ua->add_handler(
request_prepare => sub {
my ( $req, $ua, $h ) = @_;
# Set Content-Length header.
if ( my $data = $req->content ) {
$req->headers->header( 'Content-Length' => $self->_bytes( $data ) );
}
}
);
}
sub req {
my ( $self, %args ) = @_;
my $req = new HTTP::Request;
$args{content} ||= $args{data} ||= $args{body};
$args{method} ||= $args{type};
lib/API/Handle.pm view on Meta::CPAN
my $res = $self->ua->request( $req );
return wantarray ? ( $res, $req ) : $res;
}
sub db {
my ( $self, @args ) = @_;
$self->_database->switch_to( @args ) if @args;
return $self->_database;
}
# TODO: change all references to ->_encode to use ->encode and rename sub-routines
# TODO: same for _decode
sub _encode {
my ( $self, %args ) = @_;
my ( $data );
for ( $args{type} ) {
when ( 'json' ) {
lib/API/Handle.pm view on Meta::CPAN
}
return $data;
}
sub _decode {
my ( $self, %args ) = @_;
my ( $data );
for ( $args{type} ) {
when ( 'json' ) {
lib/API/Handle.pm view on Meta::CPAN
}
return $data;
}
sub _bytes {
my ( $self, $data ) = @_;
return length $data;
}
# A method that will let us write readable requests insteadOfCamelCase.
# Helpful for Google SOAP APIs. See ./t/02-google-dfp.t for example.
sub _camelize {
my $self = shift;
my $data = shift;
$data->{ lcfirst camelize $_ } = delete $data->{ $_ } for keys %{ $data };
lib/API/Handle.pm view on Meta::CPAN
}
}
}
}
sub _decamelize {
my $self = shift;
my $data = shift;
my %args = @_;
delete $data->{ $_ } # delete -xmlns and other attrs... why not?
lib/API/Handle.pm view on Meta::CPAN
}
}
}
}
sub _join_uri {
my ( $self, @path ) = @_;
my ( $base ) = ( $self->uri );
@path = map { $_ =~ s/^\///; $_ =~ s/\/$//; $_ } @path;
$base =~ s/\/$//;
return join '/', $base, @path;
}
sub _tied {
my ( $self, %args ) = @_;
my ( @array, %hash, $ref, $tied );
$ref = $args{ref}->{ $args{key} } if ref $args{ref} eq 'HASH';
$ref = $args{ref}->[ $args{index} ] if ref $args{ref} eq 'ARRAY';
API-INSEE-Sirene
view release on metacpan or search on metacpan
lib/API/INSEE/Sirene.pm view on Meta::CPAN
'typeVoieEtablissement', 'libelleVoieEtablissement',
'codePostalEtablissement', 'libelleCommuneEtablissement'
],
};
sub new {
my $class = shift;
my ($credentials, $timeout, $max_results, $proxy) = @_;
my $self = bless {
credentials => $credentials,
lib/API/INSEE/Sirene.pm view on Meta::CPAN
$self->setTimeout($timeout);
return $self;
}
sub setCredentials {
my ($self, $credentials) = @_;
$self->{'credentials'} = $credentials;
}
sub setMaxResults {
my ($self, $max_results) = @_;
$max_results //= DEFAULT_MAX_RESULTS;
$self->{'max_results'} = $max_results > HARD_MAX_RESULTS ? HARD_MAX_RESULTS : $max_results;
}
sub setDebugMode {
my ($self, $debug_value) = @_;
$self->{'debug_mode'} = $debug_value;
}
sub setProxy {
my ($self, $proxy) = @_;
defined $proxy ? $self->{'user_agent'}->proxy([ 'http', 'https' ], $proxy) : $self->{'user_agent'}->env_proxy;
}
sub setTimeout {
my ($self, $timeout) = @_;
$timeout //= DEFAULT_TIMEOUT;
$self->{'user_agent'}->timeout($timeout);
}
sub setCurrentEndpoint {
my ($self, $endpoint) = @_;
$self->{'current_endpoint'} = $endpoint;
}
sub _dumpRequest {
my ($self, $request, $response) = @_;
my $dump = sprintf "Sent request:\n%s\n", $request->as_string;
$dump .= sprintf "Received response:\n%s\n", $response->as_string if defined $response;
return $dump;
}
sub _initUserAgent {
my $self = shift;
$self->{'user_agent'} = LWP::UserAgent->new(protocols_allowed => [ 'http', 'https' ]);
$self->{'user_agent'}->agent("Perl API::INSEE::Sirene V$VERSION");
$self->{'user_agent'}->default_header('Accept' => 'application/json');
}
sub _getToken {
my $self = shift;
croak 'Please provide your credentials.' if !defined $self->{'credentials'};
my $request = POST API_AUTH_URL,
lib/API/INSEE/Sirene.pm view on Meta::CPAN
return 1, $self->_dumpRequest($request, $response);
}
}
}
sub _sendRequest {
my ($self, $parameters) = @_;
my $request;
if (!exists $parameters->{'q'}) {
my @url_parameters;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
return 1, $self->_dumpRequest($request, $response);
}
}
}
sub _buildParameters {
my ($self, $usefull_fields, $desired_fields, $criteria) = @_;
# Parameters names come from the documentation
my $parameters = {
date => strftime('%Y-%m-%d', localtime),
lib/API/INSEE/Sirene.pm view on Meta::CPAN
$parameters->{'q'} = sprintf('(%s)', $criteria) if defined $criteria;
return $parameters;
}
sub _buildFields {
my ($self, $usefull_fields, $desired_fields) = @_;
if (defined $desired_fields) {
return $self->_mapAliases($desired_fields);
}
else {
return join ',', @{ $usefull_fields };
}
}
sub _mapAliases {
my ($self, $desired_fields) = @_;
my @desired_fields = ref $desired_fields eq 'ARRAY' ? @{ $desired_fields } : $desired_fields;
foreach my $desired_field (@desired_fields) {
lib/API/INSEE/Sirene.pm view on Meta::CPAN
}
return join ',', @desired_fields;
}
sub getCustomCriteria {
my ($self, $field_name, $value, $search_mode) = @_;
croak 'No endpoint specified.' if !defined $self->{'current_endpoint'};
$search_mode //= 'aproximate';
lib/API/INSEE/Sirene.pm view on Meta::CPAN
$criteria = "periode($criteria)" if any { $_ eq $field_name } @{ $historized_fields->{$self->{'current_endpoint'}} };
return $criteria;
}
sub searchByCustomCriteria {
my ($self, $criteria, $desired_fields) = @_;
my $parameters;
switch ($self->{'current_endpoint'}) {
case 'siren' { $parameters = $self->_buildParameters($useful_fields_legal_unit, $desired_fields, $criteria) }
lib/API/INSEE/Sirene.pm view on Meta::CPAN
}
return $self->_sendRequest($parameters);
}
sub getLegalUnitBySIREN {
my ($self, $siren_number, $desired_fields) = @_;
return 1, "Invalid SIREN $siren_number -> Must be a ${ \MAX_SIREN_LENGTH } digits number."
if $siren_number !~ m/^\d{${ \MAX_SIREN_LENGTH }}$/;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $parameters = $self->_buildParameters($useful_fields_legal_unit, $desired_fields);
return $self->_sendRequest($parameters);
}
sub searchLegalUnitBySIREN {
my ($self, $siren_number, $desired_fields) = @_;
return 1, "Invalid SIREN $siren_number -> Must be a ${ \MIN_LENGTH } digits min and ${ \MAX_SIREN_LENGTH } digits number max."
if $siren_number !~ m/^\d{${ \MIN_LENGTH },${ \MAX_SIREN_LENGTH }}$/;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $criteria = $self->getCustomCriteria('siren', $siren_number, 'begin');
return $self->searchByCustomCriteria($criteria, $desired_fields);
}
sub getEstablishmentBySIRET {
my ($self, $siret_number, $desired_fields) = @_;
return 1, "Invalid SIRET $siret_number -> Must be a ${ \MAX_SIRET_LENGTH } digits number."
if $siret_number !~ m/^\d{${ \MAX_SIRET_LENGTH }}$/;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $parameters = $self->_buildParameters($useful_fields_establishment, $desired_fields);
return $self->_sendRequest($parameters);
}
sub getEstablishmentsBySIREN {
my ($self, $siren_number, $desired_fields) = @_;
return (1, "Invalid SIREN $siren_number -> Must be a ${ \MAX_SIREN_LENGTH } digits number.")
if $siren_number !~ m/^\d{${ \MAX_SIREN_LENGTH }}$/;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $criteria = $self->getCustomCriteria('siren', $siren_number);
return $self->searchByCustomCriteria($criteria, $desired_fields);
}
sub searchEstablishmentBySIRET {
my ($self, $siret_number, $desired_fields) = @_;
return 1, "Invalid SIRET $siret_number -> Must be a ${ \MIN_LENGTH } digits min and a ${ \MAX_SIRET_LENGTH } digits number max."
if $siret_number !~ m/^\d{${ \MIN_LENGTH },${ \MAX_SIRET_LENGTH }}$/;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $criteria = $self->getCustomCriteria('siret', $siret_number);
return $self->searchByCustomCriteria($criteria, $desired_fields);
}
sub getLegalUnitsByName {
my ($self, $name, $desired_fields) = @_;
$self->setCurrentEndpoint('siren');
my $criteria = $self->getCustomCriteria('denominationUniteLegale', $name);
return $self->searchByCustomCriteria($criteria, $desired_fields);
}
sub getEstablishmentsByName {
my ($self, $name, $desired_fields) = @_;
$self->setCurrentEndpoint('siret');
my $criteria = $self->getCustomCriteria('denominationUniteLegale', $name);
return $self->searchByCustomCriteria($criteria, $desired_fields);
}
sub getLegalUnitsByUsualName {
my ($self, $name, $desired_fields) = @_;
$self->setCurrentEndpoint('siren');
my $criteria = $self->getCustomCriteria('denominationUsuelle1UniteLegale', $name);
return $self->searchByCustomCriteria($criteria, $desired_fields);
}
sub getEstablishmentsByUsualName {
my ($self, $name, $desired_fields) = @_;
$self->setCurrentEndpoint('siret');
my $criteria = $self->getCustomCriteria('denominationUsuelle1UniteLegale', $name);
API-ISPManager
view release on metacpan or search on metacpan
lib/API/ISPManager.pm view on Meta::CPAN
# Last raw answer from server
our $last_answer = '';
# Public!
sub is_ok {
my $answer = shift;
return '' unless $answer && ref $answer eq 'HASH' && $answer->{success};
}
sub get_error {
my $answer = shift;
return '' if is_ok($answer); # ok == no error
return Dumper( $answer->{error} );
}
# Get data from @_
sub get_params {
my @params = @_;
if (scalar @params == 1 && ref $params[0] eq 'HASH' ) {
return { %{ $params[0] } };
} else {
lib/API/ISPManager.pm view on Meta::CPAN
}
}
# Make query string
# STATIC(HASHREF: params)
sub mk_query_string {
my $params = shift;
return '' unless $params &&
ref $params eq 'HASH' && %$params ;
lib/API/ISPManager.pm view on Meta::CPAN
return $result;
}
# Kill slashes at start / end string
# STATIC(STRING:input_string)
sub kill_start_end_slashes {
my $str = shift;
for ($str) {
s/^\/+//sgi;
s/\/+$//sgi;
lib/API/ISPManager.pm view on Meta::CPAN
# path
# allow_http
# param1
# param2
# ...
sub mk_full_query_string {
my $params = shift;
return '' unless
$params &&
ref $params eq 'HASH' &&
lib/API/ISPManager.pm view on Meta::CPAN
}
# Make request to server and get answer
# STATIC (STRING: query_string)
sub mk_query_to_server {
my $query_string = shift;
return '' unless $query_string;
warn "Query string: $query_string\n" if $DEBUG;
lib/API/ISPManager.pm view on Meta::CPAN
# Parse answer
# STATIC(HASHREF: params)
# params:
# STRING: answer
# HASHREF: xml_parser_params)
sub parse_answer {
my %params = @_;
my $answer_string =
$params{answer};
my $parser_params =
lib/API/ISPManager.pm view on Meta::CPAN
return $deparsed ? $deparsed : '';
}
# Get + deparse
# STATIC(STRING: query_string)
sub process_query {
my %params = @_;
my $query_string = $params{query_string};
my $xml_parser_params = $params{parser_params} || '';
my $fake_answer = $params{fake_answer} || '';
lib/API/ISPManager.pm view on Meta::CPAN
}
# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
my ($hash, $allowed_keys) = @_;
return unless ref $hash eq 'HASH' &&
ref $allowed_keys eq 'ARRAY';
lib/API/ISPManager.pm view on Meta::CPAN
# STATIC(HASHREF: params_hash)
# params_hash:
# - all elements from mk_full_query_string +
# - username*
# - password*
sub get_auth_id {
my %params_raw = @_;
warn 'get_auth_id params: ' . Dumper(\%params_raw) if $DEBUG;
my $params = filter_hash(
\%params_raw,
[ 'host', 'path', 'allow_http', 'username', 'password' ]
);
# Check this sub params
unless ($params->{username} && $params->{password}) {
return '';
}
lib/API/ISPManager.pm view on Meta::CPAN
return '';
}
}
# Wrapper for "ref" on undef value, without warnings :)
# Possible very stupid sub :)
# STATIC(REF: our_ref)
sub refs {
my $ref = shift;
return '' unless $ref;
return ref $ref;
}
# INTERNAL!!! Check server answer result
# STATIC(data_block)
sub is_success {
my $data_block = shift;
if ( ref $data_block eq 'HASH' && ! $data_block->{error} && $data_block->{data} ) {
return 1;
} else {
lib/API/ISPManager.pm view on Meta::CPAN
}
}
# Get data from server answer
# STATIC(data_block)
sub get_data {
my $data_block = shift;
unless ( is_success($data_block) ) {
return '';
}
lib/API/ISPManager.pm view on Meta::CPAN
return $data_block->{data};
}
# list all users
# all params derived from get_auth_id
sub query_abstract {
my %params = @_;
my $params_raw = $params{params};
my $func_name = $params{func};
my $fake_answer = $params{fake_answer} || '';
API-Instagram
view release on metacpan or search on metacpan
lib/API/Instagram.pm view on Meta::CPAN
use API::Instagram::Search;
has client_id => ( is => 'ro', required => 1 );
has client_secret => ( is => 'ro', required => 1 );
has redirect_uri => ( is => 'ro', required => 1 );
has scope => ( is => 'ro', default => sub { 'basic' } );
has response_type => ( is => 'ro', default => sub { 'code' } );
has grant_type => ( is => 'ro', default => sub { 'authorization_code' } );
has code => ( is => 'rw', isa => sub { confess "Code not provided" unless $_[0] } );
has access_token => ( is => 'rw', isa => sub { confess "No access token provided" unless $_[0] } );
has no_cache => ( is => 'rw', default => sub { 0 } );
has _ua => ( is => 'ro', default => sub { Furl->new() } );
has _obj_cache => ( is => 'ro', default => sub { { User => {}, Media => {}, Location => {}, Tag => {}, 'Media::Comment' => {} } } );
has _endpoint_url => ( is => 'ro', default => sub { 'https://api.instagram.com/v1' } );
has _authorize_url => ( is => 'ro', default => sub { 'https://api.instagram.com/oauth/authorize' } );
has _access_token_url => ( is => 'ro', default => sub { 'https://api.instagram.com/oauth/access_token' } );
has _debug => ( is => 'rw', lazy => 1 );
my $instance;
sub BUILD { $instance = shift }
sub instance { $instance //= shift->new(@_) }
sub get_auth_url {
my $self = shift;
carp "User already authorized with code: " . $self->code if $self->code;
my @auth_fields = qw(client_id redirect_uri response_type scope);
lib/API/Instagram.pm view on Meta::CPAN
$uri->query_form( map { $_ => $self->$_ } @auth_fields );
$uri->as_string();
}
sub get_access_token {
my $self = shift;
my @access_token_fields = qw(client_id redirect_uri grant_type client_secret code);
for ( @access_token_fields ) {
carp "ERROR: $_ required for generating access token." and return unless defined $self->$_;
lib/API/Instagram.pm view on Meta::CPAN
wantarray ? ( $json->{access_token}, $self->user( $json->{user} ) ) : $json->{access_token};
}
sub media { shift->_get_obj( 'Media', 'id', shift ) }
sub user { shift->_get_obj( 'User', 'id', shift // 'self' ) }
sub location { shift->_get_obj( 'Location', 'id', shift, 1 ) }
sub tag { shift->_get_obj( 'Tag', 'name', shift ) }
sub search {
my $self = shift;
my $type = shift;
API::Instagram::Search->new( type => $type )
}
sub popular_medias {
my $self = shift;
my $url = "/media/popular";
$self->_medias( $url, { @_%2?():@_ } );
}
sub _comment { shift->_get_obj( 'Media::Comment', 'id', shift ) }
#####################################################
# Returns cached wanted object or creates a new one #
#####################################################
sub _get_obj {
my ( $self, $type, $key, $code, $optional_code ) = @_;
my $data = { $key => $code };
$data = $code if ref $code eq 'HASH';
$code = $data->{$key};
lib/API/Instagram.pm view on Meta::CPAN
}
###################################
# Returns a list of Media Objects #
###################################
sub _medias {
my ($self, $url, $params, $opts) = @_;
$params->{count} //= 33;
$params->{url} = $url;
[ map { $self->media($_) } $self->_get_list( { %$params, url => $url }, $opts ) ]
}
####################################################################
# Returns a list of the requested items. Does pagination if needed #
####################################################################
sub _get_list {
my $self = shift;
my $params = shift;
my $opts = shift;
my $url = delete $params->{url} || return [];
lib/API/Instagram.pm view on Meta::CPAN
}
##############################################################
# Requests the data from the given URL with QUERY parameters #
##############################################################
sub _request {
my ( $self, $method, $url, $params, $opts ) = @_;
# Verifies access requirements
unless ( defined $self->access_token ) {
if ( !$opts->{token_not_required} or !defined $self->client_id ) {
lib/API/Instagram.pm view on Meta::CPAN
use Data::Dumper;
# die Dumper $res;
$res;
}
sub _request_data { shift->_request(@_)->{data} || {} }
sub _del { shift->_request_data( 'delete', @_ ) }
sub _get { shift->_request_data( 'get', @_ ) }
sub _post { shift->_request_data( 'post', @_ ) }
################################
# Returns requested cache hash #
################################
sub _cache { shift->_obj_cache->{ shift() } }
1;
__END__
API-Intis
view release on metacpan or search on metacpan
API/Intis/lib/API/Intis.pm view on Meta::CPAN
use Digest::Perl::MD5 'md5_hex';
use JSON;
use error_codes;
sub readConfig {
my $conf = YAML::Tiny->read( 'config.yaml' );
return (login => $conf->[0]->{APIconnector}->{login}, APIkey => $conf->[0]->{APIconnector}->{APIkey}, host => $conf->[0]->{APIconnector}->{host});
};
sub build_signature {
my (%params) = @_;
delete $params{host};
my $APIkey = delete $params{APIkey};
my @ssignature;
foreach my $key(sort keys %params){
API/Intis/lib/API/Intis.pm view on Meta::CPAN
push @ssignature, $params{$key};
};
return md5_hex join('', @ssignature).$APIkey;
};
sub connect {
my ($method, $other_params) = @_;
my $ua = WWW::Mechanize->new(ssl_opts => { verify_hostname => 0 } );
$ua->cookie_jar(HTTP::Cookies->new());
$ua->agent_alias('Linux Mozilla');
my %config = &readConfig();
API/Intis/lib/API/Intis.pm view on Meta::CPAN
return (request_json => $request_json, error => \@error, request_xml => $request_xml, request_object => \%{$r}, out_format => !defined $output_format ? 'json' : $output_format );
};
package API::Intis::APIRequest;
use JSON;
sub new {
my($class, $method, $other_params) = @_;
my %request_params;
if (defined $other_params) {
%request_params = &API::Intis::APIGrab::connect($method, $other_params);
} else {
API-MailboxOrg
view release on metacpan or search on metacpan
lib/API/MailboxOrg.pm view on Meta::CPAN
our $VERSION = '1.0.2'; # VERSION
has user => ( is => 'ro', isa => Str, required => 1 );
has password => ( is => 'ro', isa => Str, required => 1 );
has token => ( is => 'rwp', isa => Str );
has host => ( is => 'ro', isa => MojoURL["https?"], default => sub { 'https://api.mailbox.org' }, coerce => 1 );
has base_uri => ( is => 'ro', isa => Str, default => sub { 'v1/' } );
has client => (
is => 'ro',
lazy => 1,
isa => MojoUserAgent,
default => sub {
Mojo::UserAgent->new
}
);
sub _load_namespace ($package) {
my @modules = find_modules $package . '::API', { recursive => 1 };
for my $module ( @modules ) {
load_class( $module );
my $base = (split /::/, $module)[-1];
no strict 'refs'; ## no critic
*{ $package . '::' . decamelize( $base ) } = sub ($api) {
weaken $api;
state $object //= $module->instance(
api => $api,
);
API-Mathpix
view release on metacpan or search on metacpan
lib/API/Mathpix.pm view on Meta::CPAN
=head1 SUBROUTINES/METHODS
=cut
sub BUILD {
my ($self) = @_;
$self->_ua(
LWP::UserAgent->new(
timeout => 30,
lib/API/Mathpix.pm view on Meta::CPAN
=head2 process
=cut
sub process {
my ($self, $opt) = @_;
if (-f $opt->{src}) {
API-Medium
view release on metacpan or search on metacpan
lib/API/Medium.pm view on Meta::CPAN
isa => 'HTTP::Tiny',
is => 'ro',
lazy_build => 1,
);
sub _build__client {
my $self = shift;
return HTTP::Tiny->new(
agent => join( '/', __PACKAGE__, $VERSION ),
default_headers => {
lib/API/Medium.pm view on Meta::CPAN
'Content-Type' => 'application/json',
}
);
}
sub get_current_user {
my $self = shift;
my $res = $self->_request( 'GET', 'me' );
return $res->{data};
}
sub create_post {
my ( $self, $user_id, $post ) = @_;
$post->{publishStatus} ||= 'draft';
my $res = $self->_request( 'POST', 'users/' . $user_id . '/posts', $post );
return $res->{data}{url};
}
sub create_publication_post {
my ( $self, $publication_id, $post ) = @_;
$post->{publishStatus} ||= 'draft';
my $res =
$self->_request( 'POST', 'publications/' . $publication_id . '/posts',
$post );
return $res->{data}{url};
}
sub _request {
my ( $self, $method, $endpoint, $data ) = @_;
my $url = join( '/', $self->server, $endpoint );
my $res;
API-MikroTik
view release on metacpan or search on metacpan
lib/API/MikroTik.pm view on Meta::CPAN
our $VERSION = 'v0.242';
has error => '';
has host => '192.168.88.1';
has ioloop => sub { Mojo::IOLoop->new() };
has password => '';
has port => 0;
has timeout => 10;
has tls => 1;
has user => 'admin';
lib/API/MikroTik.pm view on Meta::CPAN
# Aliases
Mojo::Util::monkey_patch(__PACKAGE__, 'cmd', \&command);
Mojo::Util::monkey_patch(__PACKAGE__, 'cmd_p', \&command_p);
Mojo::Util::monkey_patch(__PACKAGE__, '_fail', \&_finish);
sub DESTROY { Mojo::Util::_global_destruction() or shift->_cleanup() }
sub cancel {
my $cb = ref $_[-1] eq 'CODE' ? pop : sub { };
return shift->_command(Mojo::IOLoop->singleton, '/cancel', {'tag' => shift},
undef, $cb);
}
sub command {
my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
my ($self, $cmd, $attr, $query) = @_;
# non-blocking
return $self->_command(Mojo::IOLoop->singleton, $cmd, $attr, $query, $cb)
if $cb;
# blocking
my $res;
$self->_command($self->ioloop, $cmd, $attr, $query,
sub { $_[0]->ioloop->stop(); $res = $_[2]; });
$self->ioloop->start();
return $res;
}
sub command_p {
Carp::croak 'Mojolicious v7.54+ is required for using promises.'
unless PROMISES;
my ($self, $cmd, $attr, $query) = @_;
my $p = Mojo::Promise->new();
$self->_command(
Mojo::IOLoop->singleton,
$cmd, $attr, $query,
sub {
return $p->reject($_[1], $_[2]) if $_[1];
$p->resolve($_[2]);
}
);
return $p;
}
sub subscribe {
do { $_[0]->{error} = 'can\'t subscribe in blocking mode'; return; }
unless ref $_[-1] eq 'CODE';
my $cb = pop;
my ($self, $cmd, $attr, $query) = @_;
$attr->{'.subscription'} = 1;
return $self->_command(Mojo::IOLoop->singleton, $cmd, $attr, $query, $cb);
}
sub _cleanup {
my $self = shift;
$_->{timeout} && $_->{loop}->remove($_->{timeout})
for values %{$self->{requests}};
$_ && $_->unsubscribe('close')->close() for values %{$self->{handles}};
delete $self->{handles};
}
sub _close {
my ($self, $loop) = @_;
$self->_fail_all($loop, 'closed prematurely');
delete $self->{handles}{$loop};
delete $self->{responses}{$loop};
}
sub _command {
my ($self, $loop, $cmd, $attr, $query, $cb) = @_;
my $tag = ++$self->{_tag};
my $r = $self->{requests}{$tag} = {tag => $tag, loop => $loop, cb => $cb};
$r->{subscription} = delete $attr->{'.subscription'};
lib/API/MikroTik.pm view on Meta::CPAN
$r->{sentence} = encode_sentence($cmd, $attr, $query, $tag);
return $self->_send_request($r);
}
sub _connect {
my ($self, $r) = @_;
warn "-- creating new connection\n" if DEBUG;
my $queue = $self->{queues}{$r->{loop}} = [$r];
lib/API/MikroTik.pm view on Meta::CPAN
address => $self->host,
port => $port,
timeout => CONN_TIMEOUT,
tls => $tls,
tls_ciphers => 'HIGH'
} => sub {
my ($loop, $err, $stream) = @_;
delete $self->{queues}{$loop};
if ($err) { $self->_fail($_, $err) for @$queue; return }
lib/API/MikroTik.pm view on Meta::CPAN
warn "-- connection established\n" if DEBUG;
$self->{handles}{$loop} = $stream;
weaken $self;
$stream->on(read => sub { $self->_read($loop, $_[1]) });
$stream->on(
error => sub { $self and $self->_fail_all($loop, $_[1]) });
$stream->on(close => sub { $self && $self->_close($loop) });
$self->_login(
$loop,
sub {
if ($_[1]) {
$_[0]->_fail($_, $_[1]) for @$queue;
$stream->close();
return;
}
lib/API/MikroTik.pm view on Meta::CPAN
);
return $r->{tag};
}
sub _enqueue {
my ($self, $r) = @_;
return $self->_connect($r) unless my $queue = $self->{queues}{$r->{loop}};
push @$queue, $r;
return $r->{tag};
}
sub _fail_all {
$_[0]->_fail($_, $_[2])
for grep { $_->{loop} eq $_[1] } values %{$_[0]->{requests}};
}
sub _finish {
my ($self, $r, $err) = @_;
delete $self->{requests}{$r->{tag}};
if (my $timer = $r->{timeout}) { $r->{loop}->remove($timer) }
$r->{cb}->($self, ($self->{error} = $err // ''), $r->{data});
}
sub _login {
my ($self, $loop, $cb) = @_;
warn "-- trying to log in\n" if DEBUG;
$loop->delay(
sub {
$self->_command($loop, '/login', {}, undef, $_[0]->begin());
},
sub {
my ($delay, $err, $res) = @_;
return $self->$cb($err) if $err;
my $secret
= md5_sum("\x00", $self->password, pack 'H*', $res->[0]{ret});
$self->_command($loop, '/login',
{name => $self->user, response => "00$secret"},
undef, $delay->begin());
},
sub {
$self->$cb($_[1]);
},
);
}
sub _read {
my ($self, $loop, $bytes) = @_;
warn "-- read bytes from socket: " . (length $bytes) . "\n" if DEBUG;
my $response = $self->{responses}{$loop} ||= API::MikroTik::Response->new();
lib/API/MikroTik.pm view on Meta::CPAN
$self->_fail($r, $_->{message});
}
}
}
sub _send_request {
my ($self, $r) = @_;
return $self->_enqueue($r) unless my $stream = $self->{handles}{$r->{loop}};
return $self->_write_sentence($stream, $r);
}
sub _write_sentence {
my ($self, $stream, $r) = @_;
warn "-- writing sentence for tag: $r->{tag}\n" if DEBUG;
$stream->write($r->{sentence});
return $r->{tag} if $r->{subscription};
weaken $self;
$r->{timeout} = $r->{loop}
->timer($self->timeout => sub { $self->_fail($r, 'response timeout') });
return $r->{tag};
}
1;
lib/API/MikroTik.pm view on Meta::CPAN
# Non-blocking
my $tag = $api->command(
'/system/resource/print',
{'.proplist' => 'board-name,version,uptime'} => sub {
my ($api, $err, $list) = @_;
...;
}
);
Mojo::IOLoop->start();
# Subscribe
$tag = $api->subscribe(
'/interface/listen' => sub {
my ($api, $err, $el) = @_;
...;
}
);
Mojo::IOLoop->timer(3 => sub { $api->cancel($tag) });
Mojo::IOLoop->start();
# Errors handling
$api->command(
'/random/command' => sub {
my ($api, $err, $list) = @_;
if ($err) {
warn "Error: $err, category: " . $list->[0]{category};
return;
lib/API/MikroTik.pm view on Meta::CPAN
);
Mojo::IOLoop->start();
# Promises
$api->cmd_p('/interface/print')
->then(sub { my $res = shift }, sub { my ($err, $attr) = @_ })
->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
=head1 DESCRIPTION
B<This module is deprecated in favour of> L<MikroTik::Client>B<.>
lib/API/MikroTik.pm view on Meta::CPAN
=head1 METHODS
=head2 cancel
# subscribe to a command output
my $tag = $api->subscribe('/ping', {address => '127.0.0.1'} => sub {...});
# cancel command after 10 seconds
Mojo::IOLoop->timer(10 => sub { $api->cancel($tag) });
# or with callback
$api->cancel($tag => sub {...});
Cancels background commands. Can accept a callback as last argument.
=head2 cmd
lib/API/MikroTik.pm view on Meta::CPAN
for (@$list) {...}
$api->command('/user/set', {'.id' => 'admin', comment => 'System admin'});
# Non-blocking
$api->command('/ip/address/print' => sub {
my ($api, $err, $list) = @_;
return if $err;
for (@$list) {...}
});
# Omit attributes
$api->command('/user/print', undef, {name => 'admin'} => sub {...});
# Errors handling
$list = $api->command('/random/command');
if (my $err = $api->error) {
die "Error: $err, category: " . $list->[0]{category};
lib/API/MikroTik.pm view on Meta::CPAN
=head2 command_p
my $promise = $api->command_p('/interface/print');
$promise->then(
sub {
my $res = shift;
...
})->catch(sub {
my ($err, $attr) = @_;
});
Same as L</command>, but always performs requests non-blocking and returns a
L<Mojo::Promise> object instead of accepting a callback. L<Mojolicious> v7.54+ is
required for promises functionality.
=head2 subscribe
my $tag = $api->subscribe('/ping',
{address => '127.0.0.1'} => sub {
my ($api, $err, $res) = @_;
});
Mojo::IOLoop->timer(
3 => sub { $api->cancel($tag) }
);
Subscribe to an output of commands with continuous responses such as C<listen> or
C<ping>. Should be terminated with L</cancel>.
API-Name
view release on metacpan or search on metacpan
requires "API::Client" => "0.03";
requires "Data::Object" => "0.57";
requires "Mojolicious" => "6.22";
requires "perl" => "v5.14.0";
on 'test' => sub {
requires "perl" => "v5.14.0";
};
on 'configure' => sub {
requires "ExtUtils::MakeMaker" => "0";
};
API-Octopart
view release on metacpan or search on metacpan
lib/API/Octopart.pm view on Meta::CPAN
=item * token => 'abcdefg-your-octopart-token-here',
This is your Octopart API token. You could do something like this to read the token from a file:
token => (sub { my $t = `cat ~/.octopart/token`; chomp $t; return $t})->(),
=item * include_specs => 1
If you have a PRO account then you can include product specs:
lib/API/Octopart.pm view on Meta::CPAN
=cut
our %valid_opts = map { $_ => 1 } qw/token include_specs cache cache_age ua_debug query_limit json_debug/;
sub new
{
my ($class, %args) = @_;
foreach my $arg (keys %args)
{
lib/API/Octopart.pm view on Meta::CPAN
=back
=cut
sub has_stock
{
my ($self, $part, %opts) = @_;
my $parts = $self->get_part_stock_detail($part, %opts);
lib/API/Octopart.pm view on Meta::CPAN
}
};
=cut
sub get_part_stock
{
my ($self, $part, %opts) = @_;
my $results = $self->get_part_stock_detail($part, %opts);
lib/API/Octopart.pm view on Meta::CPAN
...
]
=cut
sub get_part_stock_detail
{
my ($self, $part, %opts) = @_;
my $p = $self->query_part_detail($part);
lib/API/Octopart.pm view on Meta::CPAN
Return the JSON response structure as a perl ARRAY/HASH given a query meeting Octopart's
API specification.
=cut
sub octo_query
{
my ($self, $q) = @_;
my $part = shift;
lib/API/Octopart.pm view on Meta::CPAN
if ($self->{ua_debug})
{
$ua->add_handler(
"request_send",
sub {
my $msg = shift; # HTTP::Request
print STDERR "SEND >> \n"
. $msg->headers->as_string . "\n"
. "\n";
return;
}
);
$ua->add_handler(
"response_done",
sub {
my $msg = shift; # HTTP::Response
print STDERR "RECV << \n"
. $msg->headers->as_string . "\n"
. $msg->status_line . "\n"
. "\n";
lib/API/Octopart.pm view on Meta::CPAN
=item * $o->octo_query_count() - Return the number of API calls so far.
=cut
sub octo_query_count
{
my $self = shift;
return $self->{api_queries};
}
lib/API/Octopart.pm view on Meta::CPAN
"Basic Example" so you can easily lookup a specific part number. The has_stock()
and get_part_stock_detail() methods use this query internally.
=cut
sub query_part_detail
{
my ($self, $part) = @_;
# Specs require a pro account:
my $specs = '';
lib/API/Octopart.pm view on Meta::CPAN
}
));
}
our %_valid_filter_opts = ( map { $_ => 1 } (qw/currency max_moq min_qty max_price mfg seller/) );
sub _parse_part_stock
{
my ($self, $resp, %opts) = @_;
foreach my $o (keys %opts)
{
API-ParallelsWPB
view release on metacpan or search on metacpan
lib/API/ParallelsWPB.pm view on Meta::CPAN
our $VERSION = '0.03'; # VERSION
our $AUTHORITY = 'cpan:IMAGO'; # AUTHORITY
# Constuctor
sub new {
my $class = shift;
$class = ref $class || $class;
my $self = {
lib/API/ParallelsWPB.pm view on Meta::CPAN
# "free" request. Basic method for requests
sub f_request {
my ( $self, $url_array, $data ) = @_;
confess "$url_array is not array!" unless ( ref $url_array eq 'ARRAY' );
$data->{req_type} ||= 'GET';
lib/API/ParallelsWPB.pm view on Meta::CPAN
my $response = $self->_send_request($data, $url, $post_data);
return $response;
}
sub _send_request {
my ( $self, $data, $url, $post_data ) = @_;
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new( $data->{req_type} => $url );
lib/API/ParallelsWPB.pm view on Meta::CPAN
my $response = API::ParallelsWPB::Response->new( $res );
return $response;
}
sub _json {
my ( $self ) = @_;
unless( $self->{_json} ) {
$self->{_json} = JSON::XS->new;
}
API-Plesk
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
Accounts => [['1.5.0.0', 'Accounts']],
Domains => [['1.5.0.0', 'Domains']],
);
# constructor
sub new {
my $class = shift;
$class = ref ($class) || $class;
my $self = {
username => '',
lib/API/Plesk.pm view on Meta::CPAN
return bless $self, $class;
}
# sends request to Plesk API
sub send {
my ( $self, $operator, $operation, $data, %params ) = @_;
confess "Wrong request data!" unless $data && ref $data;
my $xml = { $operator => { $operation => $data } };
lib/API/Plesk.pm view on Meta::CPAN
response => $response,
error => $error,
);
}
sub bulk_send { confess "Not implemented!" }
# Send xml request to plesk api
sub xml_http_req {
my ($self, $xml) = @_;
# HTTP::Request undestends only bytes
utf8::encode($xml) if utf8::is_utf8($xml);
lib/API/Plesk.pm view on Meta::CPAN
$ua->ssl_opts(verify_hostname => 0) if $ua->can('ssl_opts');
warn $req->as_string if defined $self->{debug} && $self->{debug} > 1;
my $res = eval {
local $SIG{ALRM} = sub { die "connection timeout" };
alarm $self->{timeout};
$ua->request($req);
};
alarm 0;
lib/API/Plesk.pm view on Meta::CPAN
('', $res->status_line);
}
# renders xml packet for request
sub render_xml {
my ($self, $hash) = @_;
my $xml = _render_xml($hash);
$xml = qq|<?xml version="1.0" encoding="UTF-8"?><packet version="$self->{api_version}">$xml</packet>|;
$xml;
}
# renders xml from hash
sub _render_xml {
my ( $hash ) = @_;
return $hash unless ref $hash;
my $xml = '';
lib/API/Plesk.pm view on Meta::CPAN
$xml;
}
# initialize components
sub init_components {
my ( %c ) = @_;
my $caller = caller;
for my $alias ( keys %c ) {
my $classes = $c{$alias};
my $sub = sub {
my( $self ) = @_;
$self->{"_$alias"} ||= $self->load_component($classes);
return $self->{"_$alias"} || confess "Not implemented!";
};
lib/API/Plesk.pm view on Meta::CPAN
}
}
# loads component package and creates object
sub load_component {
my ( $self, $classes ) = @_;
my $version = version->parse($self->{api_version});
for my $item ( @$classes ) {
API-PleskExpand
view release on metacpan or search on metacpan
lib/API/PleskExpand.pm view on Meta::CPAN
=head1 DESCRIPTION
At present the module provides interaction with Plesk Expand 2.2.4 (API 2.2.4.1). Complete support of operations with Accounts, partial support of work with domains. Support of addition of domains to user Accounts.
API::PleskExpand module gives the convenient interface for addition of new functions. Extensions represent modules in a folder Plesk with definitions of demanded functions. Each demanded operation is described by two functions: op and op_response_par...
For example, here the set of subs in the Accounts module is those.
create / create_response_parse
modify / modify_response_parse
lib/API/PleskExpand.pm view on Meta::CPAN
=cut
sub new {
(undef) = shift @_;
my $self = __PACKAGE__->SUPER::new(@_);
$self->{package_name} = __PACKAGE__;
unless ($self->{api_version}) {
lib/API/PleskExpand.pm view on Meta::CPAN
Example:
my $res = $expand_client->Func_Module->operation_type(%params);
# Func_Module -- module in API/PleskExpand folder
# operation_type -- sub which defined in Func_Module.
# params hash used as @_ for operation_type sub.
=back
=cut
# OVERRIDE, INSTANCE(xml_request)
sub _execute_query {
my ($self, $xml_request) = @_;
# packet version override for
my $packet_version = $self->{'api_version'};
API-PureStorage
view release on metacpan or search on metacpan
lib/API/PureStorage.pm view on Meta::CPAN
our %ENV;
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
my $debug = 0;
sub new {
my $class = shift @_;
my $self = {
cookie_file => '/tmp/cookies.txt',
host => $_[0],
token => $_[1]
lib/API/PureStorage.pm view on Meta::CPAN
my $ret = $self->_api_post("/api/$api_version/auth/session", { api_token => $self->{token} });
return $self;
}
sub DESTROY {
my $self = shift @_;
my $ret = $self->{client}->DELETE("/api/$self->{api_version}/auth/session") if defined $self->{api_version};
unlink $self->{cookie_file};
}
### Methods
sub array_info {
my $self = shift @_;
my $ref = $self->_api_get("/api/$self->{api_version}/array?space=true");
return wantarray ? @$ref : $ref;
}
sub volume_detail {
my $self = shift @_;
my $name = shift @_;
my $ref = $self->_api_get("/api/$self->{api_version}/volume/".$name);
return wantarray ? @$ref : $ref;
}
sub volume_info {
my $self = shift @_;
my $ref = $self->_api_get("/api/$self->{api_version}/volume?space=true");
return wantarray ? @$ref : $ref;
}
sub version {
my $self = shift @_;
my $ref = $self->_api_get('/api/api_version');
return wantarray ? @{$ref->{version}} : $ref->{version};
}
### Subs
sub _api_get {
my $self = shift @_;
my $url = shift @_;
my $ret = $self->{client}->GET($url);
my $num = $ret->responseCode();
my $con = $ret->responseContent();
lib/API/PureStorage.pm view on Meta::CPAN
}
print 'DEBUG: GET ', $url, ' -> ', $num, ":\n", Dumper(from_json($con)), "\n" if $debug;
return from_json($con);
}
sub _api_post {
my $self = shift @_;
my $url = shift @_;
my $data = shift @_;
my $ret = $self->{client}->POST($url, to_json($data));
my $num = $ret->responseCode();
( run in 1.972 second using v1.01-cache-2.11-cpan-a5abf4f5562 )