Result:
found more than 263 distributions - search limited to the first 2001 files matching your query
( run in 0.538 )
ANSI-Palette
view release on metacpan or search on metacpan
lib/ANSI/Palette.pm view on Meta::CPAN
background_italic_16 => [qw/all background_italic ansi_16/],
background_italic_256 => [qw/all background_italic ansi_256/],
);
sub palette_8 {
print "ANSI palette -> \\e[Nm\n";
for (30..37) {
print "\e[" . $_ . "m " . $_;
}
reset;
}
sub palette_16 {
print "ANSI palette -> \\e[Nm\n";
for (30..37) {
print "\e[" . $_ . "m " . $_;
}
print "\nANSI palette -> \\e[N;1m\n";
lib/ANSI/Palette.pm view on Meta::CPAN
print "\e[" . $_ . ";1m " . $_;
}
reset;
}
sub palette_256 {
print "ANSI palette -> \\e[38;5;Nm\n";
for my $i (0..15) {
for my $j (0..16) {
my $code = $i * 16 + $j;
print "\e[38;5;" . $code . "m " . $code;
lib/ANSI/Palette.pm view on Meta::CPAN
print "\n";
}
reset;
}
sub text_8 {
print "\e[" . $_[0] . "m" . $_[1];
reset();
}
sub text_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : "") . "m" . $_[2];
reset();
}
sub text_256 {
print "\e[38;5;" . $_[0] . "m" . $_[1];
reset();
}
sub bold_8 {
print "\e[" . $_[0] . ";1m" . $_[1];
reset();
}
sub bold_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";1m" . $_[2];
reset();
}
sub bold_256 {
print "\e[38;5;" . $_[0] . ";1m" . $_[1];
reset();
}
sub underline_8 {
print "\e[" . $_[0] . ";4m" . $_[1];
reset();
}
sub underline_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : "") . ";4m" . $_[2];
reset();
}
sub underline_256 {
print "\e[38;5;" . $_[0] . ";4m" . $_[1];
reset();
}
sub italic_8 {
print "\e[" . $_[0] . ";3m" . $_[1];
reset();
}
sub italic_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : "") . ";3m" . $_[2];
reset();
}
sub italic_256 {
print "\e[38;5;" . $_[0] . ";3m" . $_[1];
reset();
}
sub background_text_8 {
print "\e[" . $_[0] . ";" . $_[1] . "m" . $_[2];
reset();
}
sub background_text_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";" . $_[2] . "m" . $_[3];
reset();
}
sub background_text_256 {
print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . "m" . $_[2];
reset();
}
sub background_bold_8 {
print "\e[" . $_[0] . ";" . $_[1] . ";1m" . $_[2];
reset();
}
sub background_bold_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";" . $_[2] . ";1m" . $_[3];
reset();
}
sub background_bold_256 {
print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . ";1m" . $_[2];
reset();
}
sub background_underline_8 {
print "\e[" . $_[0] . ";" . $_[1] . ";4m" . $_[2];
reset();
}
sub background_underline_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ';' . $_[2] . ";4m" . $_[3];
reset();
}
sub background_underline_256 {
print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . ";4m" . $_[2];
reset();
}
sub background_italic_8 {
print "\e[" . $_[0] . ";" . $_[1] . ";3m" . $_[2];
reset();
}
sub background_italic_16 {
print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";" . $_[2] . ";3m" . $_[3];
reset();
}
sub background_italic_256 {
print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . ";3m" . $_[2];
reset();
}
sub reset { print "\e[0m"; }
__END__
1;
AOL-TOC
view release on metacpan or search on metacpan
$SFLAP_DATA = 2;
$SFLAP_ERROR = 3;
$SFLAP_SIGNOFF = 4;
$SFLAP_KEEPALIVE = 5;
sub register_callback {
my ($self, $chan, $func, @args) = @_;
#print "register_callback() func $func for chan $chan adding to $self->{callback}{$chan}\n";
#print " self $self selfcb = $self->{callback}\n";
@{$self->{callback}{$func}} = @args;
return;
}
sub clear_callbacks {
my ($self) = @_;
my $k;
print "...............C SFLAP clear_callbacks\n";
for $k (keys %{$self->{callback}}) {
print ".............S Scan key ($k)\n";
}
}
sub callback {
my ($self, $chan, @args) = @_;
my $func;
for $func (@{$self->{callback}{$chan}}) {
#print ("callback() calling a func $func for $chan fd $self->{fd}..\n");
}
return;
}
sub new {
my ($tochost, $authorizer, $port, $nickname) = @_;
my $self;
my $ipaddr;
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
bless($self);
return $self;
}
sub destroy {
my ($self) = @_;
print "sflap destroy\n";
CORE::close($self->{fd});
$self = undef;
return;
}
sub close {
my ($self) = @_;
my $k;
print "sflap close\n";
#CORE::close($self->{fd});
return;
}
sub set_debug {
my ($self, $level) = @_;
$self->{debug_level} = $level;
print "slfap debug level $level\n";
}
sub debug {
my ($self, @args) = @_;
if (exists $self->{debug_level} && $self->{debug_level} > 0) {
print @args;
}
}
sub __connect {
my ($self) = @_;
my $socksaddr = inet_aton("206.223.45.1");
my $proto = getprotobyname('tcp');
my $sin = sockaddr_in(1080, $socksaddr);
syswrite($fd, $buffer, 19);
return ($fd);
}
sub _connect {
my ($self) = @_;
my $proto = getprotobyname('tcp');
my $sin = sockaddr_in($self->{port}, $self->{ipaddr});
my $fd = IO::Handle->new();
connect($fd, $sin) || die "connect: $!";
return ($fd);
}
sub connect {
my ($self) = @_;
my $fd;
if ($self->{proxy}) {
$fd = &{$self->{proxy}};
$self->recv();
return $fd;
}
sub recv {
my ($self) = @_;
my ($buffer, $from, $xfrom) = '';
my ($fd) = $self->{fd};
$foo = CORE::sysread($fd, $buffer, 6);
$self->callback($chan, $data);
return $buffer;
}
sub send {
my ($self, $chan, $data, $length) = @_;
my $buffer;
my $format;
if (!$length) {
$foo = CORE::syswrite($self->{fd}, $buffer, $length + 6);
$self->debug("sflap send ($self->{fd}) $foo chan = $ch seq = $seq len = $len data = $data\n");
}
sub write {
my ($self, $buffer, $len, $noflap) = @_;
my $fd = $self->{fd};
return CORE::syswrite($fd, $buffer, $len);
}
sub flush {
my $self = shift;
}
1;
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 ) {
( run in 0.538 second using v1.01-cache-2.11-cpan-5f4f29bf90f )