Result:
found more than 594 distributions - search limited to the first 2001 files matching your query
( run in 1.108 )
AHA
view release on metacpan or search on metacpan
}
=item $power = $aha->power($ain)
Get the current power consumption of the switch C<$ain> in mW.
If the switch is not connected, C<undef> is returned.
=cut
sub power {
my $self = shift;
return &_inval_check($self->_execute_cmd("getswitchpower",$self->_ain(shift)));
}
=item $name = $aha->name($ain)
Get the symbolic name for the AIN given. In this case C<$ain> must be an real
AIN.
=cut
sub name {
my $self = shift;
my $ain = shift || die "No AIN given for which to fetch the name";
return $self->_execute_cmd("getswitchname",$ain);
}
=item $ain = $aha->ain($name)
This is the inverse method to C<name()>. It takes a symbolic name C<$name> as
argument and returns the AIN. If no such name is registered, an error is
raised.
=cut
sub ain_by_name {
my $self = shift;
my $name = shift;
my $map = $self->{ain_map};
return $map->{$name} if $map->{$name};
$self->_init_ain_map();
my $ain = $self->{ain_map}->{$name};
die "No AIN for '$name' found" unless $ain;
return $ain;
}
=item $aha->logout()
Logout from the connected fritz.box in order to free up any resources. You
can still use any other method on this object, in which case it is
logs in again (which eats up some performance, of course)
=cut
sub logout {
my $self = shift;
return unless $self->{sid};
# Send a post request as defined in
# http://www.avm.de/de/Extern/files/session_id/AVM_Technical_Note_-_Session_ID.pdf
my $req = HTTP::Request->new(POST => $self->{login_url});
$req->content_type("application/x-www-form-urlencoded");
my $login = "sid=".$self->{sid}."&security:command/logout=fcn";
$req->content($login);
my $resp = $self->{ua}->request($req);
die "Cannot logout SID ",$self->{sid},": ",$resp->status_line unless $resp->is_success;
print "--- Logout ",$self->{sid} if $DEBUG;
delete $self->{sid};
}
=back
=cut
# ======================================================================
# Private methods
# Decide whether an AIN or a name is given
sub _ain {
my $self = shift;
my $ain = shift || die "No AIN or name given";
return $ain =~ /^\d{12}$/ ? $ain : $self->ain_by_name($ain);
}
# Execute a command as defined in
# http://www.avm.de/de/Extern/files/session_id/AHA-HTTP-Interface.pdf
sub _execute_cmd {
my $self = shift;
my $cmd = shift || die "No command given";
my $ain = shift;
my $url = $self->{ws_url} . "?sid=" . $self->_sid() . "&switchcmd=" . $cmd;
$url .= "&ain=" . $ain if $ain;
my $resp = $self->{ua}->get($url);
print ">>> $url\n" if $DEBUG;
die "Cannot execute ",$cmd,": ",$resp->status_line unless $resp->is_success;
my $c = $resp->content;
chomp $c;
print "<<< $c\n" if $DEBUG;
return $c;
}
# Return the cached SID or perform the login as described in
# http://www.avm.de/de/Extern/files/session_id/AVM_Technical_Note_-_Session_ID.pdf
sub _sid {
my $self = shift;
return $self->{sid} if $self->{sid};
# Get the challenge
my $resp = $self->{ua}->get($self->{login_url});
my $content = $resp->content();
my $challenge = ($content =~ /<Challenge>(.*?)<\/Challenge>/ && $1);
my $input = $challenge . '-' . $self->{password};
Encode::from_to($input, 'ascii', 'utf16le');
my $challengeresponse = $challenge . '-' . lc(Digest::MD5::md5_hex($input));
# Send the challenge back with encoded password
my $req = HTTP::Request->new(POST => $self->{login_url});
$req->content_type("application/x-www-form-urlencoded");
my $login = "response=$challengeresponse";
if ($self->{user}) {
$login .= "&username=" . $self->{user};
}
$req->content($login);
$resp = $self->{ua}->request($req);
if (! $resp->is_success()) {
die "Cannot login to ", $self->{host}, ": ",$resp->status_line();
}
$content = $resp->content();
$self->{sid} = ($content =~ /<SID>(.*?)<\/SID>/ && $1);
print "-- Login, received SID ",$self->{sid} if $DEBUG;
return $self->{sid};
}
# Initialize the reverse name -> AIN map
sub _init_ain_map {
my $self = shift;
my $devs = $self->list();
$self->{ain_map} = {};
for my $dev (@$devs) {
$self->{ain_map}->{$self->name($dev->ain())} = $dev->ain();
}
}
# Convert "inval" to undef
sub _inval_check {
my $ret = shift;
return $ret eq "inval" ? undef : $ret;
}
=head1 LICENSE
AHA is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
AHA is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with AHA. If not, see <http://www.gnu.org/licenses/>.
=head1 AUTHOR
roland@cpan.org
=cut
1;
AI-MicroStructure
view release on metacpan or search on metacpan
bin/remote.pl view on Meta::CPAN
my $func = ${"$class\::Remote"}{extract};
# provide a very basic default
my $meth = ref $func eq 'CODE'
? sub { my %seen; return grep { !$seen{$_}++ } $func->( $_[1] ); }
: sub { return $_[1] }; # very basic default
# put the method in the subclass symbol table (at runtime)
*{"$class\::extract"} = $meth;
# now run the function^Wmethod
goto &$meth;
}
# methods related to the source URL
sub source {
my $class = ref $_[0] || $_[0];
no strict 'refs';
return ${"$class\::Remote"}{source};
}
sub sources {
my $class = ref $_[0] || $_[0];
no strict 'refs';
my $src = ${"$class\::Remote"}{source};
if ( ref $src eq 'ARRAY' ) {
return @$src;
}
elsif ( ref $src eq 'HASH' ) {
return
map { ref $_ ? @$_ : $_ } $_[1] ? $src->{ $_[1] } : values %$src;
}
return $src;
}
sub has_remoteKnowledge { return defined $_[0]->source(); }
# main method: return the Knowledge from the remote source
sub remote_Knowledge {
my $class = ref $_[0] || $_[0];
return unless $class->has_remoteKnowledge();
# check that we can access the network
eval {
require LWP::UserAgent;
die "version 5.802 required ($LWP::VERSION installed)\n"
if $LWP::VERSION < 5.802;
};
if ($@) {
carp "LWP::UserAgent not available: $@";
return;
}
# fetch the content
my @items;
my @srcs = $class->sources($_[1]);
my $ua = LWP::UserAgent->new( env_proxy => 1 );
foreach my $src (@srcs) {
my $res = $ua->request( HTTP::Request->new( GET => $src ) );
if ( ! $res->is_success() ) {
carp "Failed to get content at $src (" . $res->status_line();
return;
}
# extract, cleanup and return the data
# if decoding the content fails, we just deal with the raw content
push @items =>
$class->extract( $res->decoded_content() || $res->content() );
}
# return unique items
my %seen;
return grep { !$seen{$_}++ } @items;
}
#
# transformation subroutines
#
sub tr_nonword {
my $str = shift;
$str =~ tr/a-zA-Z0-9_/_/c;
$str;
}
sub tr_accent {
my $str = shift;
$str =~ tr{ÀÃÂÃÄÅÇÈÉÊËÌÃÃŽÃÑÒÓÔÕÖØÙÚÛÜÃà áâãäåçèéêëìÃîïñòóôõöøùúûüýÿ}
{AAAAAACEEEEIIIINOOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuyy};
return $str;
}
my %utf2asc = (
"\xc3\x89" => 'E',
"\xc3\xa0" => 'a',
"\xc3\xa1" => 'a',
"\xc3\xa9" => 'e',
"\xc3\xaf" => 'i',
"\xc3\xad" => 'i',
"\xc3\xb6" => 'o',
"\xc3\xb8" => 'o',
"\xc5\xa0" => 'S',
"\x{0160}" => 'S',
# for pokemons
"\x{0101}" => 'a',
"\x{012b}" => 'i',
"\x{014d}" => 'o',
"\x{016b}" => 'u',
"\xe2\x99\x80" => 'female',
"\xe2\x99\x82" => 'male',
"\x{2640}" => 'female',
"\x{2642}" => 'male',
);
my $utf_re = qr/(@{[join( '|', sort keys %utf2asc )]})/;
sub tr_utf8_basic {
my $str = shift;
$str =~ s/$utf_re/$utf2asc{$1}/go;
return $str;
API-Assembla
view release on metacpan or search on metacpan
lib/API/Assembla.pm view on Meta::CPAN
sub get_ticket {
my ($self, $id, $number) = @_;
my $req = $self->make_req('/spaces/'.$id.'/tickets/'.$number);
my $resp = $self->_client->request($req);
# print STDERR $resp->decoded_content;
my $xp = XML::XPath->new(xml => $resp->decoded_content);
my $ticket = $xp->find('/ticket')->pop;
return API::Assembla::Ticket->new(
id => $ticket->findvalue('id').'',
created_on => DateTime::Format::ISO8601->parse_datetime($ticket->findvalue('created-on').''),
description => $ticket->findvalue('description').'',
number => $ticket->findvalue('number').'',
priority => $ticket->findvalue('priority').'',
status_name => $ticket->findvalue('status-name').'',
summary => $ticket->findvalue('summary').''
);
}
sub get_tickets {
my ($self, $id) = @_;
my $req = $self->make_req('/spaces/'.$id.'/tickets');
my $resp = $self->_client->request($req);
# print STDERR $resp->decoded_content;
my $xp = XML::XPath->new(xml => $resp->decoded_content);
my $tickets = $xp->find('/tickets/ticket');
my %objects = ();
foreach my $ticket ($tickets->get_nodelist) {
my $id = $ticket->findvalue('id').'';
$objects{$id} = API::Assembla::Ticket->new(
id => $id,
created_on => DateTime::Format::ISO8601->parse_datetime($ticket->findvalue('created-on').''),
description => $ticket->findvalue('description').'',
number => $ticket->findvalue('number').'',
priority => $ticket->findvalue('priority').'',
status_name => $ticket->findvalue('status-name').'',
summary => $ticket->findvalue('summary').''
);
}
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);
return $req;
}
__PACKAGE__->meta->make_immutable;
1;
=pod
=head1 NAME
API::Assembla - Access to Assembla API via Perl.
=head1 VERSION
version 0.03
=head1 UNDER CONSTRUCTION
API::Assembla is not feature-complete. It's a starting point. The Assembla
API has LOTS of stuff that this module does not yet contain. These features
will be added as needed by the author or as gifted by thoughtful folks who
write patches! ;)
=head1 SYNOPSIS
use API::Assembla;
my $api = API::Asembla->new(
username => $username,
password => $password
);
my $href_of_spaces = $api->get_spaces;
# Got an href of API::Assembla::Space objects keyed by space id
my $space = $api->get_space($space_id);
# Got an API::Assembla::Space object
my $href_of_tickets = $api->get_tickets;
# Got an href of API::Assembla::Space objects keyed by ticket id
my $ticket = $api->get_ticket($space_id, $ticket_number);
# Got an API::Assembla::Ticket object
=head1 DESCRIPTION
API::Assembla is a Perl interface to L<Assembla|http://www.assembla.com/>, a
ticketing, code hosting collaboration tool.
=head1 ATTRIBUTES
=head2 password
The password to use when logging in.
=head2 url
API-CLI
view release on metacpan or search on metacpan
lib/API/CLI.pm view on Meta::CPAN
# ABSTRACT: Generic Framework for REST API Command Line Clients
use strict;
use warnings;
use 5.010;
package API::CLI;
our $VERSION = '0.001'; # VERSION
use base 'App::Spec::Run::Cmd';
use URI;
use YAML::XS ();
use LWP::UserAgent;
use HTTP::Request;
use App::Spec;
use JSON::XS;
use API::CLI::Request;
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}) {
warn __PACKAGE__.':'.__LINE__.": apicall($method $path)\n";
warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$params], ['params']);
warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$opt], ['opt']);
}
$path =~ s{(?::(\w+)|\{(\w+)\})}{$params->{ $1 // $2 }}g;
if ($opt->{debug}) {
warn __PACKAGE__.':'.__LINE__.": apicall($method $path)\n";
}
my $REQ = API::CLI::Request->from_openapi(
openapi => $run->spec->openapi,
method => $method,
path => $path,
options => $opt,
parameters => $params,
verbose => $opt->{verbose} ? 1 : 0,
);
$self->add_auth($REQ);
if ($method =~ m/^(POST|PUT|PATCH|DELETE)$/) {
my $data_file = $opt->{'data-file'};
if (defined $data_file) {
open my $fh, '<', $data_file or die "Could not open '$data_file': $!";
my $data = do { local $/; <$fh> };
close $fh;
$REQ->content($data);
}
}
my ($ok, $out, $content) = $REQ->request;
if (defined $out) {
API-CPanel
view release on metacpan or search on metacpan
lib/API/CPanel.pm view on Meta::CPAN
# STATIC(STRING:input_string)
sub kill_start_end_slashes {
my $str = shift;
for ($str) {
s/^\/+//sgi;
s/\/+$//sgi;
}
return $str;
}
# Make full query string (with host, path and protocol)
# STATIC(HASHREF: params)
# params:
# host*
# path
# allow_http
# param1
# param2
# ...
sub mk_full_query_string {
my $params = shift;
return '' unless
$params &&
ref $params eq 'HASH' &&
%$params &&
$params->{host} &&
$params->{func};
my $host = delete $params->{host};
my $path = delete $params->{path} || '';
my $allow_http = delete $params->{allow_http} || '';
my $func = delete $params->{func};
unless ($path) {
$path = 'xml-api';
}
$path = kill_start_end_slashes( $path );
$host = kill_start_end_slashes( $host );
$func = kill_start_end_slashes( $func );
my $query_path = ( $allow_http ? 'http' : 'https' ) . "://$host:2087/$path/$func";
return %$params ? $query_path . '?' . mk_query_string( $params ) : $query_path;
}
# 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;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => $query_string );
$request->header( Authorization => $auth_hash );
my $response = $ua->request( $request );
my $content = $response->content;
if ($response->header('content-type') eq 'text/xml') {
warn $content if $DEBUG;
return $content;
} else {
return '';
}
}
# 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 =
$params{parser_params} || { };
return '' unless $answer_string;
my $deparsed = XMLin( $answer_string, %$parser_params );
warn Dumper $deparsed if $DEBUG;
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} || '';
my $fake_answer = $API::CPanel::FAKE_ANSWER || '';
return '' unless $query_string;
my $answer = $fake_answer ? $fake_answer : mk_query_to_server( $auth_hash, $query_string );
warn $answer if $answer && $DEBUG;
return $answer ?
parse_answer(
answer => $answer,
parser_params => $xml_parser_params
) : '';
}
# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
my ($hash, $allowed_keys) = @_;
API-DirectAdmin
view release on metacpan or search on metacpan
lib/API/DirectAdmin.pm view on Meta::CPAN
package API::DirectAdmin;
use Modern::Perl '2010';
use LWP::UserAgent;
use HTTP::Request;
use Data::Dumper;
use Carp;
use URI;
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 => '',
auth_passwd => '',
host => '',
ip => '',
debug => $DEBUG,
allow_https => 1,
fake_answer => $FAKE_ANSWER,
(@_)
};
confess "Required auth_user!" unless $self->{auth_user};
confess "Required auth_passwd!" unless $self->{auth_passwd};
confess "Required host!" unless $self->{host};
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;
}
}
lib/API/DirectAdmin.pm view on Meta::CPAN
&& $params->{command};
my $allow_https = defined $params->{allow_https} ? $params->{allow_https} : $self->{allow_https};
delete $params->{allow_https};
my $host = $self->{host};
my $port = $self->{port} || 2222;
my $command = delete $params->{command};
my $auth_user = $self->{auth_user};
my $auth_passwd = $self->{auth_passwd};
$self->kill_start_end_slashes();
my $query_path = ( $allow_https ? 'https' : 'http' ) . "://$auth_user:$auth_passwd\@$host:$port/$command?";
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;
my $result = join '&', map { "$_=$params{$_}" } sort keys %params;
return $result;
}
# Get + deparse
# STATIC(STRING: query_string)
sub process_query {
my ( $self, %params ) = @_;
my $query_string = $params{query_string};
my $method = $params{method};
confess "Empty query string" unless $query_string;
my $answer = $self->{fake_answer} ? $self->{fake_answer} : $self->mk_query_to_server( $method, $query_string, $params{params} );
carp $answer if $self->{debug};
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'";
}
confess "URL is empty" unless $url;
my $content;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( $method, $url );
if ( $method eq 'GET' ) {
my $response = $ua->request( $request );
$content = $response->content;
}
else { # Temporary URL for making request
my $temp_uri = URI->new('http:');
$temp_uri->query_form( $params );
$request->content( $temp_uri->query );
$request->content_type('application/x-www-form-urlencoded');
my $response = $ua->request($request);
$content = $response->content;
}
warn "Answer: " . $content if $self->{debug};
return $content if $params->{noparse};
return $self->parse_answer($content);
}
# Parse answer
sub parse_answer {
my ($self, $response) = @_;
return '' unless $response;
my %answer;
$response =~ s/<br>|&#\d+//ig; # Some trash from answer
$response =~ s/\n+/\n/ig;
my @params = split /&/, $response;
foreach my $param ( @params ) {
my ($key, $value) = split /=/, $param;
if ( $key =~ /(.*)\[\]/ ) { # lists
push @{ $answer{$1} }, $value;
}
else {
$answer{$key} = $value;
}
}
return \%answer || '';
}
1;
__END__
=head1 NAME
API::DirectAdmin - interface to the DirectAdmin Hosting Panel API ( http://www.directadmin.com )
=head1 SYNOPSIS
use API::DirectAdmin;
my %auth = (
auth_user => 'admin_name',
auth_passwd => 'admin_passwd',
lib/API/DirectAdmin.pm view on Meta::CPAN
=item add_record
Add zone record to dns for domain. Available types of records: A, AAAA, NS, MX, TXT, PTR, CNAME, SRV
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:
my $result = $da->dns->add_record( {
domain => 'domain.com',
type => 'MX',
name => 'mx1',
value => 10,
} );
=item remove_record
Remove record from domain zone
Example:
my $result = $da->dns->remove_record({
domain => 'domain.com',
type => 'A',
name => 'subdomain',
value => '127.127.127.127',
});
Example with MX record:
my $result = $da->dns->remove_record({
domain => 'domain.com',
type => 'mx',
name => 'mx1',
value => 10,
});
=back
=head1 INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
=head1 DEPENDENCIES
This module requires these other modules and libraries:
Modern::Perl
LWP::UserAgent
HTTP::Request
URI
Carp
Data::Dumper
=head1 COPYRIGHT AND LICENCE
Copyright (C) 2012-2013 by Andrey "Chips" Kuzmin <chipsoid@cpan.org>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.
=cut
API-Drip-Request
view release on metacpan or search on metacpan
lib/API/Drip/Request.pm view on Meta::CPAN
package API::Drip::Request;
use v5.14;
use strict;
use warnings;
use Params::ValidationCompiler qw( validation_for );
use Types::Standard qw( Str HashRef CodeRef);
use YAML;
use File::Spec;
use File::HomeDir;
use Readonly;
use Carp;
use LWP::UserAgent;
use HTTP::Request::Common;
use JSON;
use URI;
use Data::Printer;
Readonly our %DEFAULTS => (
DRIP_TOKEN => undef,
DRIP_ID => undef,
DRIP_URI => 'https://api.getdrip.com/v2',
DRIP_AGENT => 'API::Drip',
DRIP_DEBUG => 0,
);
=head1 NAME
API::Drip::Request - Perl interface to api.getdrip.com
=head1 VERSION
Version 0.05
=cut
our $VERSION = '0.05';
=head1 SYNOPSIS
use API::Drip::Request;
my $drip = API::Drip::Request->new();
$drip->do_request( POST => 'subscribers', { subscribers => [ { email => 'foo@example.com', ... }] } );
=head1 DESCRIPTION
Low-level perl interface to the Drip API as specified at https://www.getdrip.com/docs/rest-api
All of the methods in this module will throw exceptions on error.
=head1 SUBROUTINES/METHODS
=head2 new()
Creates the API::Drip::Request object. See L</"CONFIGURATION"> for accepted parameters.
Also accepts:
=over
=item debugger
A codref that should accept a list of diagnostic strings and log them somewhere
useful for debugging purposes. Only used when DRIP_DEBUG is true.
=back
=cut
my $config_validator = validation_for(
params => {
DRIP_CLIENT_CONF => { type => Str(), optional => 1 },
lib/API/Drip/Request.pm view on Meta::CPAN
my %OPT = $config_validator->(@_);
my $self = _load_conf( \%OPT );
# At this point, all configuration values should be set
foreach my $key ( keys %DEFAULTS ) {
confess "Missing configuration $key" unless defined $self->{$key};
}
$self->{debugger} = _mk_debugger( $self, %OPT );
bless $self, $class;
return $self;
}
sub _mk_debugger {
my ($self, %OPT) = @_;
unless ($self->{DRIP_DEBUG}) { return sub {}; }
if ( $OPT{debugger} ) { return $OPT{debugger} }
return sub { warn join "\n", map { ref($_) ? np $_ : $_ } @_ };
}
=head2 do_request
Accepts the following positional parameters:
=over
=item HTTP Method (required)
May be 'GET', 'POST', 'DELETE', 'PATCH', etc..
=item Endpoint (requird)
Specifies the path of the REST enpoint you want to query. Include everything after the account ID. For example, "subscribers", "subscribers/$subscriber_id/campaign_subscriptions", etc...
=item Content (optional)
Perl hashref of data that will be sent along with the request.
=back
On success, returns a Perl data structure corresponding to the data returned
from the server. Some operations (DELETE), do not return any data and may
return undef on success. On error, this method will die() with the
HTTP::Response object.
=cut
my $request_validator = validation_for( params => [ {type => Str()}, {type => Str()}, {type => HashRef(), optional => 1} ] );
sub do_request {
my $self = shift;
my ($method, $endpoint, $content) = $request_validator->(@_);
my $uri = URI->new($self->{DRIP_URI});
$uri->path_segments( $uri->path_segments, $self->{DRIP_ID}, split( '/', $endpoint) );
$self->{debugger}->( 'Requesting: ' . $uri->as_string );
my $request = HTTP::Request->new( $method => $uri->as_string, );
if ( ref($content) ) {
$request->content_type('application/vnd.api+json');
$request->content( encode_json( $content ) );
}
$request->authorization_basic( $self->{DRIP_TOKEN}, '' );
$self->{agent} //= LWP::UserAgent->new( agent => $self->{DRIP_AGENT} );
my $result = $self->{agent}->request( $request );
unless ( $result->is_success ) {
$self->{debugger}->("Request failed", $result->content);
die $result;
}
if ( $result->code == 204 ) {
$self->{debugger}->("Success, no content");
return undef;
}
my $decoded = eval {decode_json( $result->content )};
if ( $@ ) {
$self->{debugger}->('Failed to decode JSON:', $@, $result->content);
die $result;
}
return $decoded;
}
=head1 CONFIGURATION
Configuration data may be passed in through a number of different ways, which are searched in the following order of preference:
=over
=item 1. As direct paramteters to new().
=item 2. As environment variables.
=item 3. As elments of the first YAML configuration file that is found and readable in the following locations:
=over
=item 1. The location specified by the DRIP_CLIENT_CONF parameter supplied to new().
=item 2. The location specified by $ENV{DRIP_CLIENT_CONF}.
=item 3. $ENV{HOME}/.drip.conf
=back
=back
The following configuration data is accepted:
=over
=item * DRIP_TOKEN (required)
This is the user token assigned to you by drip. When you are logged in, look for "API Token" at https://www.getdrip.com/user/edit
=item * DRIP_ID (required)
API-Eulerian
view release on metacpan or search on metacpan
lib/API/Eulerian/EDW/Request.pm view on Meta::CPAN
#/usr/bin/env perl
###############################################################################
#
# @file Request.pm
#
# @brief API::Eulerian::EDW Request module used to send HTTP request to remote Peer.
#
# @author Thorillon Xavier:x.thorillon@eulerian.com
#
# @date 26/11/2021
#
# @version 1.0
#
###############################################################################
#
# Setup module name.
#
package API::Eulerian::EDW::Request;
#
# Enforce compilor rules
#
use strict; use warnings;
#
# Import API::Eulerian::EDW::Status
#
use API::Eulerian::EDW::Status;
#
# Import HTTP::Headers
#
use HTTP::Headers;
#
# Import HTTP::Request
#
use HTTP::Request;
#
# Import LWP::UserAgent
#
use LWP::UserAgent;
#
# Import IO::Socket::SSL
#
use IO::Socket::SSL;
#
# Import HTTP::Status
#
use HTTP::Status qw( :constants :is status_message );
#
# Import JSON
#
use JSON;
#
# Import Encode
#
use Encode;
#
# @brief Create new HTTP Headers.
#
# @param $class - API::Eulerian::EDW::HTTP class.
#
# @return HTTP Headers.
#
sub headers
{
return HTTP::Headers->new();
}
#
# @brief Test if the content type of given HTTP response is a
# JSON format.
#
# @param $class - API::Eulerian::EDW::Request Class.
# @param $response - HTTP response.
#
# @return 1 - Content type is JSON.
# @return 0 - Content type isnt JSON.
#
sub is_json
{
my ( $class, $response ) = @_;
my $type;
# Get content type value from HTTP response
$type = $response->header( 'content-type' );
if( defined( $type ) ) {
# Split content type into an array.
my @subtypes = split( '; ', $type );
# Iterate on subtypes entries
foreach my $subtype ( @subtypes ) {
# Test if subtype is JSON format
if( $subtype eq 'application/json' ) {
return 1;
}
}
}
lib/API/Eulerian/EDW/Request.pm view on Meta::CPAN
sub get
{
my ( $class, $url, $headers, $file ) = @_;
return $class->_request( 'GET', $url, $headers, undef, undef, $file );
}
#
# @brief Do HTTP Post on given URL.
#
# @param $class - API::Eulerian::EDW::HTTP class.
# @param $url - Remote URL.
# @param $headers - HTTP::Headers.
# @param $what - Request Data.
# @param $type - Request Data Type.
#
# @return API::Eulerian::EDW::Status instance.
#
sub post
{
my ( $class, $url, $headers, $what, $type ) = @_;
return $class->_request( 'POST', $url, $headers, $what, $type );
}
#
# @brief Send HTTP request on given url.
#
# @param $class - API::Eulerian::EDW Request class.
# @param $method - HTTP method.
# @param $url - Remote URL.
# @param $headers - HTTP headers.
# @param $what - Data of POST request.
# @param $type - Data type of POST request
# @param $file - Local file path used to store HTTP reply.
#
# @return API::Eulerian::EDW::Status instance.
#
use Data::Dumper;
sub _request
{
my ( $class, $method, $url, $headers, $what, $type, $file ) = @_;
my $status = API::Eulerian::EDW::Status->new();
my $endpoint;
my $request;
# Ensure default type
$type = $type || 'application/json';
# Sanity check POST arguments
if( $method eq 'POST' ) {
if( ! ( defined( $what ) && defined( $type ) ) ) {
$status->error( 1 );
$status->msg( "Mandatory argument to post request is/are missing" );
$status->code( 400 );
return $status;
} else {
# Setup Content_Length and Content_Type
$headers->push_header( Content_Length => length( $what ) );
$headers->push_header( Content_Type => $type );
}
}
# Create HTTP Request
$request = HTTP::Request->new( $method, $url, $headers, $what );
# Create End Point used to communicate with remote server
$endpoint = LWP::UserAgent->new(
keep_alive => 0,
cookie_jar => {},
ssl_opts => {
SSL_verifycn_publicsuffix => '',
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
verify_hostname => 0,
SSL_hostname => '',
},
);
# Increase Read Timeout on TCP socket to avoid being disconnected
$endpoint->timeout( 1800 );
# Send Request, wait response if file is defined reply content is
# writen into local file.
my $response = $endpoint->request( $request, $file );
my $json = API::Eulerian::EDW::Request->json( $response );
$status->{ response } = $response;
if( $response->code != HTTP_OK ) {
$status->error( 1 );
$status->code( $response->code );
$status->msg(
defined( $json ) ?
encode_json( $json ) : $response->content()
);
} else {
if( defined( $response->header( 'content-encoding' ) ) ) {
$status->{ encoding } = $response->header( 'content-encoding' );
}
}
return $status;
}
#
# End up module properly
#
1;
__END__
=pod
=head1 NAME
API::Eulerian::EDW::Request - API::Eulerian::EDW Request module.
=head1 DESCRIPTION
This module is used to send HTTP request to remote Peer.
=head1 METHODS
=head2 get()
I<Send HTTP GET request on given url>
lib/API/Eulerian/EDW/Request.pm view on Meta::CPAN
=head2 headers()
I<Create a new HTTP::Headers instance>
=head3 output
=over 4
=item * Instance of an HTTP::Headers.
=back
=head2 is_json()
I<Test if given HTTP response content is a JSON format>
=head3 input
=over 4
=item * HTTP response.
=back
=head3 output
=over 4
=item * 1 - HTTP response content is in JSON format.
=item * 0 - HTTP response content isnt in JSON format.
=back
=head2 json()
I<Get JSON message from HTTP response>
=head3 input
=over 4
=item * HTTP response.
=back
=head3 output
=over 4
=item * JSON message.
=back
=head1 SEE ALSO
L<API::Eulerian::EDW::Status>
L<HTTP::Headers>
L<HTTP::Request>
L<HTTP::Status>
L<LWP::UserAgent>
L<IO::Socket::SSL>
L<JSON>
L<Encode>
=head1 AUTHOR
Xavier Thorillon <x.thorillon@eulerian.com>
=head1 COPYRIGHT
Copyright (c) 2008 API::Eulerian::EDW Technologies Ltd L<http://www.eulerian.com>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
=cut
API-Handle
view release on metacpan or search on metacpan
lib/API/Handle.pm view on Meta::CPAN
package API::Handle;
{
$API::Handle::VERSION = '0.02';
}
use Moose::Role;
use namespace::autoclean;
use HTTP::Request;
use bytes;
use feature ':5.10';
use String::CamelCase qw/camelize decamelize/;
use Tie::Hash::Indexed;
has _config => (
is => 'rw'
, isa => 'Nour::Config'
, handles => [ qw/config/ ]
, required => 1
, lazy => 1
, default => sub {
require Nour::Config;
return new Nour::Config ( -base => 'config' );
}
);
has _printer => (
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
, debug => 1
, pid => 1
);
require Nour::Printer;
return new Nour::Printer ( %conf );
}
);
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 = ();
require Nour::Database;
return new Nour::Database ( %conf );
}
);
#has _util # TODO factor all the _methods to $self->util->methods... or not
has _json => (
is => 'rw'
, isa => 'JSON::XS'
, lazy => 1
, required => 1
lib/API/Handle.pm view on Meta::CPAN
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 => '-'
, indent => 2
, use_ixhash => 1
);
}
);
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 } ) {
$self->$attr( $self->config->{ $attr } )
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};
$args{uri} ||= $self->_join_uri( $args{path} );
# Preserve hash order. Maybe needed for SOAP.
if ( defined $args{content} and (
( ref $args{content} eq 'ARRAY' ) or # Deprecated - backwards compatibility
( ref $args{content} eq 'REF' and ref ${ $args{content} } eq 'ARRAY' ) # New style ? => \[]
)
) {
$self->_tied( ref => \%args, key => 'content', tied => 1 );
}
# Leave it up to the API implementation to encode the hash/array ref into JSON / Form data / XML / etc.
$req->content( $args{content} ) if defined $args{content};
$req->method( $args{method} ) if defined $args{method};
$req->uri( $args{uri} );
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' ) {
$data = $self->_json->encode( $args{data} );
}
when ( 'xml' ) {
$data = $self->_xml->write( $args{data} );
}
when ( 'form' ) {
require URI;
my $uri = URI->new('http:');
$uri->query_form( ref $args{data} eq "HASH" ? %{ $args{data} } : @{ $args{data} } );
$data = $uri->query;
$data =~ s/(?<!%0D)%0A/%0D%0A/g if defined $data;
}
}
return $data;
}
sub _decode {
my ( $self, %args ) = @_;
my ( $data );
for ( $args{type} ) {
API-INSEE-Sirene
view release on metacpan or search on metacpan
lib/API/INSEE/Sirene.pm view on Meta::CPAN
package API::INSEE::Sirene;
use strict;
use warnings;
use Carp 'croak';
use JSON;
use HTTP::Request::Common qw/ GET POST /;
use HTTP::Status ':constants';
use List::Util 'any';
use LWP::UserAgent;
use POSIX 'strftime';
use Switch;
our $VERSION = 4.04;
use constant {
API_AUTH_URL => 'https://api.insee.fr/token',
API_BASE_URL => 'https://api.insee.fr/entreprises/sirene/V3',
DEFAULT_MAX_RESULTS => 20, # from documentation
DEFAULT_TIMEOUT => 20,
HARD_MAX_RESULTS => 1_000, # from documentation
MAX_SIREN_LENGTH => 9,
MAX_SIRET_LENGTH => 14,
MIN_LENGTH => 3,
};
my $EMPTY = q//;
my $historized_fields = {
siren => [ qw/
dateFin dateDebut
etatAdministratifUniteLegale changementEtatAdministratifUniteLegale
nomUniteLegale changementNomUniteLegale nomUsageUniteLegale changementNomUsageUniteLegale
denominationUniteLegale changementDenominationUniteLegale denominationUsuelle1UniteLegale
denominationUsuelle2UniteLegale denominationUsuelle3UniteLegale changementDenominationUsuelleUniteLegale
categorieJuridiqueUniteLegale changementCategorieJuridiqueUniteLegale activitePrincipaleUniteLegale
nomenclatureActivitePrincipaleUniteLegale changementActivitePrincipaleUniteLegale nicSiegeUniteLegale
changementNicSiegeUniteLegale economieSocialeSolidaireUniteLegale changementEconomieSocialeSolidaireUniteLegale
caractereEmployeurUniteLegale changementCaractereEmployeurUniteLegale
/ ],
siret => [ qw/
etatAdministratifEtablissement changementEtatAdministratifEtablissement
enseigne1Etablissement enseigne2Etablissement enseigne3Etablissement changementEnseigneEtablissement
denominationUsuelleEtablissement changementDenominationUsuelleEtablissement
activitePrincipaleEtablissement nomenclatureActivitePrincipaleEtablissement changementActivitePrincipaleEtablissement
caractereEmployeurEtablissement changementCaractereEmployeurEtablissement
/ ],
};
my $useful_fields_legal_unit = [
qw/
siren
dateCreationUniteLegale
sigleUniteLegale
categorieEntreprise
denominationUniteLegale denominationUsuelle1UniteLegale nomUniteLegale
categorieJuridiqueUniteLegale
activitePrincipaleUniteLegale nomenclatureActivitePrincipaleUniteLegale
nicSiegeUniteLegale
/
];
my $useful_fields_establishment = [
qw/
siren siret
denominationUsuelleEtablissement denominationUniteLegale denominationUsuelle1UniteLegale nomUniteLegale
activitePrincipaleUniteLegale
lib/API/INSEE/Sirene.pm view on Meta::CPAN
$sirene->getEstablishmentBySIRET(12345678987654, $fields_that_interest_me);
# or
$sirene->getEstablishmentBySIRET(12345678987654, 'denominationUniteLegale');
# or simply
$sirene->getEstablishmentBySIRET(12345678987654);
# you can also perform searches whith a partial SIREN/SIRET number using search functions:
$sirene->searchEstablishmentBySIRET(1234567898);
$sirene->searchLegalUnitBySIREN(123456);
=head1 DESCRIPTION
This module allows you to interact with the Sirene API of INSEE (Institut National de la Statistique et des Études Économiques) in France.
It contains a set of functions that can perform searches on INSEE's database to get some information about french companies like their SIREN number, company name, company headquarters address, etc.
The terms "enterprise", "legal unit" and "establishment" used in this documentation are defined at the INSEE website in the following pages:
=over 4
=item * B<Enterprise definition:>
L<< https://www.insee.fr/en/metadonnees/definition/c1496 >>
=item * B<Legal unit definition:>
L<< https://www.insee.fr/en/metadonnees/definition/c1044 >>
=item * B<Establishment definition:>
L<< https://www.insee.fr/en/metadonnees/definition/c1377 >>
=back
Here is the documentation with among others all fields names:
=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.>
This module has been tested with 3.9 INSEE API version.
=head1 DEPENDENCIES
=over 4
=item * L<< Carp|https://perldoc.perl.org/Carp >>
=item * L<< JSON|https://metacpan.org/pod/JSON >>
=item * L<< List::Util|https://perldoc.perl.org/List::Util >>
=item * L<< HTTP::Request::Common|https://metacpan.org/pod/HTTP::Request::Common >>
=item * L<< HTTP::Status|https://metacpan.org/pod/HTTP::Status >> B<< version < 6.26 >>
=item * L<< LWP::UserAgent|https://metacpan.org/pod/LWP::UserAgent >>
=item * L<< POSIX::strftime|https://metacpan.org/pod/POSIX#strftime >>
=item * L<< Switch|https://metacpan.org/pod/Switch >>
=back
=head1 CONSTANTS
=head2 DEFAULT_MAX_RESULTS
The API's default number of results for each request. You can override it with the C<< setMaxResults >> method. A too big value may impact response time and general performances.
This constant is set to 20 results.
=head2 DEFAULT_TIMEOUT
This constant specifies how many seconds the client module has to wait for server response before giving up. You can override it with the C<< setTimeout >> method.
This constant is set to 20 seconds.
=head2 HARD_MAX_RESULTS
The maximum number of results that you can get. This value can't be increased (restricted by API). If you try to send a request with a higher value, the C<nombre> parameter will be forced to HARD_MAX_RESULTS value.
This constant is set to 1000 results.
=head2 MAX_SIREN_LENGTH
A SIREN number has a maximum length of 9 digits.
=head2 MAX_SIRET_LENGTH
A SIREN number has a maximum length of 14 digits.
=head2 MIN_LENGTH
In order to avoid useless requests with too short SIREN/SIRET numbers, the module requires at least 3 digits to allow you performing a search.
=head1 METHODS
=head2 getCustomCriteria
You can use this method to build more specific criteria:
my $criteria1 = $sirene->getCustomCriteria('numeroVoieEtablissement', 42);
You can choose between three search modes: 'exact', 'begin' or 'approximate' match. Default is 'approximate'.
my $criteria2 = $sirene->getCustomCriteria('libelleVoieEtablissement', 'avenue', undef, 'exact');
B<< Important: >> You must specify the endpoint to be reached B<< before >> calling the C<< getCustomCriteria >> method using C<< setCurrentEndpoint >>
$sirene->setCurrentEndpoint('siret');
=head2 getEstablishmentsByName
API-Mathpix
view release on metacpan or search on metacpan
lib/API/Mathpix.pm view on Meta::CPAN
package API::Mathpix;
use Moose;
use JSON::PP;
use LWP::UserAgent;
use HTTP::Request;
use MIME::Base64;
use Algorithm::LeakyBucket;
use API::Mathpix::Response;
has 'app_id' => (
is => 'rw',
isa => 'Str'
);
has 'app_key' => (
is => 'rw',
isa => 'Str'
);
has '_ua' => (
is => 'rw',
isa => 'LWP::UserAgent'
);
has '_bucket' => (
is => 'rw',
isa => 'Algorithm::LeakyBucket'
);
=head1 NAME
API::Mathpix - Use the API of Mathpix
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
=head1 SYNOPSIS
my $mathpix = API::Mathpix->new({
app_id => $ENV{MATHPIX_APP_ID},
app_key => $ENV{MATHPIX_APP_KEY},
});
my $response = $mathpix->process({
src => 'https://mathpix.com/examples/limit.jpg',
});
print $response->text;
=head1 EXPORT
A list of functions that can be exported. You can delete this section
if you don't export anything, such as for a purely object-oriented module.
=head1 SUBROUTINES/METHODS
=cut
sub BUILD {
my ($self) = @_;
$self->_ua(
LWP::UserAgent->new(
timeout => 30,
)
);
$self->_bucket(
Algorithm::LeakyBucket->new(
ticks => 200,
seconds => 60
)
);
}
=head2 process
=cut
sub process {
my ($self, $opt) = @_;
if (-f $opt->{src}) {
my $contents = do {
open my $fh, $opt->{src} or die '...';
local $/;
<$fh>;
};
$opt->{src} = "data:image/jpeg;base64,'".encode_base64($contents)."'";
}
my $url = 'https://api.mathpix.com/v3/text';
my $headers = [
'Content-Type' => 'application/json',
':app_id' => $self->app_id,
':app_key' => $self->app_key,
];
my $encoded_data = encode_json($opt);
my $r = HTTP::Request->new('POST', $url, $headers, $encoded_data);
my $response;
if ($self->_bucket->tick) {
$response = $self->_ua->request($r);
}
else {
warn 'Rate limiting !';
}
if ($response->is_success) {
my $data = decode_json($response->decoded_content);
return API::Mathpix::Response->new($data);
}
else {
warn $response->status_line;
}
}
=head1 AUTHOR
Eriam Schaffter, C<< <eriam at mediavirtuel.com> >>
=head1 BUGS & SUPPORT
Please go directly to Github
https://github.com/eriam/API-Mathpix
=head1 LICENSE AND COPYRIGHT
This software is Copyright (c) 2021 by Eriam Schaffter.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
=cut
1;
API-Octopart
view release on metacpan or search on metacpan
lib/API/Octopart.pm view on Meta::CPAN
=cut
sub octo_query
{
my ($self, $q) = @_;
my $part = shift;
my ($content, $hashfile);
if ($self->{cache})
{
system('mkdir', '-p', $self->{cache}) if (! -d $self->{cache});
my $h = md5_hex($q);
$hashfile = "$self->{cache}/$h.query";
# Load the cached version if older than cache_age days.
my $age_days = (-M $hashfile);
if (-e $hashfile && $age_days < $self->{cache_age})
{
if ($self->{ua_debug})
{
print STDERR "Reading from cache file (age=$age_days days): $hashfile\n";
}
if (open(my $in, $hashfile))
{
local $/;
$content = <$in>;
close($in);
}
else
{
die "$hashfile: $!";
}
}
}
if (!$content)
{
my $ua = LWP::UserAgent->new( agent => 'mdf-perl/1.0', keep_alive => 3);
$self->{api_queries} //= 0;
if ($self->{query_limit} && $self->{api_queries} >= $self->{query_limit})
{
die "query limit exceeded: $self->{api_queries} >= $self->{query_limit}";
}
$self->{api_queries}++;
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";
return;
}
);
}
my $req;
my $response;
my $tries = 0;
while ($tries < 3)
{
$req = HTTP::Request->new('POST' => 'https://octopart.com/api/v4/endpoint',
HTTP::Headers->new(
'Host' => 'octopart.com',
'Content-Type' => 'application/json',
'Accept' => 'application/json',
'Accept-Encoding' => 'gzip, deflate',
'token' => $self->{token},
'DNT' => 1,
'Origin' => 'https://octopart.com',
),
encode_json( { query => $q }));
$response = $ua->request($req);
if (!$response->is_success)
{
$tries++;
print STDERR "query error, retry $tries. "
. $response->code . ": "
. $response->message . "\n";
sleep 2**$tries;
}
else
{
last;
}
}
$content = $response->decoded_content;
if (!$response->is_success) {
die "request: " . $req->as_string . "\n" .
"resp: " . $response->as_string;
}
}
my $j = from_json($content);
if (!$j->{errors})
{
if ($hashfile)
{
open(my $out, ">", $hashfile) or die "$hashfile: $!";
print $out $content;
close($out);
}
}
else
{
my %errors;
foreach my $e (@{ $j->{errors} })
{
$errors{$e->{message}}++;
}
die "Octopart: " . join("\n", keys(%errors)) . "\n";
}
if ($self->{json_debug})
{
if ($hashfile)
{
API-ParallelsWPB
view release on metacpan or search on metacpan
lib/API/ParallelsWPB.pm view on Meta::CPAN
package API::ParallelsWPB;
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use JSON::XS;
use Carp;
use API::ParallelsWPB::Response;
use base qw/ API::ParallelsWPB::Requests /;
# ABSTRACT: client for Parallels Presence Builder API
our $VERSION = '0.03'; # VERSION
our $AUTHORITY = 'cpan:IMAGO'; # AUTHORITY
# Constuctor
sub new {
my $class = shift;
$class = ref $class || $class;
my $self = {
username => '',
password => '',
server => '',
api_version => '5.3',
debug => 0,
timeout => 30,
(@_)
};
map { confess "Field '" . $_ . "' required!" unless $self->{ $_ } } qw/username password server/;
return bless $self, $class;
}
# "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';
$data->{req_type} = uc $data->{req_type};
#compile URL
my $url = 'https://' . $self->{server} . '/api/' . $self->{api_version} . '/';
$url .= join( '/', @{ $url_array }) . '/';
my $post_data;
if ( $data->{req_type} eq 'POST' || $data->{req_type} eq 'PUT' ) {
$data->{post_data} ||= {};
unless ( ref $data->{post_data} eq 'HASH' || ref $data->{post_data} eq 'ARRAY' ) {
confess "parameter post_data must be hashref or arrayref!"
}
$post_data = $self->_json->encode($data->{post_data});
}
$post_data ||= '{}';
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 );
if ( $data->{req_type} eq 'POST' || $data->{req_type} eq 'PUT' ) {
$req->header( 'content-type' => 'application/json' );
$req->content( $post_data );
}
$req->authorization_basic( $self->{username}, $self->{password} );
$ua->ssl_opts( verify_hostname => 0 );
$ua->timeout( $self->{timeout} );
warn $req->as_string if ( $self->{debug} );
my $res = $ua->request( $req );
warn $res->as_string if ( $self->{debug} );
my $response = API::ParallelsWPB::Response->new( $res );
return $response;
}
sub _json {
my ( $self ) = @_;
unless( $self->{_json} ) {
$self->{_json} = JSON::XS->new;
}
return $self->{_json};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
API::ParallelsWPB - client for Parallels Presence Builder API
=head1 VERSION
version 0.03
=head1 SYNOPSIS
my $client = API::ParallelsWPB->new( username => 'admin', password => 'passw0rd', server => 'builder.server.mysite.ru' );
my $response = $client->get_sites_info;
if ( $response->success ) {
for my $site ( @{ $response->response } ) {
say "UUID: ". $site->{uuid};
}
}
else {
warn "Error occured: " . $response->error . ", Status: " . $response->status;
}
=head1 METHODS
=head2 B<new($class, %param)>
API-Plesk
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
package API::Plesk;
use strict;
use warnings;
use Carp;
use Data::Dumper;
use HTTP::Request;
use LWP::UserAgent;
use XML::Fast;
use version;
use API::Plesk::Response;
our $VERSION = '2.03';
# creates accessors to components
# can support old interface of API::Plesk
init_components(
# new
customer => [['1.6.3.0', 'Customer']],
webspace => [['1.6.3.0', 'Webspace']],
site => [['1.6.3.0', 'Site']],
subdomain => [['1.6.3.0', 'Subdomain']],
site_alias => [['1.6.3.0', 'SiteAlias']],
sitebuilder => [['1.6.3.0', 'SiteBuilder']],
ftp_user => [['1.6.3.0', 'FTPUser']],
service_plan => [['1.6.3.0', 'ServicePlan']],
service_plan_addon => [['1.6.3.0', 'ServicePlanAddon']],
database => [['1.6.3.0', 'Database']],
webuser => [['1.6.3.0', 'WebUser']],
dns => [['1.6.3.0', 'DNS']],
mail => [['1.6.3.0', 'Mail']],
user => [['1.6.3.0', 'User']],
# old
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 => '',
password => '',
secret_key => '',
url => '',
api_version => '1.6.3.1',
debug => 0,
timeout => 30,
(@_)
};
if (!$self->{secret_key}) {
confess "Required username!" unless $self->{username};
confess "Required password!" unless $self->{password};
}
confess "Required url!" unless $self->{url};
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 } };
$xml = $self->render_xml($xml);
warn "REQUEST $operator => $operation\n$xml" if $self->{debug};
my ($response, $error) = $self->xml_http_req($xml);
warn "RESPONSE $operator => $operation => $error\n$response" if $self->{debug};
unless ( $error ) {
$response = xml2hash $response, array => [$operation, 'result', 'property'];
}
return API::Plesk::Response->new(
operator => $operator,
operation => $operation,
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);
my $ua = new LWP::UserAgent( parse_head => 0 );
my $req = new HTTP::Request POST => $self->{url};
if ($self->{secret_key}) {
$req->push_header(':KEY', $self->{secret_key});
} else {
$req->push_header(':HTTP_AUTH_LOGIN', $self->{username});
$req->push_header(':HTTP_AUTH_PASSWD', $self->{password});
}
$req->content_type('text/xml; charset=UTF-8');
$req->content($xml);
# LWP6 hack to prevent verification of hostname
$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;
warn $res->as_string if defined $self->{debug} && $self->{debug} > 1;
return ('', 'connection timeout')
if !$res || $@ || ref $res && $res->status_line =~ /connection timeout/;
return $res->is_success() ?
($res->content(), '') :
('', $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 = '';
for my $tag ( keys %$hash ) {
my $value = $hash->{$tag};
if ( ref $value eq 'HASH' ) {
$value = _render_xml($value);
}
elsif ( ref $value eq 'ARRAY' ) {
my $tmp;
$tmp .= _render_xml($_) for ( @$value );
API-PleskExpand
view release on metacpan or search on metacpan
#!/usr/bin/perl
use strict;
use warnings;
use Module::Build;
my $build = Module::Build->new(
module_name => 'API::PleskExpand',
license => 'perl',
dist_author => 'NRG <pavel.odintsov@googlemail.com>',
requires => {
'API::Plesk' => '1.06',
'Data::Dumper' => 0,
'LWP::UserAgent' => 0,
'Getopt::Long' => 0,
'HTTP::Request' => 0,
'Carp' => 0,
'URI' => 0,
},
build_requires => {
'Test::More' => 0,
'Test::LongString' => 0,
'URI' => 0,
},
create_makefile_pl => 'traditional',
);
$build->create_build_script;
API-ReviewBoard
view release on metacpan or search on metacpan
ReviewBoard.pm view on Meta::CPAN
print "Summary of Review Request:\n", $summary, "\n\n";
my $bug = $rb->getBugIds(changenum => '1302722');
print "Associated Bug list:\n", $bug, "\n\n";
my $commentscount = $rb->getReviewCommentsCount( reviewnum => '4108034');
print "No of comments added for Review Request:\n", $commentscount, "\n\n";
my $outgoingreviews = $rb->getOutgoingReviewsCount(user => 'users');
print "No of outgoing Review Requests by user 'users':\n",$outgoingreviews,"\n\n";
my $reviewsbydate = $rb->getOutgoingReviewsCountByDate(user => 'users', startdate => '2011-03-01', enddate => '2011-03-30');
print "No of outgoing Review Requests by user 'users' during time interval:\n", $reviewsbydate, "\n\n";
my $reviewsbystatus = $rb->getOutgoingReviewsCountByStatus(user => 'users', status => 'submitted');
print "No of outgoing Review Requests by user 'users' in state submitted:\n", $reviewsbystatus, "\n\n";
my $incomingreviews = $rb->getIncomingReviewsCount(user => 'users');
print "No of incoming review requests made to user:\n", $incomingreviews, "\n\n";
=head1 DESCRIPTION
C<API::ReviewBoard> provides an interface to work with the exported ReviewBoard 2.0 APIs.
You can choose to either subclass this module, and thus using its
accessors on your own module, or to store an C<API::ReviewBoard>
object inside your own object, and access the accessors from there.
See the C<SYNOPSIS> for examples.
=head1 METHODS
=head2 my $rb = API::ReviewBoard->new( hostedurl => 'http://reviewboard.company.com',
username => 'user',
password => 'passwd' );
Creates a new API::ReviewBoard object.
=cut
sub new {
my $class = shift;
my %args = @_;
my $self;
%args = validate(
@_,
{
hostedurl => { type => SCALAR, optional => 0 },
username => { type => SCALAR, optional => 0 },
password => { type => SCALAR, optional => 0 },
}
);
$self->{_owner} = $$;
$self->{_hostedurl} = $args{hostedurl};
$self->{_username} = $args{username};
$self->{_password} = $args{password};
$self->{_useragent} = LWP::UserAgent->new;
$self->{_cookie_jar} = HTTP::Cookies->new(file => "lwpcookies.txt", autosave => 1);
# post request to login
my $link = $self->{_hostedurl}.'api/json/accounts/login/';
my $request = new HTTP::Request('POST',$link);
my $content = 'username='.$self->{_username}.'&password='.$self->{_password};
$request->content($content);
my $response = $self->{_useragent}->simple_request($request);
# extract cookie from response header
$self->{_cookie_jar}->extract_cookies($response);
bless $self,$class;
return $self;
}
=head2 $rb->getReviewBoardLink(changenum => '112345');
Gets the review board link for a ACTIVE change request number.
=cut
sub getReviewBoardLink {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
# get request to get review number based on change number
my $changenumlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $changenumlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml=~ m/.*"id": (\d+),.*/;
my $reviewnum = $1;
my $reviewlink = $self->{_hostedurl}.'/r/'.$reviewnum;
return $reviewlink;
}
=head2 $rb->getReviewDescription(changenum => '112345');
The new review request description from ACTIVE change request.
=cut
sub getReviewDescription {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
# get request to get review number based on change number
my $changenumlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $changenumlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*"description": "(.*)", "links".*/;
my $description = $1;
$description =~ s/(\\n)+/\n/g;
return ($description);
}
=head2 $rb->getReviewDateAdded(changenum => '112345');
Gets the date on which ACTIVE change request was added.
=cut
sub getReviewDateAdded {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
my $changenumlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $changenumlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*"time_added": "(.*)", "summary".*/;
my $dateadded = $1;
return ($dateadded);
}
=head2 $rb->getReviewLastUpdated(changenum => '112345');
Gets the date on which change request was last updated.
=cut
sub getReviewLastUpdated {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
my $changenumlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $changenumlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ /.*"last_updated": "(.*)", "description".*/;
my $lastupdated = $1;
return ($lastupdated);
}
=head2 $rb->getReviewers(changenum => '112345');
Gets the name of the reviewers assigned for ACTIVE change request number.
The function returns an ARRAYREF to the user.
=cut
sub getReviewers {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*"target_people": (.*), "testing_done".*/;
my $name = $1;
my @arr;
my $count = @arr = $name =~ /"title": "(\w+)"/g;
my $reviewers = \@arr;
return ($reviewers);
}
=head2 $rb->getSubmitter(changenum => '112345');
Gets the name of the submitter who submitted the ACTIVE change request.
=cut
sub getSubmitter {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*"submitter": (.*), "screenshots".*/;
my $name = $1;
my @arr;
my $count = @arr = $name =~ /"title": "(\w+)"/g;
my $submitter = \@arr;
return ($submitter);
}
=head2 $rb->getSummary(changenum => '112345');
The review request's brief summary of ACTIVE change request.
=cut
sub getSummary {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*"summary": "(.*)", "public".*/;
my $summary = $1;
return ($summary);
}
=head2 $rb->getSummary(changenum => '112345');
Get the list of bugs closed or referenced by the ACTIVE change request.
=cut
sub getBugIds {
my $self = shift;
my %args = validate(
@_,
{ changenum => { type => SCALAR, optional => 0 },
}
);
$self->{_changenum} = $args{changenum};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?changenum='.$self->{_changenum};
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*"bugs_closed": (.*), "changenum".*/;
my $bugids = $1;
return ($bugids);
}
=head2 $rb->getReviewCommentsCount(reviewnum => '41080');
Gets the count of comments received for an ACTIVE change request.
=cut
sub getReviewCommentsCount {
my $self = shift;
my %args = validate(
@_,
{ reviewnum => { type => SCALAR, optional => 0 },
}
);
$self->{_reviewnum} = $args{reviewnum};
my $userlink = $self->{_hostedurl}.'/api/review-requests/'.$self->{_reviewnum}.'/reviews/?counts-only=1';
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*{"count": (\d+).*/ ;
my $count = $1;
return $count;
}
=head2 $rb->getOutgoingReviewsCount(user => 'abdcde');
Gets the count of review requests made by a user.
=cut
sub getOutgoingReviewsCount {
my $self = shift;
my %args = validate(
@_,
{ user => { type => SCALAR, optional => 0 },
}
);
$self->{_user} = $args{user};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?from-user='.$self->{_user}.'&status=all&counts-only=1';
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*{"count": (\d+).*/ ;
my $count = $1;
return ($count);
}
=head2 $rb->getOutgoingReviewsCountByDate(user => 'abdcde', startdate => '2011-03-01',
enddate => '2011-03-30');
Gets the count of review requests made by a user during time interval.
=cut
sub getOutgoingReviewsCountByDate {
my $self = shift;
my %args = validate(
@_,
{ user => { type => SCALAR, optional => 0 },
startdate => { type => SCALAR, optional => 0 },
enddate => { type => SCALAR, optional => 0 },
}
);
$self->{_user} = $args{user};
$self->{_startdate} = $args{startdate};
$self->{_enddate} = $args{enddate};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?from-user='.$self->{_user}.'&time-added-from='.$self->{_startdate}.'&time-added-to='.$self->{_enddate}.'&status=all&counts-only=1';
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*{"count": (\d+).*/ ;
my $count = $1;
return $count;
}
=head2 $rb->getOutgoingReviewsCountByStatus(user => 'abdcde', status => 'all | pending |submitted | discarded' );
Gets the count of review requests made by a user with status in [all | pending |submitted | discarded].
=cut
sub getOutgoingReviewsCountByStatus {
my $self = shift;
my %args = validate(
@_,
{ user => { type => SCALAR, optional => 0 },
status => { type => SCALAR, optional => 0 },
}
);
$self->{_user} = $args{user};
$self->{_status} = $args{status};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?from-user='.$self->{_user}.'&status='.$self->{_status}.'&counts-only=1';
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*{"count": (\d+).*/ ;
my $count = $1;
return $count;
}
=head2 $rb->getIncomingReviewsCount(user => 'abdcde');
Gets the count of review requests made to a user.
=cut
sub getIncomingReviewsCount {
my $self = shift;
my %args = validate(
@_,
{ user => { type => SCALAR, optional => 0 },
}
);
$self->{_user} = $args{user};
my $userlink = $self->{_hostedurl}.'/api/review-requests/?to-users='.$self->{_user}.'&counts-only=1';
my $request = new HTTP::Request('GET', $userlink);
$self->{_cookie_jar}->add_cookie_header($request);
my $response = $self->{_useragent}->simple_request($request);
my $xml = $response->as_string;
$xml =~ m/.*{"count": (\d+).*/ ;
my $count = $1;
return $count;
}
=head1 AUTHOR
This module by Chetan Giridhar E<lt>chetang@cpan.orgE<gt>.
=head1 COPYRIGHT
This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.
=cut
1;
API-Vultr
view release on metacpan or search on metacpan
lib/API/Vultr.pm view on Meta::CPAN
package API::Vultr;
use 5.008;
use strict;
use warnings;
use Carp qw(croak);
use URI qw();
use LWP::UserAgent ();
our $VERSION = '0.003';
sub _make_uri {
my ( $self, $path, %query ) = @_;
my $uri = URI->new( 'https://api.vultr.com/v2' . $path );
if (%query) {
$uri->query_form(%query);
}
return $uri->as_string;
}
sub _request {
my ( $self, $method, $uri, $body ) = @_;
if ( not( defined $body ) ) {
my $lc_method = lc $method;
return $self->ua->$lc_method( $uri,
Authorization => 'Bearer ' . $self->{api_key} );
}
else {
my $request = HTTP::Request->new( uc $method, $uri );
$request->header( 'Content-Type' => 'application/json' );
$request->content($body);
return $self->ua->request($request);
}
}
sub api_key {
my ( $self, $setter ) = @_;
if ( defined $setter ) {
return $self->{api_key} = $setter;
}
return $self->{api_key};
}
sub ua {
my ( $self, $setter ) = @_;
if ( defined $setter ) {
return $self->{ua} = $setter;
}
return $self->{ua};
}
sub new {
my ( $class, %args ) = @_;
croak
qq{You must specify an API key when creating an instance of API::Vultr}
unless exists $args{api_key};
my $self = { %args, ua => LWP::UserAgent->new( timeout => 10 ) };
return bless( $self, __PACKAGE__ );
}
# ACCOUNT #
sub get_account_info {
my $self = shift;
return $self->_request( 'get', $self->_make_uri('/account') );
}
# APPLICATIONS #
sub get_applications {
my $self = shift;
return $self->_request( 'get', $self->_make_uri('/applications') );
}
# BACKUPS #
sub get_backups {
my ( $self, %query ) = @_;
return $self->_request( 'get', $self->_make_uri( '/backups', %query ) );
}
sub get_backup_by_id {
APISchema
view release on metacpan or search on metacpan
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "APISchema",
"no_index" : {
"directory" : [
"t",
"xt",
"inc",
"share",
"eg",
"examples",
"author",
"builder"
]
},
"prereqs" : {
"configure" : {
"requires" : {
"Module::Build::Tiny" : "0.035"
}
},
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
"Test::MinimumVersion::Fast" : "0.04",
"Test::PAUSE::Permissions" : "0.04",
"Test::Pod" : "1.41",
"Test::Spellunker" : "v0.2.7"
}
},
"runtime" : {
"requires" : {
"Class::Accessor::Lite" : "0",
"Class::Accessor::Lite::Lazy" : "0",
"Class::Load" : "0",
"HTML::Escape" : "0",
"HTTP::Message" : "0",
"Hash::Merge::Simple" : "0",
"JSON::Pointer" : "0",
"JSON::XS" : "0",
"List::MoreUtils" : "0",
"Path::Class" : "0",
"Plack" : "0",
"Router::Simple" : "0",
"Text::Markdown::Hoedown" : "0",
"Text::MicroTemplate" : "0",
"Text::MicroTemplate::DataSection" : "0",
"Text::MicroTemplate::Extended" : "0",
"URI::Escape" : "0",
"URL::Encode" : "0",
"Valiemon" : "0.04",
"perl" : "5.014"
}
},
"test" : {
"requires" : {
"HTTP::Request::Common" : "0",
"Path::Class" : "0",
"Test::Class" : "0",
"Test::Deep" : "0",
"Test::Deep::JSON" : "0",
"Test::Fatal" : "0",
"Test::More" : "0.98"
}
}
},
"provides" : {
"APISchema" : {
"file" : "lib/APISchema.pm",
"version" : "1.37"
},
"APISchema::DSL" : {
"file" : "lib/APISchema/DSL.pm"
},
"APISchema::Generator::Markdown" : {
"file" : "lib/APISchema/Generator/Markdown.pm"
},
"APISchema::Generator::Markdown::ExampleFormatter" : {
"file" : "lib/APISchema/Generator/Markdown/ExampleFormatter.pm"
},
"APISchema::Generator::Markdown::Formatter" : {
"file" : "lib/APISchema/Generator/Markdown/Formatter.pm"
},
"APISchema::Generator::Markdown::ResourceResolver" : {
"file" : "lib/APISchema/Generator/Markdown/ResourceResolver.pm"
},
"APISchema::Generator::Router::Simple" : {
"file" : "lib/APISchema/Generator/Router/Simple.pm"
},
"APISchema::JSON" : {
"file" : "lib/APISchema/JSON.pm"
},
"APISchema::Resource" : {
"file" : "lib/APISchema/Resource.pm"
},
"APISchema::Route" : {
"file" : "lib/APISchema/Route.pm"
},
"APISchema::Schema" : {
"file" : "lib/APISchema/Schema.pm"
},
"APISchema::Validator" : {
"file" : "lib/APISchema/Validator.pm"
},
"APISchema::Validator::Decoder" : {
"file" : "lib/APISchema/Validator/Decoder.pm"
},
"APISchema::Validator::Result" : {
"file" : "lib/APISchema/Validator/Result.pm"
},
"Plack::App::APISchema::Document" : {
"file" : "lib/Plack/App/APISchema/Document.pm"
},
"Plack::App::APISchema::MockServer" : {
"file" : "lib/Plack/App/APISchema/MockServer.pm"
},
"Plack::Middleware::APISchema::RequestValidator" : {
APNS-Agent
view release on metacpan or search on metacpan
"Songmu <y.songmu@gmail.com>"
],
"dynamic_config" : 0,
"generated_by" : "Minilla/v0.11.0",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "APNS-Agent",
"no_index" : {
"directory" : [
"t",
"xt",
"inc",
"share",
"eg",
"examples",
"author",
"builder"
]
},
"prereqs" : {
"configure" : {
"requires" : {
"CPAN::Meta" : "0",
"CPAN::Meta::Prereqs" : "0",
"Module::Build" : "0.38"
}
},
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
"Test::MinimumVersion" : "0.10108",
"Test::Pod" : "1.41",
"Test::Spellunker" : "v0.2.7"
}
},
"runtime" : {
"requires" : {
"AnyEvent::APNS" : "0",
"Cache::LRU" : "0",
"Class::Accessor::Lite::Lazy" : "0.03",
"Encode" : "0",
"Hash::Rename" : "0",
"JSON::XS" : "0",
"Log::Minimal" : "0",
"Plack::Loader" : "0",
"Plack::Request" : "0",
"Router::Boom::Method" : "0",
"feature" : "0",
"perl" : "5.010"
}
},
"test" : {
"requires" : {
"AnyEvent" : "0",
"AnyEvent::Socket" : "0",
"HTTP::Request::Common" : "0",
"Plack::Test" : "0",
"Test::More" : "0.98",
"Test::TCP" : "0"
}
}
},
"provides" : {
"APNS::Agent" : {
"file" : "lib/APNS/Agent.pm",
"version" : "0.06"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/Songmu/p5-APNS-Agent/issues"
},
"homepage" : "https://github.com/Songmu/p5-APNS-Agent",
"repository" : {
"url" : "git://github.com/Songmu/p5-APNS-Agent.git",
"web" : "https://github.com/Songmu/p5-APNS-Agent"
}
},
"version" : "0.06"
}
APP-REST-RestTestSuite
view release on metacpan or search on metacpan
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
package APP::REST::RestTestSuite;
use 5.006;
use strict;
use warnings FATAL => 'all';
use Data::Dumper;
use HTTP::Request;
use Time::HiRes qw( time sleep );
use File::Path;
use Cwd;
use LWP::UserAgent;
use APP::REST::ParallelMyUA;
use constant LOG_FILE => 'rest_client.log';
use constant ERR_LOG_FILE => 'rest_client_error.log';
use constant LINE => '=' x 50;
$| = 1; #make the pipe hot
$Data::Dumper::Indent = 1;
=head1 NAME
APP::REST::RestTestSuite - Suite for testing restful web services
=head1 VERSION
Version 0.03
=cut
our $VERSION = '0.03';
=head1 SYNOPSIS
use APP::REST::RestTestSuite;
my $suite = APP::REST::RestTestSuite->new();
$suite->execute_test_cases( $suite->get_test_cases() );
my ( $cases_in_config, $executed, $skipped, $passed, $failed ) =
$suite->get_result_summary();
#OR
use APP::REST::RestTestSuite;
# overrides the default config and log file paths
my $suite = APP::REST::RestTestSuite->new(
REST_CONFIG_FILE => <config file>,
LOG_FILE_PATH => <path>,
);
$suite->execute_test_cases( $suite->get_test_cases() );
my ( $cases_in_config, $executed, $skipped, $passed, $failed ) =
$suite->get_result_summary();
=head1 DESCRIPTION
APP::REST::RestTestSuite object is instantiated with the data in config file.
Default config file format is defined in __DATA__ and that can be overridden
by passing the config file as an argument to the class.
Default LOG file path is the current working directory of the script which
calls this module
=head1 SUBROUTINES/METHODS
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
#expects an hash with keys as test case number and value as hash ref with test
#specification; validate that before trying to execute them.
my $err = $self->validate_test_cases(@_);
die "ERROR: $err\n" if ($err);
my %test_cases = @_;
my $ua = LWP::UserAgent->new;
$ua->agent("RTAT/$VERSION");
$ua->timeout(90); # in seconds
$ua->default_header('Accept' => '*/*'); # to get cross platform support
my ( $config, $total, $total_response_time, $skip, $pass, $fail ) = (0) x 6;
my ( $uri, $method, $req_content_type, $req_body, $status ) = (undef) x 5;
my ( $request, $response ) = (undef) x 2;
my ( $username, $password ) = (undef) x 2;
$username = $self->{username};
$password = $self->{password};
my $fh = $self->get_log_file_handle();
my $err_fh = $self->get_err_log_file_handle();
if ( $self->{html_log_required}
&& ( $self->{html_log_required} =~ /yes/i ) )
{
print $fh
qq|<HTML> <HEAD> <TITLE>LOG for $self->{endpoint}</TITLE> </HEAD>|
. qq|<BODY><textarea rows="999999" cols="120" style="border:none;">|;
print $err_fh
qq|<HTML> <HEAD> <TITLE>ERROR LOG for $self->{endpoint}</TITLE> </HEAD>|
. qq|<BODY><textarea rows="999999" cols="120" style="border:none;">|;
}
print STDERR "\nTest Suite executed on $self->{endpoint}\n";
print $fh "\nTest Suite executed on $self->{endpoint}\n";
print $err_fh "\nTest Suite executed on $self->{endpoint}\n";
foreach my $count ( sort { $a <=> $b } keys(%test_cases) ) {
my $tc = $test_cases{$count};
$config++;
print $fh "\n", LINE, "\n";
if ( $tc->{execute} && ( $tc->{execute} =~ /no/i ) ) {
print $fh "\nSkipping Test case $count => $tc->{test_case} \n";
$skip++;
next;
}
$uri = qq|$self->{rest_uri_base}| . qq|$tc->{uri}|;
$method = uc( $tc->{request_method} );
$req_content_type = $tc->{request_content_type};
$req_body = $tc->{request_body} || 0;
$status = $tc->{response_status};
if ( $tc->{request_method} =~ /get/i ) {
$request = HTTP::Request->new( $method, $uri );
$request->authorization_basic( $username, $password )
if ( $username && $password );
} else {
$request =
HTTP::Request->new( $method, $uri, new HTTP::Headers, $req_body );
$request->authorization_basic( $username, $password )
if ( $username && $password );
$request->content_type($req_content_type);
$request->content_length( length($req_body) );
}
print STDERR "Executing Test case $count => $tc->{test_case}";
print $fh "Executing Test case $count => $tc->{test_case}";
my $start_time = time;
$response = $ua->request($request);
$total++;
my $exec_time = $self->delta_time( start_time => $start_time );
$total_response_time += $exec_time;
$exec_time = sprintf( "%.2f", $exec_time );
print STDERR " [Completed in $exec_time ms]\n";
print $fh " [Completed in $exec_time ms]\n";
$self->_print_logs(
fh => $fh,
uri => $uri,
method => $method,
req_body => $req_body,
);
$self->_print_logs(
fh => $fh,
res => $response,
exec_time => $exec_time,
);
#Level-1 check => check for response status code
#Level-2 check => check for expected response content_type
my $resp_code = $response->code;
if ( $status =~ m/$resp_code/ ) {
my $failed = 0;
if ( defined $tc->{response_content_type} ) {
my $expected_response_content_type =
$tc->{response_content_type};
#my $respose_content_type = $response->{_headers}->content_type;
my $respose_content_type = $response->header('Content-Type');
unless ( defined $respose_content_type ) {
$failed = 1;
} elsif ( $expected_response_content_type !~
m/$respose_content_type/ )
{
$failed = 1;
print $err_fh "\n", LINE, "\n";
print $err_fh
"Executing Test case $count => $tc->{test_case}";
print $err_fh
"\n*********ATTENTION CONTENT TYPE ERROR ******";
print $err_fh
"\n\nExpected content_type is $expected_response_content_type\n";
print $err_fh
"content_type recieved in response is $respose_content_type\n";
print $err_fh
"\n*********ATTENTION CONTENT TYPE ERROR ******";
$self->_print_logs(
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
die "ERROR: $err\n" if ($err);
my %test_cases = @_;
# use my customized user agent for parallel invokes
my $pua = APP::REST::ParallelMyUA->new();
$pua->agent("RTAT/$VERSION");
$pua->in_order(1); # handle requests in order of registration
$pua->duplicates(0); # ignore duplicates
$pua->timeout(60); # in seconds
$pua->redirect(1); # follow redirects
$pua->default_header('Accept' => '*/*'); # to get cross platform support
my ( $config, $total, $total_response_time, $skip, $pass, $fail ) = (0) x 6;
my ( $uri, $method, $req_content_type, $req_body, $status ) = (undef) x 5;
my ( $request, $response ) = (undef) x 2;
my ( $username, $password ) = (undef) x 2;
$username = $self->{username};
$password = $self->{password};
my $fh = $self->get_log_file_handle();
if ( $self->{html_log_required}
&& ( $self->{html_log_required} =~ /yes/i ) )
{
print $fh
qq|<HTML> <HEAD> <TITLE>LOG for $self->{endpoint}</TITLE> </HEAD>|
. qq|<BODY><textarea rows="999999" cols="120" style="border:none;">|;
}
print STDERR "\nTest Suite executed on $self->{endpoint}\n";
print $fh "\nTest Suite executed on $self->{endpoint}\n";
my @reqs;
foreach my $count ( sort { $a <=> $b } keys(%test_cases) ) {
my $tc = $test_cases{$count};
$config++;
if ( $tc->{execute} =~ /no/i ) {
print $fh "\nSkipping Test case $count => $tc->{test_case} \n";
$skip++;
next;
}
$uri = qq|$self->{rest_uri_base}| . qq|$tc->{uri}|;
#Support only GET methods at present
if ( $tc->{request_method} =~ /get/i ) {
# Create HTTP request pool for later execution by parallel useragent
$method = uc( $tc->{request_method} );
$req_content_type = $tc->{request_content_type};
$req_body = $tc->{request_body} || 0;
$status = $tc->{response_status};
my $request = HTTP::Request->new( $method, $uri );
$request->authorization_basic( $username, $password )
if ( $username && $password );
push( @reqs, $request );
}
$total++;
}
print STDERR "\nRequesting [$total] web services together.\n";
foreach my $req (@reqs) {
# register all requests and wait for them to finish
if ( my $res = $pua->register($req) ) {
print STDERR $res->error_as_HTML;
}
}
print STDERR "Receiving response from web services. Please wait..!\n";
# will return once all forked web services are either completed or timeout
my $entries = $pua->wait();
print STDERR "\n\n";
foreach ( keys %$entries ) {
my $response = $entries->{$_}->response;
my $tick = $entries->{$_}->{tick};
my $exec_time = ( $tick->{end} - $tick->{start} ) * 1000 ;
$total_response_time += $exec_time;
$exec_time = sprintf( "%.2f", $exec_time );
print STDERR "\n", $response->request->url,
"\n ! Response Status [", $response->code,
"]\tResponse Time [$exec_time ms]";
$self->_print_logs(
fh => $fh,
uri => $response->request->url,
method => $response->request->method,
req_body => ''
);
$self->_print_logs(
fh => $fh,
res => $response,
exec_time => $exec_time,
);
}
#convert milli seconds to seconds for total_exec_time
$total_response_time = sprintf( "%.2f", $total_response_time / 1000 );
my $avg_response_time =
sprintf( "%.2f", ( $total_response_time * 1000 ) / $total );
print STDERR
"\n\n\nComplete test case report is in $self->{file}->{log_file}";
print STDERR
"\n\nResponse time of $total web service calls => [$total_response_time seconds]\n";
print STDERR
ASNMTAP
view release on metacpan or search on metacpan
lib/ASNMTAP/Asnmtap/Plugins/WebTransact.pm view on Meta::CPAN
# ----------------------------------------------------------------------------------------------------------
# © Copyright 2003-2011 by Alex Peeters [alex.peeters@citap.be]
# ----------------------------------------------------------------------------------------------------------
# 2011/mm/dd, v3.002.003, package ASNMTAP::Asnmtap::Plugins::WebTransact
# ----------------------------------------------------------------------------------------------------------
package ASNMTAP::Asnmtap::Plugins::WebTransact;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use strict;
use warnings; # Must be used in test mode only. This reduces a little process speed
#use diagnostics; # Must be used in test mode only. This reduces a lot of process speed
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use CGI::Carp qw(fatalsToBrowser set_message cluck);
use HTTP::Request::Common qw(GET POST HEAD);
use HTTP::Cookies;
use LWP::Debug;
use LWP::UserAgent;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use ASNMTAP::Asnmtap qw(%ERRORS %TYPE &_dumpValue);
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
BEGIN { $ASNMTAP::Asnmtap::Plugins::WebTransact::VERSION = do { my @r = (q$Revision: 3.002.003$ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; }
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use constant FALSE => 0;
use constant TRUE => ! FALSE;
use constant Field_Refs => {
Method => { is_ref => FALSE, type => '' },
Url => { is_ref => FALSE, type => '' },
Qs_var => { is_ref => TRUE, type => 'ARRAY' },
Qs_fixed => { is_ref => TRUE, type => 'ARRAY' },
Exp => { is_ref => FALSE, type => 'ARRAY' },
Exp_Fault => { is_ref => FALSE, type => '' },
Exp_Return => { is_ref => TRUE, type => 'HASH' },
Msg => { is_ref => FALSE, type => '' },
Msg_Fault => { is_ref => FALSE, type => '' },
Timeout => { is_ref => FALSE, type => undef },
Perfdata_Label => { is_ref => FALSE, type => undef }
};
my (%returns, %downloaded, $ua);
keys %downloaded = 128;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _handleHttpdErrors { print "<hr><h1>ASNMTAP::Asnmtap::Plugins::WebTransact It's not a bug, it's a feature!</h1><p>Error: $_[0]</p><hr>"; }
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
set_message ( \&_handleHttpdErrors );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _error_message { $_[0] =~ s/\n/ /g; $_[0]; }
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
sub new {
my ($object, $asnmtapInherited, $urls_ar) = @_;
# $urls_ar is a ref to a list of hashes (representing a request record) in a partic format.
# If a hash is __not__ in that format it's much better to cluck since it is
# hard to interpret 'not an array ref' messages (from check::_make_request) caused
# by mis spelled or mistaken field names.
&_dumpValue ( $asnmtapInherited, $object .': attribute asnmtapInherited is missing.' ) unless ( defined $asnmtapInherited );
ASP4
view release on metacpan or search on metacpan
lib/ASP4/ErrorHandler/Remote.pm view on Meta::CPAN
package ASP4::ErrorHandler::Remote;
use strict;
use warnings 'all';
use base 'ASP4::ErrorHandler';
use vars __PACKAGE__->VARS;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Date 'time2iso';
use JSON::XS;
use Data::Dumper;
require ASP4;
our $ua;
sub run
{
my ($s, $context) = @_;
my $error = $Stash->{error};
$s->print_error( $error );
$s->send_error($error);
}# end run()
sub send_error
{
my ($s, $error) = @_;
$ua ||= LWP::UserAgent->new();
$ua->agent( ref($s) . " $ASP4::VERSION" );
my %clone = %$error;
my $req = POST $Config->errors->post_errors_to, \%clone;
$ua->request( $req );
}# end send_error()
1;# return true:
=pod
=head1 NAME
ASP4::ErrorHandler::Remote - Send your errors someplace else via http.
=head1 SYNOPSIS
In your C<asp4-config.json>:
...
"errors": {
"error_handler": "ASP4::ErrorHandler::Remote",
"post_errors_to": "http://errors.ohno.com/post/errors/here/"
},
...
=head1 DESCRIPTION
This class provides a default error handler which does the following:
1) Makes a simple HTML page and prints it to the browser, telling the user
that an error has just occurred.
2) Sends an error notification to the web address specified in the config.
The data contained within the POST will match the public properties of L<ASP4::Error>, like this:
$VAR1 = {
AWS-CloudFront
view release on metacpan or search on metacpan
lib/AWS/CloudFront/Request.pm view on Meta::CPAN
package
AWS::CloudFront::Request;
use VSO;
use HTTP::Request;
use AWS::CloudFront::ResponseParser;
has 'cf' => (
is => 'ro',
isa => 'AWS::CloudFront',
required => 1,
);
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'protocol' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub { 'https' }
);
sub _send_request
{
my ($s, $method, $uri, $headers, $content) = @_;
my $req = HTTP::Request->new( $method => $uri );
$req->content( $content ) if $content;
map {
$req->header( $_ => $headers->{$_} )
} keys %$headers;
my $res = $s->cf->ua->request( $req );
# # After creating a bucket and setting its location constraint, we get this
# # strange 'TemporaryRedirect' response. Deal with it.
# if( $res->header('location') && $res->content =~ m{>TemporaryRedirect<}s )
# {
# $req->uri( $res->header('location') );
# $res = $s->s3->ua->request( $req );
# }# end if()
return $s->parse_response( $res );
}# end _send_request()
sub parse_response
{
my ($s, $res) = @_;
die "parse_response() is not yet implemented!";
}# end parse_response()
1;# return true:
AWS-S3
view release on metacpan or search on metacpan
lib/AWS/S3.pm view on Meta::CPAN
package AWS::S3;
use Moose;
use Carp 'confess';
use LWP::UserAgent::Determined;
use HTTP::Response;
use HTTP::Request::Common;
use IO::Socket::INET;
use Class::Load 'load_class';
use AWS::S3::ResponseParser;
use AWS::S3::Owner;
use AWS::S3::Bucket;
our $VERSION = '1.00';
has [qw/access_key_id secret_access_key/] => ( is => 'ro', isa => 'Str' );
has 'session_token' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
default => sub { $ENV{AWS_SESSION_TOKEN} },
);
has 'region' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
default => sub { $ENV{AWS_REGION} },
);
has 'secure' => (
is => 'ro',
isa => 'Bool',
lazy => 1,
default => 0
);
has 'endpoint' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my ( $s ) = @_;
if ( my $region = $s->region ) {
return "s3.$region.amazonaws.com"
} else {
return "s3.amazonaws.com"
}
},
);
has 'ua' => (
is => 'ro',
isa => 'LWP::UserAgent',
default => sub { LWP::UserAgent::Determined->new }
);
has 'honor_leading_slashes' => (
is => 'ro',
isa => 'Bool',
default => sub { 0 },
);
sub request {
AWS-SQS-Simple
view release on metacpan or search on metacpan
lib/AWS/SQS/Simple.pm view on Meta::CPAN
my $value_octets = encode('utf-8-strict', $params->{ $key } ) ;
$to_sign .= escape( $key_octets ) . '=' . escape( $value_octets ) ;
}
return $to_sign ;
}
=head2 escape
URI escape only the characters that should be escaped, according to RFC 3986
=cut
sub escape {
my ($str) = @_;
return uri_escape_utf8( $str,'^A-Za-z0-9\-_.~' ) ;
}
=head2 _generate_timestamp
Calculate current TimeStamp
=cut
sub _generate_timestamp {
return sprintf("%04d-%02d-%02dT%02d:%02d:%02d.000Z",
sub { ($_[5]+1900,
$_[4]+1,
$_[3],
$_[2],
$_[1],
$_[0])
}->(gmtime(time)));
}
=head2 _make_request
=cut
sub _make_request {
my $self = shift ;
my $url_to_access = shift ;
my $contents ;
my $attempts = 0 ;
my $got_data = 0 ;
my $this_profile_location ;
my $response;
until( $got_data or $attempts > 5 ) {
my $request = HTTP::Request->new(
GET => $url_to_access
);
my $ua = LWP::UserAgent->new ;
$ua->timeout(60) ;
$ua->env_proxy ;
$ua->agent( 'AWIS-INFO_GET/'.$VERSION ) ;
$response = $ua->request( $request ) ;
if( $response->is_success() ) {
$contents = $response->content;
$got_data = 1;
} else {
$contents = $response->content ;
print STDERR "ERROR : $contents" ;
$attempts++ ;
sleep( $attempts * 10 ) ;
}
$contents = $response->content ;
$attempts++ ;
}
my $response_content = $response->content ;
return $response_content ;
}
=head1 AUTHOR
Ankita, C<< <sankita.11 at gmail.com> >>
=head1 COPYRIGHT & LICENSE
Copyright 2014 Ankita Singhal, all rights reserved.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
1; # End of AWS::SQS::Simple
AWS-Signature4
view release on metacpan or search on metacpan
lib/AWS/Signature4.pm view on Meta::CPAN
package AWS::Signature4;
use strict;
use POSIX 'strftime';
use URI;
use URI::QueryParam;
use URI::Escape;
use Digest::SHA 'sha256_hex','hmac_sha256','hmac_sha256_hex';
use Date::Parse;
use Carp 'croak';
our $VERSION = '1.02';
=head1 NAME
AWS::Signature4 - Create a version4 signature for Amazon Web Services
=head1 SYNOPSIS
use AWS::Signature4;
use HTTP::Request::Common;
use LWP;
my $signer = AWS::Signature4->new(-access_key => 'AKIDEXAMPLE',
-secret_key => 'wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY');
my $ua = LWP::UserAgent->new();
# Example POST request
my $request = POST('https://iam.amazonaws.com',
[Action=>'ListUsers',
Version=>'2010-05-08']);
$signer->sign($request);
my $response = $ua->request($request);
# Example GET request
my $uri = URI->new('https://iam.amazonaws.com');
$uri->query_form(Action=>'ListUsers',
Version=>'2010-05-08');
my $url = $signer->signed_url($uri); # This gives a signed URL that can be fetched by a browser
my $response = $ua->get($url);
=head1 DESCRIPTION
This module implement's Amazon Web Service's Signature version 4
(http://docs.aws.amazon.com/general/latest/gr/signature-version-4.html).
=head1 METHODS
=over 4
=item $signer = AWS::Signature4->new(-access_key => $account_id,-secret_key => $private_key);
Create a signing object using your AWS account ID and secret key. You
may also use the temporary security tokens received from Amazon's STS
service, either by passing the access and secret keys derived from the
token, or by passing a VM::EC2::Security::Token produced by the
VM::EC2 module.
Arguments:
Argument name Argument Value
------------- --------------
-access_key An AWS acccess key (account ID)
-secret_key An AWS secret key
-security_token A VM::EC2::Security::Token object
If a security token is provided, it overrides any values given for
-access_key or -secret_key.
If the environment variables EC2_ACCESS_KEY and/or EC2_SECRET_KEY are
set, their contents are used as defaults for -acccess_key and
-secret_key.
=cut
sub new {
my $self = shift;
my %args = @_;
my ($id,$secret,$token);
if (ref $args{-security_token} && $args{-security_token}->can('access_key_id')) {
$id = $args{-security_token}->accessKeyId;
$secret = $args{-security_token}->secretAccessKey;
}
$id ||= $args{-access_key} || $ENV{EC2_ACCESS_KEY}
or croak "Please provide -access_key parameter or define environment variable EC2_ACCESS_KEY";
$secret ||= $args{-secret_key} || $ENV{EC2_SECRET_KEY}
or croak "Please provide -secret_key or define environment variable EC2_SECRET_KEY";
return bless {
access_key => $id,
secret_key => $secret,
(defined($args{-security_token}) ? (security_token => $args{-security_token}) : ()),
},ref $self || $self;
}
sub access_key { shift->{access_key } }
sub secret_key { shift->{secret_key } }
=item $signer->sign($request [,$region] [,$payload_sha256_hex])
Given an HTTP::Request object, add the headers required by AWS and
then sign it with a version 4 signature by adding an "Authorization"
header.
The request must include a URL from which the AWS endpoint and service
can be derived, such as "ec2.us-east-1.amazonaws.com." In some cases
(e.g. S3 bucket operations) the endpoint does not indicate the
region. In this case, the region can be forced by passing a defined
value for $region. The current date and time will be added to the
request using an "X-Amz-Date header." To force the date and time to a
fixed value, include the "Date" header in the request.
The request content, or "payload" is retrieved from the HTTP::Request
object by calling its content() method.. Under some circumstances the
payload is not included directly in the request, but is in an external
file that will be uploaded as the request is executed. In this case,
you must pass a second argument containing the results of running
sha256_hex() (from the Digest::SHA module) on the content.
The method returns a true value if successful. On errors, it will
throw an exception.
=item $url = $signer->signed_url($request)
This method will generate a signed GET URL for the request. The URL
will include everything needed to perform the request.
=back
=cut
sub sign {
my $self = shift;
my ($request,$region,$payload_sha256_hex) = @_;
$self->_add_date_header($request);
$self->_sign($request,$region,$payload_sha256_hex);
}
=item my $url $signer->signed_url($request_or_uri [,$expires])
Pass an HTTP::Request, a URI object, or just a plain URL string
containing the proper endpoint and parameters needed for an AWS REST
API Call. This method will return an appropriately signed request as a
URI object, which can be shared with non-AWS users for the purpose of,
e.g., accessing an object in a private S3 bucket.
Pass an optional $expires argument to indicate that the URL will only
be valid for a finite period of time. The value of the argument is in
seconds.
=cut
sub signed_url {
my $self = shift;
my ($arg1,$expires) = @_;
my ($request,$uri);
if (ref $arg1 && UNIVERSAL::isa($arg1,'HTTP::Request')) {
$request = $arg1;
$uri = $request->uri;
my $content = $request->content;
$uri->query($content) if $content;
if (my $date = $request->header('X-Amz-Date') || $request->header('Date')) {
$uri->query_param('Date'=>$date);
}
}
$uri ||= URI->new($arg1);
my $date = $uri->query_param_delete('Date') || $uri->query_param_delete('X-Amz-Date');
$request = HTTP::Request->new(GET=>$uri);
$request->header('Date'=> $date);
$uri = $request->uri; # because HTTP::Request->new() copies the uri!
return $uri if $uri->query_param('X-Amz-Signature');
my $scope = $self->_scope($request);
$uri->query_param('X-Amz-Algorithm' => $self->_algorithm);
$uri->query_param('X-Amz-Credential' => $self->access_key . '/' . $scope);
$uri->query_param('X-Amz-Date' => $self->_datetime($request));
$uri->query_param('X-Amz-Expires' => $expires) if $expires;
$uri->query_param('X-Amz-SignedHeaders' => 'host');
# If there was a security token passed, we need to supply it as part of the authorization
# because AWS requires it to validate IAM Role temporary credentials.
if (defined($self->{security_token})) {
$uri->query_param('X-Amz-Security-Token' => $self->{security_token});
}
# Since we're providing auth via query parameters, we need to include UNSIGNED-PAYLOAD
# http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html
# it seems to only be needed for S3.
if ($scope =~ /\/s3\/aws4_request$/) {
$self->_sign($request, undef, 'UNSIGNED-PAYLOAD');
} else {
$self->_sign($request);
}
my ($algorithm,$credential,$signedheaders,$signature) =
$request->header('Authorization') =~ /^(\S+) Credential=(\S+), SignedHeaders=(\S+), Signature=(\S+)/;
$uri->query_param_append('X-Amz-Signature' => $signature);
return $uri;
}
sub _add_date_header {
my $self = shift;
my $request = shift;
my $datetime;
unless ($datetime = $request->header('x-amz-date')) {
$datetime = $self->_zulu_time($request);
$request->header('x-amz-date'=>$datetime);
}
}
sub _scope {
my $self = shift;
my ($request,$region) = @_;
my $host = $request->uri->host;
my $datetime = $self->_datetime($request);
my ($date) = $datetime =~ /^(\d+)T/;
my $service;
if ($host =~ /^([\w.-]+)\.s3\.amazonaws.com/) { # S3 bucket virtual host
$service = 's3';
$region ||= 'us-east-1';
} elsif ($host =~ /^[\w-]+\.s3-([\w-]+)\.amazonaws\.com/) {
$service = 's3';
$region ||= $2;
} elsif ($host =~ /^(\w+)[-.]([\w-]+)\.amazonaws\.com/) {
lib/AWS/Signature4.pm view on Meta::CPAN
$region ||= $2;
} elsif ($host =~ /^([\w-]+)\.amazonaws\.com/) {
$service = $1;
$region = 'us-east-1';
}
$service ||= 's3';
$region ||= 'us-east-1'; # default
return "$date/$region/$service/aws4_request";
}
sub _parse_scope {
my $self = shift;
my $scope = shift;
return split '/',$scope;
}
sub _datetime {
my $self = shift;
my $request = shift;
return $request->header('x-amz-date') || $self->_zulu_time($request);
}
sub _algorithm { return 'AWS4-HMAC-SHA256' }
sub _sign {
my $self = shift;
my ($request,$region,$payload_sha256_hex) = @_;
return if $request->header('Authorization'); # don't overwrite
my $datetime = $self->_datetime($request);
unless ($request->header('host')) {
my $host = $request->uri->host;
$request->header(host=>$host);
}
my $scope = $self->_scope($request,$region);
my ($date,$service);
($date,$region,$service) = $self->_parse_scope($scope);
my $secret_key = $self->secret_key;
my $access_key = $self->access_key;
my $algorithm = $self->_algorithm;
my ($hashed_request,$signed_headers) = $self->_hash_canonical_request($request,$payload_sha256_hex);
my $string_to_sign = $self->_string_to_sign($datetime,$scope,$hashed_request);
my $signature = $self->_calculate_signature($secret_key,$service,$region,$date,$string_to_sign);
$request->header(Authorization => "$algorithm Credential=$access_key/$scope, SignedHeaders=$signed_headers, Signature=$signature");
}
sub _zulu_time {
my $self = shift;
my $request = shift;
my $date = $request->header('Date');
my @datetime = $date ? gmtime(str2time($date)) : gmtime();
return strftime('%Y%m%dT%H%M%SZ',@datetime);
}
sub _hash_canonical_request {
my $self = shift;
my ($request,$hashed_payload) = @_; # (HTTP::Request,sha256_hex($content))
my $method = $request->method;
my $uri = $request->uri;
my $path = $uri->path || '/';
my @params = $uri->query_form;
my $headers = $request->headers;
$hashed_payload ||= sha256_hex($request->content);
# canonicalize query string
my %canonical;
while (my ($key,$value) = splice(@params,0,2)) {
$key = uri_escape($key);
$value = uri_escape($value);
push @{$canonical{$key}},$value;
}
my $canonical_query_string = join '&',map {my $key = $_; map {"$key=$_"} sort @{$canonical{$key}}} sort keys %canonical;
# canonicalize the request headers
my (@canonical,%signed_fields);
for my $header (sort map {lc} $headers->header_field_names) {
next if $header =~ /^date$/i;
my @values = $headers->header($header);
# remove redundant whitespace
foreach (@values ) {
next if /^".+"$/;
s/^\s+//;
s/\s+$//;
s/(\s)\s+/$1/g;
}
push @canonical,"$header:".join(',',@values);
$signed_fields{$header}++;
}
my $canonical_headers = join "\n",@canonical;
$canonical_headers .= "\n";
my $signed_headers = join ';',sort map {lc} keys %signed_fields;
my $canonical_request = join("\n",$method,$path,$canonical_query_string,
$canonical_headers,$signed_headers,$hashed_payload);
my $request_digest = sha256_hex($canonical_request);
return ($request_digest,$signed_headers);
}
sub _string_to_sign {
my $self = shift;
my ($datetime,$credential_scope,$hashed_request) = @_;
return join("\n",'AWS4-HMAC-SHA256',$datetime,$credential_scope,$hashed_request);
}
=item $signing_key = AWS::Signature4->signing_key($secret_access_key,$service_name,$region,$date)
Return just the signing key in the event you wish to roll your own signature.
=cut
sub signing_key {
my $self = shift;
my ($kSecret,$service,$region,$date) = @_;
my $kDate = hmac_sha256($date,'AWS4'.$kSecret);
my $kRegion = hmac_sha256($region,$kDate);
Acme-AsciiArtFarts
view release on metacpan or search on metacpan
lib/Acme/AsciiArtFarts.pm view on Meta::CPAN
package Acme::AsciiArtFarts;
use warnings;
use strict;
use LWP;
=head1 NAME
Acme::AsciiArtFarts - Simple Object Interface to AsciiArtFarts
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.03';
=head1 SYNOPSIS
This package provides a simple object orientated interface to AsciiArtFarts - a
website focussed on Ascii Art humour.
use Acme::AsciiArtFarts;
my $aaf = Acme::AsciiArtFarts->new();
my $current = $aaf->current();
print $current;
=head1 METHODS
=head2 new
Constructor - creates a new Acme:AsciiArtFarts object. This method takes no arguments.
=cut
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
$self->{ua} = LWP::UserAgent->new();
$self->{uri} = 'http://www.asciiartfarts.com';
$self->{req} = HTTP::Request->new(GET => $self->{uri});
$self->__get_keywords;
$self->{cur_key}= '';
$self->{cur_num}= 0;
$self->{key_arr}= ();
return $self
}
=head2 current
print $aaf->current();
Returns the current strip.
=cut
sub current {
return $_[0]->__request('/today.txt')
}
=head2 random
print $aaf->random();
Returns a random strip.
=cut
sub random {
return __parse($_[0]->__request('/random.cgi'));
}
=head2 list_keywords
print join " ", $aaf->list_keywords();
Returns a list of all keywords by which strips are sorted.
=cut
sub list_keywords {
return sort keys %{$_[0]->{keywords}}
}
=head2 list_by_keyword
my @art = $aaf->list_by_keyword('matrix');
Returns a list of strip numbers for the given keyword.
=cut
sub list_by_keyword {
my ($self,$keyword)= @_;
exists $self->{keywords}->{$keyword} or return 0;
return @{$self->{keywords}{$keyword}{strips}};
}
=head2 get_by_num
print $aaf->get_by_num($art[0]);
Acme-CPANAuthors-Russian
view release on metacpan or search on metacpan
script/cpan-author.pl view on Meta::CPAN
grep { $_->{'pause'} !~ /^(KORSHAK|AGNISLAV|ZERO|ZWON|SODASODA|CUB|DZHARIY|IHEFFNER|QUEVLAR|VTI|GUGU|EJS|GRUBER|EGORSH|MVUETS|BEROV|CYBER|NIKIP|TTOD|OMEGA|DRINCHEV|YAKWOO|PLCGI|MADZ|VMS|SHTATLAND|IVAN|ILYA|GREGORY|ERIC|DIMRUB|ANDREI|AXS|MOO|ICHLADI...
grep { $_->{'email'} !~ /ua$/ }
grep { $_->{'email'} !~ /bg$/ }
grep { $_->{'email'} !~ /by$/ }
grep { $_->{'email'} !~ /ws$/ }
grep { $_->{'email'} !~ /cz$/ }
# ua
# grep { $_->{'pause'} =~ /^ZERO|CUB|VTI|GUGU|EJS|GRUBER|MVUETS|DARKNOS|DZHARIY$/ || $_->{'email'} =~ /ua$/ }
# cyrillic
grep {
my $name = $_->{'name'};
scalar grep { $name =~ /$_/ } @$NAME;
}
# no
# grep { $_->{pause} !~ /^BDULFER$/ }
# grep { $_->{pause} =~ /^KIRILLM|KJETIL|SJN|MRAMBERG|KRN|ANDREMAR|TRONDMM|ARNE|EIDOLON|NICOMEN|COSIMO|AFF|ESPIZO$/ || $_->{'email'} =~ /no$/ }
map {
my($url, $name ) = $_->[ 1] =~ /<a href="([^"]+)">([^<]+)/; $name ||= $_->[ 1]; $name =~ s/\s+$//; $name =~ s/&[^;]+;//sg;
my($url2, $pause) = $_->[-1] =~ /<a href="([^"]+)">([^<]+)/; $pause ||= $_->[-1];
+{
'id' => $_->[0],
'name' => $name,
'url' => $url,
'email' => $_->[2],
'pause' => $pause,
'author' => $url2 ? 1 : 0,
};
}
map {
[m{^ (\d+)\. \s ([^<]+ | <a.*?/a> | \s) .*? <a \s href="mailto:([^"]*)" .* -- \s+ (.*) $}x]
}
map { split m{\s*<br />\s*} }
grep { utf8::decode($_);1 }
do { local $/; open my $fh, '<', 'get_utf8.html'; <$fh> } =~ m{Archives</a></h3>(.*)<h3><a id="mailinglists"}s
# map { $_->is_success ? $_->content =~ m{Archives</a></h3>(.*)<h3><a id="mailinglists"}s : () }
# LWPUserAgent->new('timeout' => 15)->get('http://pause.perl.org/pause/query?ACTION=who_is')
]
;
package LWPUserAgent; # XXX: bad UTF-8 encoding
use strict;
use base 'LWP::UserAgent';
use constant {
FILE => '~get.html',
EXP => 24*60*60, # 1 day
};
sub get {
my $self = shift;
unlink FILE if -e FILE && time - [stat(FILE)]->[9] > EXP;
if (my $data = eval { local $/; open my $fh, '<', FILE or die $!; <$fh> }) {
warn 'cache';
$_->request(HTTP::Request->new('GET', shift)), return $_ for HTTP::Response->new(200, 'OK', undef, $data);
}
for ($self->SUPER::get(@_)) {
open my $fh, '>', FILE or die $!;
print $fh $_->content;
return $_;
}
}
1;
__END__
=head1 NAME
cpan-author.pl - try to find Russian CPAN authors
=head1 SYNOPSIS
./cpan-author.pl
=head1 DESCRIPTION
You can use this to find Russian CPAN authors or Russian PAUSE id accounts.
This script fetches data from L<http://pause.perl.org/pause/query?ACTION=who_is>.
See source code :)
=head1 AUTHOR
Anatoly Sharifulin, E<lt>sharifulin at gmail.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 by Anatoly Sharifulin.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
Acme-CPANLists-Import-PerlDancerAdvent-2014
view release on metacpan or search on metacpan
lib/Acme/CPANLists/Import/PerlDancerAdvent/2014.pm view on Meta::CPAN
package Acme::CPANLists::Import::PerlDancerAdvent::2014;
our $DATE = '2016-11-19'; # DATE
our $VERSION = '0.002'; # VERSION
our @Module_Lists = ({description=>"This list is generated by extracting module names mentioned in [http://advent.perldancer.org/2014/] (retrieved on 2016-11-18). Visit the URL for the full contents.",entries=>[{module=>"DBIx::Class"},{module=>"Dance...
1;
# ABSTRACT: Modules mentioned in PerlDancer Advent Calendar 2014
__END__
=pod
=encoding UTF-8
=head1 NAME
Acme::CPANLists::Import::PerlDancerAdvent::2014 - Modules mentioned in PerlDancer Advent Calendar 2014
=head1 VERSION
This document describes version 0.002 of Acme::CPANLists::Import::PerlDancerAdvent::2014 (from Perl distribution Acme-CPANLists-Import-PerlDancerAdvent-2014), released on 2016-11-19.
=head1 DESCRIPTION
This module is generated by extracting module names mentioned in L<http://advent.perldancer.org/2014/> (retrieved on 2016-11-18). Visit the URL for the full contents.
=head1 MODULE LISTS
=head2 Modules mentioned in PerlDancer Advent Calendar 2014
This list is generated by extracting module names mentioned in [http://advent.perldancer.org/2014/] (retrieved on 2016-11-18). Visit the URL for the full contents.
=over
=item * L<DBIx::Class>
=item * L<Dancer>
=item * L<Dancer2>
=item * L<Amon2>
=item * L<App::Cmd>
=item * L<HTTP::Server::PSGI>
=item * L<Moo>
=item * L<Moose>
=item * L<Plack>
=item * L<Carton>
=item * L<HTTP::Server::Simple>
=item * L<Pinto>
=item * L<Plack::Builder>
=item * L<local::lib>
=item * L<App::FatPacker>
=item * L<MIME::Types>
=item * L<PSGI>
=item * L<Dancer2::Handler::AutoPage>
=item * L<Dancer2::Handler::File>
=item * L<Plack::Middleware::Static>
=item * L<File::Spec>
=item * L<HTTP::Tiny>
=item * L<JSON>
=item * L<Template>
=item * L<Dancer2::Core::App>
=item * L<Dancer2::Core::Dispatcher>
=item * L<Plack::App::URLMap>
=item * L<Dancer2::Serializer::CBOR>
=item * L<Dancer2::Test>
=item * L<Dancer::Test>
=item * L<HTTP::Cookies>
=item * L<HTTP::Request>
=item * L<HTTP::Response>
=item * L<LWP>
=item * L<LWP::Protocol::PSGI>
=item * L<LWP::UserAgent>
=item * L<Plack::Test>
=item * L<Test::More>
=item * L<Test::WWW::Mechanize>
=item * L<Test::WWW::Mechanize::PSGI>
=item * L<WWW::Mechanize>
=item * L<Dancer2::Core::Factory>
=item * L<Dancer2::Plugin>
=item * L<Dancer2::Plugin::Auth::Tiny>
=item * L<Dancer2::Plugin::Database>
=item * L<Dancer2::Plugin::Auth::Extensible>
=item * L<Dancer2::Plugin::Passphrase>
=item * L<Digest>
=item * L<Plack::Middleware>
=item * L<Plack::Middleware::ContentLength>
=item * L<Plack::Middleware::FixMissingBodyInRedirect>
=item * L<Plack::Middleware::Head>
=item * L<Plack::Middleware::RemoveRedundantBody>
=item * L<Plack::Util>
=back
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/Acme-CPANLists-Import-PerlDancerAdvent-2014>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-Acme-CPANLists-Import-PerlDancerAdvent-2014>.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Acme-CPANLists-Import-PerlDancerAdvent-2014>
When submitting a bug or request, please include a test-file or a
Acme-CPANModulesBundle-Import-PerlDancerAdvent-2014
view release on metacpan or search on metacpan
lib/Acme/CPANModules/Import/PerlDancerAdvent/2014.pm view on Meta::CPAN
# This file was first automatically generated by gen-acme-cpanmodules-module-from-acme-cpanlists-list on Sat Sep 22 08:02:21 2018 from module list in Acme::CPANLists::Import::PerlDancerAdvent::2014 version 0.002.
package Acme::CPANModules::Import::PerlDancerAdvent::2014;
our $DATE = '2018-09-22'; # DATE
our $VERSION = '0.001'; # VERSION
our $LIST = {
description => "This list is generated by extracting module names mentioned in [http://advent.perldancer.org/2014/] (retrieved on 2016-11-18). Visit the URL for the full contents.",
entries => [
{ module => "DBIx::Class" },
{ module => "Dancer" },
{ module => "Dancer2" },
{ module => "Amon2" },
{ module => "App::Cmd" },
{ module => "HTTP::Server::PSGI" },
{ module => "Moo" },
{ module => "Moose" },
{ module => "Plack" },
{ module => "Carton" },
{ module => "HTTP::Server::Simple" },
{ module => "Pinto" },
{ module => "Plack::Builder" },
{ module => "local::lib" },
{ module => "App::FatPacker" },
{ module => "MIME::Types" },
{ module => "PSGI" },
{ module => "Dancer2::Handler::AutoPage" },
{ module => "Dancer2::Handler::File" },
{ module => "Plack::Middleware::Static" },
{ module => "File::Spec" },
{ module => "HTTP::Tiny" },
{ module => "JSON" },
{ module => "Template" },
{ module => "Dancer2::Core::App" },
{ module => "Dancer2::Core::Dispatcher" },
{ module => "Plack::App::URLMap" },
{ module => "Dancer2::Serializer::CBOR" },
{ module => "Dancer2::Test" },
{ module => "Dancer::Test" },
{ module => "HTTP::Cookies" },
{ module => "HTTP::Request" },
{ module => "HTTP::Response" },
{ module => "LWP" },
{ module => "LWP::Protocol::PSGI" },
{ module => "LWP::UserAgent" },
{ module => "Plack::Test" },
{ module => "Test::More" },
{ module => "Test::WWW::Mechanize" },
{ module => "Test::WWW::Mechanize::PSGI" },
{ module => "WWW::Mechanize" },
{ module => "Dancer2::Core::Factory" },
{ module => "Dancer2::Plugin" },
{ module => "Dancer2::Plugin::Auth::Tiny" },
{ module => "Dancer2::Plugin::Database" },
{ module => "Dancer2::Plugin::Auth::Extensible" },
{ module => "Dancer2::Plugin::Passphrase" },
{ module => "Digest" },
{ module => "Plack::Middleware" },
{ module => "Plack::Middleware::ContentLength" },
{ module => "Plack::Middleware::FixMissingBodyInRedirect" },
{ module => "Plack::Middleware::Head" },
{ module => "Plack::Middleware::RemoveRedundantBody" },
{ module => "Plack::Util" },
],
summary => "Modules mentioned in PerlDancer Advent Calendar 2014",
};
1;
# ABSTRACT: Modules mentioned in PerlDancer Advent Calendar 2014
__END__
=pod
=encoding UTF-8
=head1 NAME
Acme::CPANModules::Import::PerlDancerAdvent::2014 - Modules mentioned in PerlDancer Advent Calendar 2014
=head1 VERSION
This document describes version 0.001 of Acme::CPANModules::Import::PerlDancerAdvent::2014 (from Perl distribution Acme-CPANModulesBundle-Import-PerlDancerAdvent-2014), released on 2018-09-22.
=head1 DESCRIPTION
Modules mentioned in PerlDancer Advent Calendar 2014.
This list is generated by extracting module names mentioned in [http://advent.perldancer.org/2014/] (retrieved on 2016-11-18). Visit the URL for the full contents.
=head1 INCLUDED MODULES
=over
=item * L<DBIx::Class>
=item * L<Dancer>
=item * L<Dancer2>
=item * L<Amon2>
=item * L<App::Cmd>
=item * L<HTTP::Server::PSGI>
=item * L<Moo>
=item * L<Moose>
=item * L<Plack>
=item * L<Carton>
=item * L<HTTP::Server::Simple>
=item * L<Pinto>
=item * L<Plack::Builder>
=item * L<local::lib>
=item * L<App::FatPacker>
=item * L<MIME::Types>
=item * L<PSGI>
=item * L<Dancer2::Handler::AutoPage>
=item * L<Dancer2::Handler::File>
=item * L<Plack::Middleware::Static>
=item * L<File::Spec>
=item * L<HTTP::Tiny>
=item * L<JSON>
=item * L<Template>
=item * L<Dancer2::Core::App>
=item * L<Dancer2::Core::Dispatcher>
=item * L<Plack::App::URLMap>
=item * L<Dancer2::Serializer::CBOR>
=item * L<Dancer2::Test>
=item * L<Dancer::Test>
=item * L<HTTP::Cookies>
=item * L<HTTP::Request>
=item * L<HTTP::Response>
=item * L<LWP>
=item * L<LWP::Protocol::PSGI>
=item * L<LWP::UserAgent>
=item * L<Plack::Test>
=item * L<Test::More>
=item * L<Test::WWW::Mechanize>
=item * L<Test::WWW::Mechanize::PSGI>
=item * L<WWW::Mechanize>
=item * L<Dancer2::Core::Factory>
=item * L<Dancer2::Plugin>
=item * L<Dancer2::Plugin::Auth::Tiny>
=item * L<Dancer2::Plugin::Database>
=item * L<Dancer2::Plugin::Auth::Extensible>
=item * L<Dancer2::Plugin::Passphrase>
=item * L<Digest>
=item * L<Plack::Middleware>
=item * L<Plack::Middleware::ContentLength>
=item * L<Plack::Middleware::FixMissingBodyInRedirect>
=item * L<Plack::Middleware::Head>
=item * L<Plack::Middleware::RemoveRedundantBody>
=item * L<Plack::Util>
=back
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/Acme-CPANModulesBundle-Import-PerlDancerAdvent-2014>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-Acme-CPANModulesBundle-Import-PerlDancerAdvent-2014>.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Acme-CPANModulesBundle-Import-PerlDancerAdvent-2014>
When submitting a bug or request, please include a test-file or a
( run in 1.108 second using v1.01-cache-2.11-cpan-de7293f3b23 )