Result:
found more than 191 distributions - search limited to the first 2001 files matching your query
( run in 0.785 )
ANSI-Heatmap
view release on metacpan or search on metacpan
lib/ANSI/Heatmap.pm view on Meta::CPAN
'blue-red' => [0x10 .. 0x15, 0x39, 0x5d, 0x81, 0xa5, reverse(0xc4 .. 0xc9)],
'grayscale' => [0xe8 .. 0xff],
);
my $DEFAULT_SWATCH = 'blue-red';
sub new {
my $class = shift;
my %args = (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
my $self = bless { map => [], minmax => {} }, $class;
$self->swatch($DEFAULT_SWATCH);
$self->interpolate(0);
lib/ANSI/Heatmap.pm view on Meta::CPAN
croak "Invalid constructor argument(s) " . join(', ', sort keys %args);
}
return $self;
}
sub swatch_names {
my $self = shift;
return (sort keys %SWATCHES);
}
sub set {
my ($self, $x, $y, $z) = @_;
$self->{map}[$y][$x] = $z;
$self->_set_minmax(x => $x, y => $y, z => $z);
}
sub get {
my ($self, $x, $y) = @_;
return $self->{map}[$y][$x] || 0;
}
sub inc {
my ($self, $x, $y) = @_;
$self->set( $x, $y, $self->get($x, $y) + 1 );
}
sub swatch {
my $self = shift;
if (@_) {
my $sw = shift;
@_ == 0 or croak "swatch: excess arguments";
if (ref $sw) {
lib/ANSI/Heatmap.pm view on Meta::CPAN
}
}
return $self->{swatch};
}
sub to_string {
my $self = shift;
return $self->render($self->data);
}
# Convert heatmap hash to a 2D grid of intensities, normalised between 0 and 1,
# cropped to the min/max range supplied and scaled to the desired width/height.
sub data {
my ($self, $mm) = @_;
my %mm = $self->_figure_out_min_and_max;
my $inv_max_z = $mm{zrange} ? 1 / $mm{zrange} : 0;
my @out;
my $xscale = $mm{width} / ($mm{max_x} - $mm{min_x} + 1);
my $yscale = $mm{height} / ($mm{max_y} - $mm{min_y} + 1);
my $get = sub { $self->{map}[ $_[1] ][ $_[0] ] || 0 };
my $sample;
if (!$self->interpolate
|| $xscale == int($xscale) && $yscale == int($yscale)) {
$sample = $get; # nearest neighbour/direct lookup
}
lib/ANSI/Heatmap.pm view on Meta::CPAN
}
return \@out;
}
sub render {
my ($self, $matrix) = @_;
my $half = $self->half;
my @s;
for my $y (0..$#{$matrix}) {
lib/ANSI/Heatmap.pm view on Meta::CPAN
return join '', @s;
}
# Return hash of min/max values for each axis.
sub _figure_out_min_and_max {
my $self = shift;
my %calc = (
(map { $_ => 0 } @_minmax_fields),
%{$self->{minmax}},
($self->{minmax}{min_z}||0) >= 0 ? (min_z => 0) : (),
lib/ANSI/Heatmap.pm view on Meta::CPAN
$calc{zrange} = $calc{max_z} - $calc{min_z};
return %calc;
}
sub _binterp {
my $get = shift;
return sub {
my ($x, $y) = @_;
my ($fx, $bx) = modf($x);
my ($fy, $by) = modf($y);
my @p = map { $get->($bx + $_->[0], $by + $_->[1]) } ([0,0],[0,1],[1,0],[1,1]);
lib/ANSI/Heatmap.pm view on Meta::CPAN
my $z = $y1 + ($y2 - $y1) * $fx;
return $z;
};
}
sub _set_minmax {
my ($self, %vals) = @_;
my $mm = $self->{minmax};
while (my ($k, $v) = each %vals) {
if (!defined $mm->{"min_$k"}) {
$mm->{"min_$k"} = $mm->{"max_$k"} = $v;
lib/ANSI/Heatmap.pm view on Meta::CPAN
}
}
}
# Maps a number from [0,1] to a swatch colour.
sub _swatch_lookup {
my ($self, $index) = @_;
return $self->{swatch}->[$index * $#{$self->{swatch}} + .5];
}
1;
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
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
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
=head1 DESCRIPTION
This package provides an abstraction and method for rapidly developing HTTP API
clients. While this module can be used to interact with APIs directly,
API::Client was designed to be consumed (subclassed) by higher-level
purpose-specific API clients.
=head1 THIN CLIENT
The thin API client library is advantageous as it has complete API coverage and
lib/API/Client.pm view on Meta::CPAN
This example illustrates how you might fetch an API resource.
=cut
=head2 subclassing
package Hookbin;
use Data::Object::Class;
extends 'API::Client';
sub auth {
['admin', 'secret']
}
sub headers {
[['Accept', '*/*']]
}
sub base {
['https://httpbin.org/get']
}
package main;
my $hookbin = Hookbin->new;
This package was designed to be subclassed and provides hooks into the client
building and request dispatching processes. Specifically, there are three
useful hooks (i.e. methods, which if present are used to build up the client
object and requests), which are, the C<auth> hook, which should return a
C<Tuple[Str, Str]> which is used to configure the basic auth header, the
C<base> hook which should return a C<Tuple[Str]> which is used to configure the
API-DeutscheBahn-Fahrplan
view release on metacpan or search on metacpan
lib/API/DeutscheBahn/Fahrplan.pm view on Meta::CPAN
URL endpoint for DB Fahrplan free version. Defaults to I<https://api.deutschebahn.com/freeplan/v1>.
=item fahrplan_plus_url
URL endpoint for DB Fahrplan subscribed version. Defaults to I<https://api.deutschebahn.com/fahrplan-plus/v1>.
=item access_token
Access token to sign requests. If provided the client will use the C<fahrplan_plus_url> endpoint.
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
our $VERSION = 0.09;
our $DEBUG = '';
our $FAKE_ANSWER = '';
# for init subclasses
init_components(
domain => 'Domain',
mysql => 'Mysql',
user => 'User',
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!";
};
no strict 'refs';
*{"$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;
lib/API/DirectAdmin.pm view on Meta::CPAN
Example:
my $result = $da->dns->add_record({
domain => 'domain.com',
type => 'A',
name => 'subdomain', # will be "subdomain.domain.com." in record
value => '127.127.127.127',
});
Example with MX record:
lib/API/DirectAdmin.pm view on Meta::CPAN
Example:
my $result = $da->dns->remove_record({
domain => 'domain.com',
type => 'A',
name => 'subdomain',
value => '127.127.127.127',
});
Example with MX record:
API-Drip-Request
view release on metacpan or search on metacpan
bin/drip_client.pl view on Meta::CPAN
=head2 Operations
=over
=item B<getsub>
Get a list of all subscribers.
=item B<addsub>
Add a subscriber. At a minimum, must also specify -email, or -id.
Accepts: -email, -id, -new_email, -user_id, -time_zone, -lifetime_value, -ip_address
=item B<delsub>
Delete a subscriber. Must specify -email, or -id.
=item B<getwork>
Get a list of all workflows.
bin/drip_client.pl view on Meta::CPAN
GetOptions( \%OPT,
'help|h|?',
'man',
'verbose|verb|v+',
'conf=s',
'addsub', 'getsub', 'delsub', 'getwork', 'startwork', 'event',
'workflow=i', 'action=s',
'email=s', 'id=s', 'new_email=s', 'user_id=s', 'time_zone=s', 'lifetime_vaule=i', 'ip_address=s', 'prospect'
) or pod2usage(2);
pod2usage(1) if $OPT{help};
pod2usage(-exitval => 0, -verbose => 2) if $OPT{man};
bin/drip_client.pl view on Meta::CPAN
use API::Drip::Request;
my $client = API::Drip::Request->new( $OPT{conf} ? ( DRIP_CLIENT_CONF => $OPT{conf} ) : () );
eval {
if ( $OPT{getsub} ) { get_subscribers() and exit }
if ( $OPT{addsub} ) { add_subscribers( %OPT ) and exit }
if ( $OPT{delsub} ) { delete_subscribers( %OPT ) and exit }
if ( $OPT{getwork} ) { get_workflows( %OPT ) and exit }
if ( $OPT{startwork} ) { start_workflow( %OPT ) and exit }
if ( $OPT{event} ) { record_event( %OPT ) and exit }
};
if ( $@ ) {
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 )] );
my $endpoint = 'workflows/' . $OPT{workflow} . '/subscribers';
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
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
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
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
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);
lib/API/INSEE/Sirene.pm view on Meta::CPAN
=over 4
=item *
L<< https://api.insee.fr/catalogue/site/themes/wso2/subthemes/insee/pages/item-info.jag?name=Sirene&version=V3&provider=insee >>
=back
B<Please note that this API is french so all fields names used in function calls are in french, including the aliases.>
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'};
warn "-- got request for command '$cmd' (tag: $tag)\n" if DEBUG;
$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
for (@$data) {
next unless my $r = $self->{requests}{delete $_->{'.tag'}};
my $type = delete $_->{'.type'};
push @{$r->{data} ||= Mojo::Collection->new()}, $_
if %$_ && !$r->{subscription};
if ($type eq '!re' && $r->{subscription}) {
$r->{cb}->($self, '', $_);
}
elsif ($type eq '!done') {
$r->{data} ||= Mojo::Collection->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<.>
Both blocking and non-blocking interface to a MikroTik API service. With queries,
command subscriptions and Promises/A+ (courtesy of an I/O loop). Based on
L<Mojo::IOLoop> and would work alongside L<EV>.
=head1 ATTRIBUTES
L<API::MikroTik> implements the following attributes.
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
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
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;
}
( run in 0.785 second using v1.01-cache-2.11-cpan-7add2cbd662 )