Result:
found more than 436 distributions - search limited to the first 2001 files matching your query
( run in 0.492 )
API-ISPManager
view release on metacpan or search on metacpan
add_database.pl view on Meta::CPAN
use Data::Dumper;
use API::ISPManager;
#
# Script for add databases account to certain user account in ISPManager
#
die "Params required: host / username / password / db_name / db_user / db_password\n" unless scalar @ARGV == 6;
my $host = $ARGV[0];
API-Instagram
view release on metacpan or search on metacpan
lib/API/Instagram.pm view on Meta::CPAN
my @access_token_fields = qw(client_id redirect_uri grant_type client_secret code);
for ( @access_token_fields ) {
carp "ERROR: $_ required for generating access token." and return unless defined $self->$_;
}
my $data = { map { $_ => $self->$_ } @access_token_fields };
my $json = $self->_request( 'post', $self->_access_token_url, $data, { token_not_required => 1 } );
wantarray ? ( $json->{access_token}, $self->user( $json->{user} ) ) : $json->{access_token};
}
lib/API/Instagram.pm view on Meta::CPAN
# Returns cached wanted object or creates a new one #
#####################################################
sub _get_obj {
my ( $self, $type, $key, $code, $optional_code ) = @_;
my $data = { $key => $code };
$data = $code if ref $code eq 'HASH';
$code = $data->{$key};
# Returns if CODE is not optional and not defined or if it's not a string
return if (!$optional_code and !defined $code) or ref $code;
# Code used as cache key
my $cache_code = md5_hex( $code // $data);
# Returns cached value or creates a new object
my $return = $self->_cache($type)->{$cache_code} //= ("API::Instagram::$type")->new( $data );
# Deletes cache if no-cache is set
delete $self->_cache($type)->{$cache_code} if $self->no_cache;
return $return;
lib/API/Instagram.pm view on Meta::CPAN
my $count = $params->{count} // 999_999_999;
$count = 999_999_999 if $count < 0;
$params->{count} = $count;
my $request = $self->_request( 'get', $url, $params, $opts );
my $data = $request->{data};
# Keeps requesting if total items is less than requested
# and still there is pagination
while ( my $pagination = $request->{pagination} ){
last if @$data >= $count;
last unless $pagination->{next_url};
$opts->{prepared_url} = 1;
$request = $self->_request( 'get', $pagination->{next_url}, $params, $opts );
push @$data, @{ $request->{data} };
}
return @$data;
}
##############################################################
# Requests the data from the given URL with QUERY parameters #
##############################################################
sub _request {
my ( $self, $method, $url, $params, $opts ) = @_;
# Verifies access requirements
lib/API/Instagram.pm view on Meta::CPAN
use Data::Dumper;
# die Dumper $res;
$res;
}
sub _request_data { shift->_request(@_)->{data} || {} }
sub _del { shift->_request_data( 'delete', @_ ) }
sub _get { shift->_request_data( 'get', @_ ) }
sub _post { shift->_request_data( 'post', @_ ) }
################################
# Returns requested cache hash #
################################
sub _cache { shift->_obj_cache->{ shift() } }
API-Intis
view release on metacpan or search on metacpan
API/Intis/README.mkdn view on Meta::CPAN
* sending SMS messages (including scheduling options);
* receiving status reports about messages that have been sent previously;
* requesting lists of authorised sender names;
* requesting lists of incoming SMS messages;
* requesting current balance status;
* requesting lists of databases;
* requesting lists of numbers within particular contact list;
* searching for a particular number in a stop list;
* adding new templates;
* requesting monthly statistics;
* making HLR request;
API-MailboxOrg
view release on metacpan or search on metacpan
lib/API/MailboxOrg/APIBase.pm view on Meta::CPAN
has json_rpc => ( is => 'ro', isa => Str, default => sub { '2.0' } );
state $request_id = 1;
sub _request ( $self, $method, $params = {}, $opts = {} ) {
my $rpc_data = {
jsonrpc => $self->json_rpc,
id => $request_id++,
method => $method,
};
$rpc_data->{params} = $params->%* ? $params : "";
my $api = $self->api;
if ( $opts->{needs_auth} && !$api->token ) {
my $auth_result = $api->base->auth(
lib/API/MailboxOrg/APIBase.pm view on Meta::CPAN
$api->base_uri;
my $tx = $api->client->post(
$uri,
\%header,
json => $rpc_data,
);
my $response = $tx->res;
if ( $tx->error ) {
carp $tx->error->{message};
return;
}
my $data = $response->json;
if ( $data->{error} ) {
carp $data->{error}->{message};
return;
}
return $data->{result};
}
1;
__END__
API-Mathpix
view release on metacpan or search on metacpan
lib/API/Mathpix.pm view on Meta::CPAN
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);
lib/API/Mathpix.pm view on Meta::CPAN
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;
}
API-Medium
view release on metacpan or search on metacpan
lib/API/Medium.pm view on Meta::CPAN
sub get_current_user {
my $self = shift;
my $res = $self->_request( 'GET', 'me' );
return $res->{data};
}
sub create_post {
my ( $self, $user_id, $post ) = @_;
$post->{publishStatus} ||= 'draft';
my $res = $self->_request( 'POST', 'users/' . $user_id . '/posts', $post );
return $res->{data}{url};
}
sub create_publication_post {
my ( $self, $publication_id, $post ) = @_;
$post->{publishStatus} ||= 'draft';
my $res =
$self->_request( 'POST', 'publications/' . $publication_id . '/posts',
$post );
return $res->{data}{url};
}
sub _request {
my ( $self, $method, $endpoint, $data ) = @_;
my $url = join( '/', $self->server, $endpoint );
my $res;
if ($data) {
$res = $self->_client->request( $method, $url,
{ content => encode_json($data) } );
}
else {
$res = $self->_client->request( $method, $url );
}
if ( $res->{success} ) {
lib/API/Medium.pm view on Meta::CPAN
=head1 DESCRIPTION
It's probably a good idea to read L<the Medium API
docs|https://github.com/Medium/medium-api-docs> first, especially as
the various data structures you have to send (or might get back) are
B<not> documented here.
See F<example/hello_medium.pl> for a complete script.
=head2 Authentication
lib/API/Medium.pm view on Meta::CPAN
above on how to get it. Please make sure no not leak your Integration
Token. If you do, anybody who has it can take over your Medium page!
=head2 get_current_user
my $data = $m->get_current_user;
Fetch the User "object".
You will need this to get the user C<id> for posting. Depending on
your app you might want to store your C<id> in some config file to
lib/API/Medium.pm view on Meta::CPAN
/publications/{{publicationId}}/contributors
=head2 create_post
my $url = $m->create_post( $user_id, $post_data );
Create a new post. If you pass in bad data, Medium will probably
report an error.
C<publishStatus> is set to 'draft' unless you pass in another value.
=head2 create_publication_post
my $url = $m->create_publication_post( $publication_id, $post_data );
Create a new post under a publication. You will need to figure out the
publication_id by calling the API from the commandline (until
C<publications> is implemented.)
If you pass in bad data, Medium will probably report an error.
C<publishStatus> is set to 'draft' unless you pass in another value.
=head2 TODO
API-MikroTik
view release on metacpan or search on metacpan
lib/API/MikroTik.pm view on Meta::CPAN
sub _finish {
my ($self, $r, $err) = @_;
delete $self->{requests}{$r->{tag}};
if (my $timer = $r->{timeout}) { $r->{loop}->remove($timer) }
$r->{cb}->($self, ($self->{error} = $err // ''), $r->{data});
}
sub _login {
my ($self, $loop, $cb) = @_;
warn "-- trying to log in\n" if DEBUG;
lib/API/MikroTik.pm view on Meta::CPAN
my ($self, $loop, $bytes) = @_;
warn "-- read bytes from socket: " . (length $bytes) . "\n" if DEBUG;
my $response = $self->{responses}{$loop} ||= API::MikroTik::Response->new();
my $data = $response->parse(\$bytes);
for (@$data) {
next unless my $r = $self->{requests}{delete $_->{'.tag'}};
my $type = delete $_->{'.type'};
push @{$r->{data} ||= Mojo::Collection->new()}, $_
if %$_ && !$r->{subscription};
if ($type eq '!re' && $r->{subscription}) {
$r->{cb}->($self, '', $_);
}
elsif ($type eq '!done') {
$r->{data} ||= Mojo::Collection->new();
$self->_finish($r);
}
elsif ($type eq '!trap' || $type eq '!fatal') {
$self->_fail($r, $_->{message});
API-Name
view release on metacpan or search on metacpan
lib/API/Name.pm view on Meta::CPAN
$name->action('patch', %args); # PATCH request
The action method issues a request to the API resource represented by the
object. The first parameter will be used as the HTTP request method. The
arguments, expected to be a list of key/value pairs, will be included in the
request if the key is either C<data> or C<query>.
=head2 create
my $results = $name->create(%args);
lib/API/Name.pm view on Meta::CPAN
$name->POST(%args);
The create method issues a C<POST> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 delete
my $results = $name->delete(%args);
lib/API/Name.pm view on Meta::CPAN
$name->DELETE(%args);
The delete method issues a C<DELETE> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 fetch
my $results = $name->fetch(%args);
lib/API/Name.pm view on Meta::CPAN
$name->GET(%args);
The fetch method issues a C<GET> request to the API resource represented by the
object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 update
my $results = $name->update(%args);
lib/API/Name.pm view on Meta::CPAN
$name->PUT(%args);
The update method issues a C<PUT> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head1 RESOURCES
=head2 account
API-Octopart
view release on metacpan or search on metacpan
lib/API/Octopart.pm view on Meta::CPAN
{
die "invalid filter option: '$o'" if (!$_valid_filter_opts{$o});
}
my @results;
foreach my $r (@{ $resp->{data}{search}{results} })
{
$r = $r->{part};
my %part;
$part{mfg} = $r->{manufacturer}{name};
API-ParallelsWPB
view release on metacpan or search on metacpan
lib/API/ParallelsWPB.pm view on Meta::CPAN
# "free" request. Basic method for requests
sub f_request {
my ( $self, $url_array, $data ) = @_;
confess "$url_array is not array!" unless ( ref $url_array eq 'ARRAY' );
$data->{req_type} ||= 'GET';
$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} );
lib/API/ParallelsWPB.pm view on Meta::CPAN
Connection timeout. Optional parameter.
=back
=head2 B<f_request($self, $url_array_ref, $data)>
"Free" request. Now for internal usage only.
$data:
req_type : HTTP request type: get, post, put, delete. GET by default.
post_data: data for POST request. Must be hashref.
=head1 SEE ALSO
L<Parallels Presence Builder Guide|http://download1.parallels.com/WPB/Doc/11.5/en-US/online/presence-builder-standalone-installation-administration-guide>
API-Plesk
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
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']],
lib/API/Plesk.pm view on Meta::CPAN
return bless $self, $class;
}
# sends request to Plesk API
sub send {
my ( $self, $operator, $operation, $data, %params ) = @_;
confess "Wrong request data!" unless $data && ref $data;
my $xml = { $operator => { $operation => $data } };
$xml = $self->render_xml($xml);
warn "REQUEST $operator => $operation\n$xml" if $self->{debug};
lib/API/Plesk.pm view on Meta::CPAN
);
my $res = $api->customer->get();
if ($res->is_success) {
for ( @{$res->data} ) {
print "login: $_->{login}\n";
}
}
else {
print $res->error;
lib/API/Plesk.pm view on Meta::CPAN
Additional params:
api_version - default 1.6.3.1
debug - default 0
timeout - default 30 sec.
=item send($operator, $operation, $data, %params)
This method prepare and sends request to Plesk API.
Returns API::Plesk::Response object.
$operator - name of operator XML section of Plesk API.
$operation - mane of operation XML section of Plesk API.
$data - data hash that is converted to XML and is sended to plesk server.
=item xml_http_req( $xml )
Internal method. it implements real request sending to Plesk API.
API-PleskExpand
view release on metacpan or search on metacpan
lib/API/PleskExpand.pm view on Meta::CPAN
my $expand_client = API::PleskExpand->new(%params);
my $res = $expand_client->Func_Module->operation_type(%params);
if ($res->is_success) {
$res->get_data; # return arr ref of answer blocks
}
=head1 DESCRIPTION
At present the module provides interaction with Plesk Expand 2.2.4 (API 2.2.4.1). Complete support of operations with Accounts, partial support of work with domains. Support of addition of domains to user Accounts.
API-PureStorage
view release on metacpan or search on metacpan
lib/API/PureStorage.pm view on Meta::CPAN
}
sub _api_post {
my $self = shift @_;
my $url = shift @_;
my $data = shift @_;
my $ret = $self->{client}->POST($url, to_json($data));
my $num = $ret->responseCode();
my $con = $ret->responseContent();
if ( $num == 500 ) {
die "API returned error 500 for '$url' - $con\n";
}
lib/API/PureStorage.pm view on Meta::CPAN
my $volume_info_ref = $pure->volume_info()
Returns a hash or hasref (depending on requested context) of general array
information, including space usage.
=head3 Hash data reference:
* hostname - the configured hostname of the system
* total_reduction - The current overall data reduction multiple of the array. IE: A "2" here means "2:1" reduction.
* data_reduction - The reduction multiple of just data partitions.
Array-wide space usage info:
* volumes - bytes in use by active volume data
* shared_space - bytes recognized in use between multiple copies, volumes, snapshots, etc
* snapshots - bytes in use by snapshots
* system - bytes in use by system overhead. This can include recently allocated bytes
that have yet to be accounted for in other categories. IE: a recently deleted volume
that has yet to garbage collect.
* total - a byte count of all data on the system.
* capacity - the total capacity of the array in bytes
* thin_provisioning - ?
lib/API/PureStorage.pm view on Meta::CPAN
Returns an array or arrayref of general information about volumes include space
usage.
Each element of the array is a hash reference, representing a single volume.
=head3 Hash data reference:
* name - the name of this volume
* data_reduction - Reduction multiple of the data on this volume
* total_reduction - overall reduction multiple of this volume
Volume space usage info:
lib/API/PureStorage.pm view on Meta::CPAN
* snapshots - bytes in use by snapshots
* system - bytes in use by system overhead
* total - a byte count of all data used by the the volume
* size - the max size of the volume
* thin_provisioning - ?
lib/API/PureStorage.pm view on Meta::CPAN
my $volume_detail_ref = $pure->volume_detail($volume_name);
Returns a hash or hasref (depending on requested context) of additional
information on the volumes now shown in the vol_info() summary.
=head3 Hash data reference:
* created - A time stamp from when the volume was created
* name - the name of the volume
* serial - the serial number of the volume
* size - Size of the volume in bytes
API-Stripe
view release on metacpan or search on metacpan
lib/API/Stripe.pm view on Meta::CPAN
$stripe->action('patch', %args); # PATCH request
The action method issues a request to the API resource represented by the
object. The first parameter will be used as the HTTP request method. The
arguments, expected to be a list of key/value pairs, will be included in the
request if the key is either C<data> or C<query>.
=head2 create
my $results = $stripe->create(%args);
lib/API/Stripe.pm view on Meta::CPAN
$stripe->POST(%args);
The create method issues a C<POST> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 delete
my $results = $stripe->delete(%args);
lib/API/Stripe.pm view on Meta::CPAN
$stripe->DELETE(%args);
The delete method issues a C<DELETE> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 fetch
my $results = $stripe->fetch(%args);
lib/API/Stripe.pm view on Meta::CPAN
$stripe->GET(%args);
The fetch method issues a C<GET> request to the API resource represented by the
object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 update
my $results = $stripe->update(%args);
lib/API/Stripe.pm view on Meta::CPAN
$stripe->PUT(%args);
The update method issues a C<PUT> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head1 RESOURCES
=head2 account
API-Trello
view release on metacpan or search on metacpan
lib/API/Trello.pm view on Meta::CPAN
$trello->action('patch', %args); # PATCH request
The action method issues a request to the API resource represented by the
object. The first parameter will be used as the HTTP request method. The
arguments, expected to be a list of key/value pairs, will be included in the
request if the key is either C<data> or C<query>.
=head2 create
my $results = $trello->create(%args);
lib/API/Trello.pm view on Meta::CPAN
$trello->POST(%args);
The create method issues a C<POST> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 delete
my $results = $trello->delete(%args);
lib/API/Trello.pm view on Meta::CPAN
$trello->DELETE(%args);
The delete method issues a C<DELETE> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 fetch
my $results = $trello->fetch(%args);
lib/API/Trello.pm view on Meta::CPAN
$trello->GET(%args);
The fetch method issues a C<GET> request to the API resource represented by the
object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 update
my $results = $trello->update(%args);
lib/API/Trello.pm view on Meta::CPAN
$trello->PUT(%args);
The update method issues a C<PUT> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head1 RESOURCES
=head2 actions
API-Twitter
view release on metacpan or search on metacpan
lib/API/Twitter.pm view on Meta::CPAN
$headers->header('Content-Type' => 'application/json');
# append path suffix
$url->path("@{[$url->path]}.json") if $url->path !~ /\.json$/;
# oauth data
my $consumer_key = $self->consumer_key;
my $consumer_secret = $self->consumer_secret;
my $access_token = $self->access_token;
my $access_token_secret = $self->access_token_secret;
lib/API/Twitter.pm view on Meta::CPAN
$twitter->action('patch', %args); # PATCH request
The action method issues a request to the API resource represented by the
object. The first parameter will be used as the HTTP request method. The
arguments, expected to be a list of key/value pairs, will be included in the
request if the key is either C<data> or C<query>.
=head2 create
my $results = $twitter->create(%args);
lib/API/Twitter.pm view on Meta::CPAN
$twitter->POST(%args);
The create method issues a C<POST> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 delete
my $results = $twitter->delete(%args);
lib/API/Twitter.pm view on Meta::CPAN
$twitter->DELETE(%args);
The delete method issues a C<DELETE> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 fetch
my $results = $twitter->fetch(%args);
lib/API/Twitter.pm view on Meta::CPAN
$twitter->GET(%args);
The fetch method issues a C<GET> request to the API resource represented by the
object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 update
my $results = $twitter->update(%args);
lib/API/Twitter.pm view on Meta::CPAN
$twitter->PUT(%args);
The update method issues a C<PUT> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head1 RESOURCES
=head2 account
API-Vultr
view release on metacpan or search on metacpan
lib/API/Vultr.pm view on Meta::CPAN
my $create_response = $vultr_api->create_instance(
region => 'ewr',
plan => 'vc2-6c-16gb',
label => 'My Instance',
os_id => 215,
user_data => 'QmFzZTY4EVsw32WfsGGHsjKJI',
backups => 'enabled',
hostname => 'hostname'
);
if ($create_response->is_success) {
API-Wunderlist
view release on metacpan or search on metacpan
lib/API/Wunderlist.pm view on Meta::CPAN
$wunderlist->action('patch', %args); # PATCH request
The action method issues a request to the API resource represented by the
object. The first parameter will be used as the HTTP request method. The
arguments, expected to be a list of key/value pairs, will be included in the
request if the key is either C<data> or C<query>.
=head2 create
my $results = $wunderlist->create(%args);
lib/API/Wunderlist.pm view on Meta::CPAN
$wunderlist->POST(%args);
The create method issues a C<POST> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 delete
my $results = $wunderlist->delete(%args);
lib/API/Wunderlist.pm view on Meta::CPAN
$wunderlist->DELETE(%args);
The delete method issues a C<DELETE> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 fetch
my $results = $wunderlist->fetch(%args);
lib/API/Wunderlist.pm view on Meta::CPAN
$wunderlist->GET(%args);
The fetch method issues a C<GET> request to the API resource represented by the
object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head2 update
my $results = $wunderlist->update(%args);
lib/API/Wunderlist.pm view on Meta::CPAN
$wunderlist->PUT(%args);
The update method issues a C<PUT> request to the API resource represented by
the object. The arguments, expected to be a list of key/value pairs, will be
included in the request if the key is either C<data> or C<query>.
=head1 RESOURCES
=head2 avatars
APISchema
view release on metacpan or search on metacpan
1.00 2015-08-27T10:48:03Z
- Support schema which contains unicode characters
- Enable `use utf8` in DSL file
0.03 2015-08-18T02:06:45Z
- Validation error has more details. expected: expected schema, actual: actual input data
0.02 2015-03-16T02:35:36Z
- Add a status_code parameter to P::MW::AS::RequestValidator
0.01 2015-02-18T10:41:05Z
APNS-Agent
view release on metacpan or search on metacpan
lib/APNS/Agent.pm view on Meta::CPAN
$self->_sending;
}
},
on_error_response => sub {
my ($identifier, $state) = @_;
my $data = $self->_sent_cache->get($identifier) || {};
$self->on_error_response->($self, {
identifier => $identifier,
state => $state,
token => $data->{token},
payload => $data->{payload},
});
},
($self->debug_port ? (debug_port => $self->debug_port) : ()),
);
}
APP-REST-RestTestSuite
view release on metacpan or search on metacpan
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
$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
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
414 : The URI has more than 2k characters.
415 : Representation not supported for the resource.
416 : Requested range not satisfiable.
500 : Internal server error.
501 : Requested HTTP operation not supported.
502 : Backend service failure (data store failure).
505 : HTTP version not supported.
############################
#END_HTTP_CODE_DEF
############################
APR-Emulate-PSGI
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
ARCv2
view release on metacpan or search on metacpan
lib/Arc/Connection.pm view on Meta::CPAN
}
}
## function for reading and writing on the command connection.
## This function is always used by the C<Arc::Connection::Server> to handle
## command data. When calling the C<ProcessCommand> from C<Arc::Connection::Client>
## this function is also used.
## Data is read from the local socket resp. pipe and is written encrypted
## to the network socket. The other side reads the data from network socket,
## decrypts it and writes it to its local socket. This function behaves differently on
## client and server sides, when the local or network socket is closed.
##in> *locfdin, *locfdout
##out> always true
##eg> $this->ReadWriteBinary(*STDIN,*STDOUT);
lib/Arc/Connection.pm view on Meta::CPAN
my $stop = 0;
while (my @rs = $sel->can_read) {
foreach my $r (@rs) {
# Something is readable.
my $ret = $r->sysread($buf,4096);
# If no data received, this read socket is closed
# We don't want to listen to it anymore
unless ($ret) {
$sel->remove($r);
# If there is nothing to read anymore
# we will never write to the other socket again.
lib/Arc/Connection.pm view on Meta::CPAN
$ret = $this->_SetError("Sending command $cmd failed.") unless $this->_SendLine($cmd,defined $msg ? " ".$msg : "");
return $ret;
}
## receive a line (command). (protocol)
## This function receives data from the ARCv2 connection and
## fills the internal C<__linequeue> and C<__partial>. It returns
## a line from the internal buffer if there is any. It also handles
## timeouts and "connection closed by foreign host"'s.
##out> true (and the line) if everything worked fine, otherwise false (undef)
##eg> if (my $line = $this->_RecvLine()) { ... }
lib/Arc/Connection.pm view on Meta::CPAN
my $partial = defined($this->{__partial}) ? $this->{__partial} : "";
my $buf = "";
until (scalar @{$this->{__linequeue}}) {
if ($this->{_select}->can_read($this->{timeout})) { # true if select thinks there is data
my $inbuf;
unless ($this->{_connection}->sysread($inbuf,4096)) {
$this->{_connected} = 0;
$this->{_connection}->close();
return $this->_SetError("Connection closed by foreign host.");
ARGV-JSON
view release on metacpan or search on metacpan
lib/ARGV/JSON.pm view on Meta::CPAN
perl -MARGV::JSON -anal -E 'say $_->{foo}->{bar}' a.json b.json
=head1 DESCRIPTION
ARGV::JSON parses each input from C<< @ARGV >> and enables to access
the JSON data structures via C<< <> >>.
Each C<< readline >> call to C<< <> >> (or C<< <ARGV> >>) returns a
hashref or arrayref or something that the input serializes in the
JSON format.
ARGV-OrDATA
view release on metacpan or search on metacpan
lib/ARGV/OrDATA.pm view on Meta::CPAN
undef *ORIG;
}
sub is_using_argv {
! is_using_data()
}
sub is_using_data {
my ($package) = caller;
$package = caller 1 if 'ARGV::OrDATA' eq $package;
return do {
no strict 'refs';
*ARGV eq *{$package . '::DATA' }
lib/ARGV/OrDATA.pm view on Meta::CPAN
To restore the old behaviour, you can call the C<unimport> method.
use ARGV::OrDATA;
my $from_data = <>;
@ARGV = 'file1.txt'; # Ignored.
'ARGV::OrDATA'->unimport;
lib/ARGV/OrDATA.pm view on Meta::CPAN
=item ARGV::OrDATA::is_using_argv()
Returns 0 when ARGV reads from DATA, 0 otherwise.
=item ARGV::OrDATA::is_using_data()
Returns 1 when ARGV reads from DATA, 1 otherwise.
=back
lib/ARGV/OrDATA.pm view on Meta::CPAN
E. Choroba, C<< <choroba at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to the GitHub repository at
L<https://github.com/choroba/argv-ordata>.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
lib/ARGV/OrDATA.pm view on Meta::CPAN
L<http://mcpan.org/pod/ARGV-OrDATA>
=item * GitHub
L<https://github.com/choroba/argv-ordata>
=back
=head1 ACKNOWLEDGEMENTS
ARGV-Struct
view release on metacpan or search on metacpan
lib/ARGV/Struct.pm view on Meta::CPAN
1;
#################### main pod documentation begin ###################
=head1 NAME
ARGV::Struct - Parse complex data structures passed in ARGV
=head1 SYNOPSIS
use ARGV::Struct;
my $struct = ARGV::Struct->new->parse;
lib/ARGV/Struct.pm view on Meta::CPAN
Have you ever felt that you need something different than Getopt?
Are you tired of shoehorning Getopt style arguments into your commandline scripts?
Are you trying to express complex datastructures via command line?
then ARGV::Struct is for you!
It's designed so the users of your command line utilities won't hate you when things
get complex.
=head1 THE PAIN
I've had to use some command-line utilities that had to do creative stuff to transmit
deeply nested arguments, or datastructure-like information. Here are some strategies that
I've found over time:
=head2 Complex arguments codified as JSON
JSON is horrible for the command line because you have to escape the quotes. It's a nightmare.
lib/ARGV/Struct.pm view on Meta::CPAN
command --key key1 --value value1 --key key1 --value value 2
=head1 THE DESIGN
The design of this module is aimed at "playing well with the shell". The main purpose is
to let the user transmit complex data structures, while staying compact enough for command line
use.
=head2 Key/Value sets (objects)
On the command line, the user can transmit sets of key/value pairs within curly brackets
lib/ARGV/Struct.pm view on Meta::CPAN
Return an instance of the parser. If argv is not specified, @ARGV will be
used.
=head2 parse
return the parsed data structure
=head1 STATUS
This module is quite experimental. I developed it while developing Paws (a
Perl AWS SDK). It has a commandline utility that needs to recollect all the
ARGV-readonly
view release on metacpan or search on metacpan
Makefile.PL
MANIFEST
README
t/ARGV-readonly.t
lib/ARGV/readonly.pm
META.yml Module meta-data (added by MakeMaker)
ARS-Simple
view release on metacpan or search on metacpan
examples/generate_fid_hash.pl view on Meta::CPAN
#----------
my $sql = qq{select
f.fieldName,
f.fieldID,
decode(FOption, 1, 'Required ', 2, 'Optional ', 3, 'System RO', '*Unknown*'),
decode(datatype, 0, 'AR_DATA_TYPE_NULL', 1, 'AR_DATA_TYPE_KEYWORD', 2, 'AR_DATA_TYPE_INTEGER', 3, 'AR_DATA_TYPE_REAL', 4, 'AR_DATA_TYPE_CHAR', 5, 'AR_DATA_TYPE_DIARY', 6, 'AR_DATA_TYPE_ENUM', 7, 'AR_DATA_TYPE_TIME', 8, 'AR_DATA_TYPE_BITMASK', 9, 'AR_...
c.maxlength
from arschema a
join field f
on f.schemaid = a.schemaid and datatype < 30 and f.fieldID != 15
left outer join field_char c
on c.schemaid = f.schemaid and c.fieldid = f.fieldID
where a.name = '$form'
order by 1};
my $m = $ars->get_SQL({ sql => $sql });
### Sample data for 'User' form
# my $m = {
# numMatches => 30,
# rows => [
# [ 'CreateDate' , 3, 'System RO', 'AR_DATA_TYPE_TIME', undef ],
# [ 'LastModifiedBy' , 5, 'System RO', 'AR_DATA_TYPE_CHAR', 254 ],
examples/generate_fid_hash.pl view on Meta::CPAN
# };
unless ($m && $m->{numMatches})
{
print "No data returned, quitting\n";
exit;
}
# Check size and replace spaces with '_', you could also remove them!
my $max_len = 0;
examples/generate_fid_hash.pl view on Meta::CPAN
$fid_hash .= sprintf(" '%s'%s=> %10d,\t\t# %s type=%s %d\n", $row->[0], ' ' x ($max_len + 1 - length($row->[0])), $row->[1], $row->[2], $row->[3], $row->[4]);
}
$fid_hash .= " );\n";
$CLIP->Set($fid_hash);
print "$fid_hash\nFormatted data copied to clipboard\n";
ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
,-schgen => 1 # 1 - use vfname('meta') for '-meta', generate it from ARS if not exists.
# 2 - renewable 'meta' smartly
# 3 - renew meta always
# [schema,...] - list to renew
,-schfdo => 0 # Include display only fields into schema (AR_FIELD_OPTION_DISPLAY)
,-meta => {} # Forms metadata from ARS:
# {formName}->{-fields}->{fieldName}=>{}
# {formName}->{-fldids}->{fieldId}=>{}
# Additional parameters may be:
# ,'fieldLbl' =>label
# ,'fieldLbll'=>label localised
lib/ARSObject.pm view on Meta::CPAN
# ,strIn=>sub(self,form,{field},$_=val){}
# ,strOut=>sub(self,form,{field},$_=val){}
# },...}
,-maxRetrieve => 0 # ARS::ars_GetListEntry(maxRetrieve)
,-entryNo => undef # Logical number of entry inserted
,-strFields => 1 # Translate fields data using 'strIn'/'strOut'/'-meta'?
# 1 - 'enumLimits', 2 - 'fieldLbvl' before 'enumLimits'
,-cmd =>'' # Command running, for err messages, script local $s->{-cmd}
,-die =>undef # Error die/warn, 'Carp' or 'CGI::Carp...'
# ,-diemsg => undef #
,-warn=>undef # , see set() and connect() below
lib/ARSObject.pm view on Meta::CPAN
$v =~s/"/""/g;
$v =~/^\d+$/ ? $v : ('"' .$v .'"');
}
sub dsquot { # Quote data structure
$#_ <2 # (self, ?'=>', data struct)
? dsquot($_[0],'=> ',$_[1])
: !ref($_[2]) # (, hash delim, value) -> stringified
? strquot($_[0],$_[2])
: ref($_[2]) eq 'ARRAY'
? '[' .join(', ', map {dsquot(@_[0..1],$_)
lib/ARSObject.pm view on Meta::CPAN
} sort keys %{$_[2]}) .'}'
: strquot($_[0],$_[2])
}
sub dsquot1 { # Quote data structure, defined elements only
$#_ <2 # (self, ?'=>', data struct)
? dsquot1($_[0],'=> ',$_[1])
: !ref($_[2]) # (, hash delim, value) -> stringified
? strquot($_[0],$_[2])
: ref($_[2]) eq 'ARRAY'
? '[' .join(', ', map {defined($_) ? dsquot1(@_[0..1],$_) : ()
lib/ARSObject.pm view on Meta::CPAN
: strquot($_[0],$_[2])
}
sub dsdump { # Data structure dump to string
my ($s, $d) =@_; # (data structure) -> dump string
eval('use Data::Dumper');
my $o =Data::Dumper->new([$d]);
$o->Indent(1);
$o->Deepcopy(1);
$o->Dump();
}
sub dsparse { # Data structure dump string to perl structure
my ($s, $d) =@_; # (string) -> data structure
eval('use Safe; 1')
&& Safe->new()->reval($d)
}
sub dscmp { # Compare data structures
my($s, $ds1, $ds2) =@_;
return(1) if (defined($ds1) && !defined($ds2)) ||(defined($ds2) && !defined($ds1));
return(0) if !defined($ds1) && !defined($ds2);
return(1) if (ref($ds1) ||'') ne (ref($ds2) ||'');
return($ds1 cmp $ds2) if !ref($ds1);
lib/ARSObject.pm view on Meta::CPAN
$_[0]->{-vfbase} .($v =~/^-(.+)/ ? ($1 .($_[2] ||'.var')) : ($v .($_[2] ||'.var')))
}
sub vfstore { # Store variables file
# (varname, {data}) -> success
# (-slot) -> success
my($s,$n,$d)=@_;
$d =$s->{$n} if !$d && ($n =~/^-/);
my $f =$s->vfname($n, '.new');
my $r;
lib/ARSObject.pm view on Meta::CPAN
$r
}
sub vfload { # Load variables file
# (varname|-slot, ?{use default} | load default, ?renew | renew seconds) -> {data}
my($s,$f,$d,$nn) =@_; # -slot-calc, -slot-store
my $k =($f =~/^-/ ? $f : undef);
$f =$s->vfname($f);
if ($nn && $nn >1) {
my @st =stat($f);
lib/ARSObject.pm view on Meta::CPAN
vfload($s,$f,1,$nn ||1);
}
sub vfclear { # Clear vfdata() and vfhash()
my($s,$f) =@_; # (-slot, ?period seconds) -> vfload
return(1) if $f !~/^-/;
delete($s->{$f});
foreach my $k (keys %$s) {
next if $k !~/^\Q$f\E[\/].+/;
lib/ARSObject.pm view on Meta::CPAN
}
1;
}
sub vfdata { # Access to array data from variables file
# automatically load using vfload().
# (-slot) -> [array]
# (-slot, filter sub{}(self, -slot, index, $_=value)) -> [array]
vfload($_[0], $_[1], 1) if !$_[0]->{$_[1]} || (ref($_[0]->{$_[1]}) eq 'CODE');
if ($_[2]) {
if (ref($_[2]) eq 'CODE') {
local $_;
local $_[0]->{-cmd} =($_[0]->{-cmd} ? $_[0]->{-cmd} .': ' : '')
."vfdata('$_[1]', sub{})";
my ($rr, $v);
if (ref($_[0]->{$_[1]}) eq 'ARRAY') {
$rr =[];
for(my $i=0; $i<=$#{$_[0]->{$_[1]}}; $i++) {
if (!defined(eval{$v =&{$_[2]}($_[0], $_[1], $i, $_ =$_[0]->{$_[1]}->[$i])}) && $@) {
lib/ARSObject.pm view on Meta::CPAN
}
$_[0]->{$_[1]}
}
sub vfhash { # Access to hash of array data from variables file
# automatically formed in memory using vfdata().
# (-slot, key name) -> {hash from vfdata()}
# (-slot, key name => key value) -> {key=>value,...}
# (-slot, key name => key value => elem name ) -> elem value
# (-slot, key name => filter sub{}(self, -slot, key, $_ = value)) -> {key=>value,...}
my($s, $f, $k, $v, $e) =@_;
return(&{$s->{-die}}($s->efmt('Key name needed',undef,undef,'vfhash',$f))) if !$k;
lib/ARSObject.pm view on Meta::CPAN
: $s->{$kk}->{$v}
}
sub vfdistinct {# Distinct values from vfdata() field.
# (-slot, key name) -> [keys %{vfhash(...)}]
# (-slot, key name => filter sub{}(self, -slot, key, $_ = value)) -> [keys %{vfhash(...)}]
my($s, $f, $k, $v) =@_;
my(%rh, $t);
local $_;
lib/ARSObject.pm view on Meta::CPAN
$s->arsmeta();
$s
}
sub disconnect { # Disconnect data servers
my $s =shift;
$s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
$s->{-ctrl}=undef;
$s->{-dbi} && eval{$s->{-dbi}->disconnect()};
$s->{-dbi} =undef;
}
sub arsmeta { # Load/refresh ARS metadata
my $s =shift; # -srv, -usr, -pswd, -lang
$s->set(@_);
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
.($s->{-schgen} ? "dumper('" .$s->vfname('meta') ."')" : 'arsmeta()');
if (ref($s->{-schgen})
lib/ARSObject.pm view on Meta::CPAN
my %ff =ARS::ars_GetFieldTable($s->{-ctrl}, $f);
!%ff && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetFieldTable',$f)));
foreach my $ff (sort keys %ff) {
my $fm =ARS::ars_GetField($s->{-ctrl},$f,$ff{$ff})
|| return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetField',$f,$ff)));
# 'fieldId', 'fieldName', 'dataType'
next if !$fm->{dataType}
|| ($fm->{dataType} =~/^(trim|control|table|column|page)/);
next if !$s->{-schfdo} && $fm->{option} && ($fm->{option} == 4); # AR_FIELD_OPTION_DISPLAY
$s->{-meta}->{$f}->{-fields}->{$ff} =$fm;
$s->{-meta}->{$f}->{-fields}->{$ff}->{indexUnique} =$fm->{fieldId}
if $ix->{$fm->{fieldId}}
|| ($fm->{fieldId} eq '1'); # || '179'?
lib/ARSObject.pm view on Meta::CPAN
$s->vfload('-meta');
# print $s->cpcon($s->dsdump($s->{-meta})), "\n"; exit(0);
}
else {
$s->{-meta} ={};
return(&{$s->{-die}}($s->efmt('No metadata',$s->{-cmd})))
}
$s->arsmetaix() if $s->{-meta};
}
sub arsmetaix { # Index ARS metadata
my $s =shift;
if ($s->{-meta}) {
foreach my $f (keys %{$s->{-meta}}){
next if $f =~/^-/;
$s->{-meta}->{$f}->{-fldids} ={}
lib/ARSObject.pm view on Meta::CPAN
# print $s->cpcon($s->dsdump($s->{-metaid})), "\n"; exit(0);
}
}
sub arsmetamin { # Minimal ARS metadata ('-meta-min' varfile)
my $s =shift; # refresh after 'arsmeta'/'connect'
$s->set(@_); # load instead of 'arsmeta'/'connect'
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
.($s->{-schgen} ? "dumper('" .$s->vfname('meta-min') ."')" : 'arsmetamin()');
if (ref($s->{-schgen})
lib/ARSObject.pm view on Meta::CPAN
if (!$fvs) {
$s->{'-meta-min'} ={};
foreach my $f (keys %{$s->{-meta}}) {
foreach my $ff (keys %{$s->{-meta}->{$f}->{-fields}}) {
my $e =$s->{-meta}->{$f}->{-fields}->{$ff};
next if (!$e->{dataType}
|| ($e->{dataType} ne 'time'))
&& (!$e->{'limit'}
|| !$e->{'limit'}->{'enumLimits'}
|| !($e->{'limit'}->{'enumLimits'}->{'regularList'} ||$e->{'limit'}->{'enumLimits'}->{'customList'}));
$s->{'-meta-min'}->{$f} ={} if !$s->{'-meta-min'}->{$f};
$s->{'-meta-min'}->{$f}->{-fields} ={} if !$s->{'-meta-min'}->{$f}->{-fields};
lib/ARSObject.pm view on Meta::CPAN
delete $s->{'-meta-min'};
$s;
}
sub arsmetasql { # SQL ARS metadata ('-meta-sql' varfile)
my $s =shift; # refresh after 'arsmeta'/'connect'
$s->set(@_); # !!! 'enum' texts
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
.($s->{-schgen} ? "dumper('" .$s->vfname('meta-sql') ."')" : 'arsmetasql()');
if (ref($s->{-schgen})
lib/ARSObject.pm view on Meta::CPAN
$s->{'-meta-sql'} ={} if !$s->{'-meta-sql'};
foreach my $f ($s->{-schema} ? @{$s->{-schema}} : sort keys %{$s->{-meta}}) {
$s->sqlname($f);
foreach my $ff (sort keys %{$s->{-meta}->{$f}->{-fields}}) {
$s->sqlname($f,$ff,1);
if ($s->{-meta}->{$f}->{-fields}->{$ff}->{dataType} eq 'enum') {
# $s->sqlname($f,'_str_' .$ff,1);
# $s->{'-meta-sql'}->{$s->sqlname($f)}->{-cols}->{$s->sqlname($f,'_str_' .$ff)}->{TYPE_NAME} ='varchar';
}
}
foreach my $ff ('_arsobject_insert', '_arsobject_update', '_arsobject_delete') {
lib/ARSObject.pm view on Meta::CPAN
}
if ($fu ||!$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}) {
my $flh =$s->{-meta}->{$f}->{-fields}->{$ff}->{limit};
my $tch ={COLUMN_NAME => $tc
, 'fieldName'=>$ff
, 'dataType' => $ffh->{dataType}
, 'timestamp'=>$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}
&& $s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}->{'timestamp'}
|| time()
, $ffh && $ffh->{fieldId}
? ('fieldId' => $ffh->{fieldId})
: ()
, !$ffh ||!$ffh->{dataType}
? ()
: $ffh->{dataType} eq 'integer'
? (TYPE_NAME => 'int')
: $ffh->{dataType} eq 'real'
? (TYPE_NAME => 'float')
: $ffh->{dataType} eq 'decimal'
? (TYPE_NAME => $ffh->{dataType}
, $flh
? ($flh->{precision} ? (DECIMAL_DIGITS => $flh->{precision}) : ()
,$flh->{rangeHigh} ? (COLUMN_SIZE => length($flh->{rangeHigh})) : ()
)
: ()
)
: $ffh->{dataType} eq 'char'
&& (!$flh || !$flh->{maxLength} || ($flh->{maxLength} >255))
? (TYPE_NAME => 'text')
: 0 && ($ffh->{dataType} eq 'char') && $ffh->{indexUnique}
? (TYPE_NAME => 'char'
, $flh && $flh->{maxLength}
? (COLUMN_SIZE => $flh->{maxLength})
: ()
)
: $ffh->{dataType} eq 'char'
? (TYPE_NAME=>'varchar' # $ffh->{dataType}
, $flh && $flh->{maxLength}
? (COLUMN_SIZE => $flh->{maxLength})
: ()
)
: $ffh->{dataType} eq 'diary'
? (TYPE_NAME => 'text')
: $ffh->{dataType} eq 'time'
? (TYPE_NAME => 'datetime' # !'int'
#,COLUMN_SIZE=>19,DECIMAL_DIGITS=>0
)
: $ffh->{dataType} eq 'enum'
? (TYPE_NAME => 'int')
: ()
, $ffh && $ffh->{fieldId}
&& (($ffh->{fieldId} =~/^(?:1)$/) || $ffh->{indexUnique})
? (IS_PK => $ffh->{fieldId})
lib/ARSObject.pm view on Meta::CPAN
my($s,$f,$ff) =@_;
$ff =ref($ff) ? $ff
: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
: $s->{-meta}->{$f}->{-fields}->{$ff};
if ($ff && !$ff->{-hashOut} && ($ff->{dataType} eq 'enum')) {
my $et =ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
? $ff->{'limit'}->{'enumLimits'}
: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
lib/ARSObject.pm view on Meta::CPAN
my($s,$f,$ff) =@_;
$ff =ref($ff) ? $ff
: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
: $s->{-meta}->{$f}->{-fields}->{$ff};
if ($ff && !$ff->{-listVals} && ($ff->{dataType} eq 'enum')) {
my $et =ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
? $ff->{'limit'}->{'enumLimits'}
: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
lib/ARSObject.pm view on Meta::CPAN
}
else {
# return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strOut',$f,$ff->{fieldName},$v)))
}
}
elsif ($ff->{dataType} eq 'enum') {
schlbls(@_);
$v =strOut(@_) if $ff->{-hashOut};
}
elsif ($ff->{dataType} eq 'time') {
$v =strtime($s,$v)
}
$v
}
lib/ARSObject.pm view on Meta::CPAN
}
else {
return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strIn',$f,$ff->{fieldName},$v)))
}
}
elsif ($ff->{dataType} eq 'enum') {
my $et = ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
? $ff->{'limit'}->{'enumLimits'}
: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
lib/ARSObject.pm view on Meta::CPAN
$et =undef
}
return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strIn',$f,$ff->{fieldName},$v)))
if $et && ($v !~/^\d+$/);
}
elsif ($ff->{dataType} eq 'time') {
$v =timestr($s,$v);
}
$v
}
sub lsflds { # List fields from '-meta'
# (additional field options)
my ($s, @a) =@_;
@a =('fieldLblc') if !@a;
unshift @a, 'fieldName', 'fieldId', 'dataType', 'option', 'createMode';
map { my $f =$_;
$f =~/^-/
? ()
: map { my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
join("\t", $f
lib/ARSObject.pm view on Meta::CPAN
my $q ='trim|control|table|column|page';
$q .= '|currency|attach' if $a{-fields} =~/^-\$/;
$q .= '|attach' if $a{-fields} =~/^-f/;
$a{-fields} =
[map { my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
!$ff->{dataType} || !$ff->{fieldId}
|| ($ff->{dataType} =~/^($q)/)
|| ($ff->{fieldId} eq '15') # 'Status-History'
# ars_GetListEntryWithFields() -> [ERROR] (ORA-00904: "C15": invalid identifier) (ARERR #552)
|| (!$a{-xfields} ? 0 : ref($a{-xfields}) eq 'CODE' ? &{$a{-xfields}}($s, $ff) : grep {($_ eq $ff->{fieldId}) || ($_ eq $ff->{fieldName})} @{$a{-xfields}})
? ()
: ($ff->{fieldId})
lib/ARSObject.pm view on Meta::CPAN
}
sub entryBLOB { # BLOB field retrieve/update
# (-form=>form, -id=>entryId, -field=>fieldId|fieldName
# ,?-set=>data
# ,?-file=>filePath, ?-set=>boolean
my ($s, %a) =@_;
my $f =$a{-schema} ||$a{-form} ||$a{-from} ||$a{-into};
my $eu =!$a{-file} ? exists($a{-set}) : exists($a{-set}) ? $a{-set} : $a{-into};
if ($eu) {
lib/ARSObject.pm view on Meta::CPAN
return($_[0]->{-dbi}) if $_[0]->{-dbi};
dbiconnect(@_)
}
sub dbiconnect {# DBI connect to any database
# (-dbiconnect=>[]) -> dbi object
set(@_);
set($_[0],-die=>'Carp') if !$_[0]->{-die};
print $_[0]->cpcon("dbiconnect()\n")
if $_[0]->{-echo};
lib/ARSObject.pm view on Meta::CPAN
} 'COLUMN_SIZE', 'DECIMAL_DIGITS') .')'
: '')
}
sub dbidsmetasync { # DBI datastore - sync meta with 'arsmetasql'
my ($s, %arg) =@_; # (-echo)
return(undef) if !$s->{'-meta-sql'};
my $dbt ={map {!$_
? ()
: $_ =~/\."*([^."]+)"*$/
lib/ARSObject.pm view on Meta::CPAN
}
$s;
}
sub dbidsrpl { # DBI datastore - load data from ARS
my ($s, %arg) =@_;
$arg{-form} =$arg{-from} ||$arg{-schema} if !$arg{-form};
$arg{-query} =$arg{-where} ||$arg{-qual} if !$arg{-query};
$arg{-filter}=undef if !$arg{-filter};
$arg{-lim_rf}=300 if !$arg{-lim_rf};
lib/ARSObject.pm view on Meta::CPAN
|| !exists($r->{$f->{fieldName}});
$rw->{$f->{fieldName}} =!defined($r->{$f->{fieldName}})
? $r->{$f->{fieldName}}
: $f->{TYPE_NAME} eq 'datetime'
? strtime($s, $r->{$f->{fieldName}})
: ($f->{dataType} =~/^(?:char)$/) && $f->{COLUMN_SIZE}
? substr($r->{$f->{fieldName}}, 0, $f->{COLUMN_SIZE_DB} ||$f->{COLUMN_SIZE})
: $r->{$f->{fieldName}};
$rd->{$f->{COLUMN_NAME}} =$1
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
lib/ARSObject.pm view on Meta::CPAN
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{TYPE_NAME} eq 'float');
$rd->{$f->{COLUMN_NAME}} =substr($rd->{$f->{COLUMN_NAME}}, 0, $f->{COLUMN_SIZE_DB} ||$f->{COLUMN_SIZE})
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{dataType} =~/^(?:char)$/) && $f->{COLUMN_SIZE};
$ru =1 if $rd
&& (defined($rd->{$f->{COLUMN_NAME}})
? !defined($rw->{$f->{fieldName}})
|| ($rd->{$f->{COLUMN_NAME}} ne $rw->{$f->{fieldName}})
: defined($rw->{$f->{fieldName}}));
lib/ARSObject.pm view on Meta::CPAN
join(', ', map {$_ ? $_ : ()} $ci && "new $ci", $cu && "upd $cu", $cd && "del $cd")
||'up-to-date'
}
sub dbidsquery { # DBI datastore - query data alike ARS
my ($s, %arg) =@_;
# -form => ARS form || -from => sql table name
# -fields=> ARS fields || -select=>sql select list
# -query=> ARS query || -where => sql where
# -order =>
lib/ARSObject.pm view on Meta::CPAN
: $m->{-cols}->{$_} && $m->{-cols}->{$_}->{fieldName} && $m->{-cols}->{$_}->{fieldId}
? ($m->{-cols}->{$_}->{fieldName}
=>
(!defined($r->{$_})
? $r->{$_}
: $ys && ($m->{-cols}->{$_}->{dataType} eq 'enum')
? $s->strOut($arg{-form}, $m->{-cols}->{$_}->{fieldId}, $r->{$_})
: ($m->{-cols}->{$_}->{TYPE_NAME} =~/^(?:datetime|float)$/) && ($r->{$_} =~/^(.+)\.0+$/)
? $1
: $r->{$_}))
: $yc
lib/ARSObject.pm view on Meta::CPAN
}
@r
}
sub dbidsqq { # DBI datastore - quote/parse condition to SQL names
my ($s,$sf,$mh) =@_; # (self, query string, default sql metadata)
if (0) {
my $q =substr($s->{-dbi}->quote_identifier(' '),0,1);
$sf =~s/$q([^$q]+)$q\.$q([^$q]+)$q/!$s->{'-meta-sql'}->{-forms}->{$1} ? "?1$q$1${q}.$q$2$q" : $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$1}}->{-fields}->{$2} ? $s->{-dbi}->quote_identifier($s->{'-meta-sql'}->{-forms}->{$1}) .'.' .$s->{-dbi}-...
$sf =~s/$q([^$q]+)$q/$s->{'-meta-sql'}->{-forms}->{$1} ? ($s->{-sqlschema} ? $s->{-dbi}->quote_identifier($s->{-sqlschema}) .'.' : '') .$s->{-dbi}->quote_identifier($s->{'-meta-sql'}->{-forms}->{$1}) : $mh->{-fields}->{$1} ? $s->{-dbi}->quote_identi...
return($sf);
lib/ARSObject.pm view on Meta::CPAN
}
sub smtpsend { # SMTP mail msg send
# -from||-sender, -to||-recipient,
# -data|| -subject + (-text || -html)
my ($s, %a) =@_;
return(&{$s->{-die}}("SMTP host not defined"))
if !$s->{-smtphost};
local $s->{-smtpdomain} =$s->{-smtpdomain}
|| ($s->{-smtphost} && $s->smtp(sub{$_[1]->domain()}))
lib/ARSObject.pm view on Meta::CPAN
$a{-recipient} =&{$a{-recipient}}($s,\%a) if ref($a{-recipient}) eq 'CODE';
$a{-recipient} =[grep {$_} split /\s*[,;]\s*/, ($a{-recipient} =~/^\s*(.*)\s*$/ ? $1 : $a{-recipient})]
if $a{-recipient} && ref($a{-recipient}) && ($a{-recipient} =~/[,;]/);
return(&{$s->{-die}}("SMTP e-mail recipients not defined"))
if !$a{-recipient};
if (!defined($a{-data})) {
my $koi =(($a{-charset}||$s->charset()||'') =~/1251/);
$a{-subject} = ref($a{-subject}) eq 'CODE'
? &{$a{-subject}}($s,\%a)
: 'ARSObject'
if ref($a{-subject}) ||!defined($a{-subject});
$a{-data} ='';
$a{-data} .='From: ' .($koi ? $s->cptran('ansi','koi',$a{-from})
: $a{-from})
."\cM\cJ";
$a{-data} .='Subject: '
.($koi
? $s->cptran('ansi','koi',$a{-subject})
: $a{-subject}) ."\cM\cJ";
$a{-data} .='To: '
.($koi
? $s->cptran('ansi','koi', ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to})
: (ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to}))
."\cM\cJ"
if $a{-to};
foreach my $k (keys %a) {
next if $k =~/^-(data|subject|html|text|from|to|sender|recipient)$/;
next if !defined($a{$k});
my $n =$k =~/^-(.+)/ ? ucfirst($1) .':' : $k;
$a{-data} .=$n .' ' .$a{$k} ."\cM\cJ";
}
$a{-data} .="MIME-Version: 1.0\cM\cJ";
$a{-data} .='Content-type: ' .($a{-html} ? 'text/html' : 'text/plain')
.'; charset=' .($a{-charset}||$s->charset())
."\cM\cJ";
$a{-data} .='Content-Transfer-Encoding: ' .($a{-encoding} ||'8bit') ."\cM\cJ";
$a{-data} .="\cM\cJ";
$a{-data} .=$a{-html} ||$a{-text} ||'';
}
local $^W=undef;
$s->smtp->mail($a{-sender} =~/<\s*([^<>]+)\s*>/ ? $1 : $a{-sender})
||return(&{$s->{-die}}("SMTP sender \'" .$a{-sender} ."' -> " .($s->smtp->message()||'?')));
$s->smtp->to(ref($a{-recipient})
? (map { !$_ ? () : /<\s*([^<>]+)\s*>/ ? $1 : $_ } @{$a{-recipient}})
: $a{-recipient}, {'SkipBad'=>1}) # , {'SkipBad'=>1}
|| return(&{$s->{-die}}("SMTP recipient \'"
.(ref($a{-recipient}) ? join(', ', (map { !$_ ? () : /<\s*([^<>]+)\s*>/ ? $1 : $_ } @{$a{-recipient}})) : $a{-recipient}) ."' -> " .($s->smtp->message()||'?')));
$s->smtp->data($a{-data})
||return(&{$s->{-die}}("SMTP data '" .$a{-data} ."' -> " .($s->smtp->message()||'?')));
my $r =$s->smtp->dataend()
||return(&{$s->{-die}}("SMTP dataend -> " .($s->smtp->message()||'?')));
$r ||1;
}
sub soon { # Periodical execution of this script
lib/ARSObject.pm view on Meta::CPAN
}
1
}
sub cfpinit { # Field Player: init data structures
my ($s) =@_; # (self) -> self
$s->{-fphc} ={};
$s->{-fphd} ={};
my $dh ={};
my $dp =undef;
lib/ARSObject.pm view on Meta::CPAN
my $fs =$f->{-vfname} ||$af->{-vfname};
my $fn =undef;
my $fv =undef;
if ($frk && $fs && ($fn =$frk->{-namedb}) && defined($fv=cfpv($s, $frk->{-master}))) {
$s->{-fpbv} =$f->{-namedb}
? $s->vfdata($fs, sub{defined($_->{$fn}) && ($_->{$fn} eq $fv)})
: [];
$r =shift @{$s->{-fpbv}} if $s->{-fpbv} && scalar(@{$s->{-fpbv}});
$r ={} if !$r;
}
elsif ($fs) {
lib/ARSObject.pm view on Meta::CPAN
elsif ($fn =cfpnd($s, cfpv($s, $af))) {
$fv =cfpv($s, $fn)
}
if ($fn && defined($fv)) {
$r =undef;
my $fa =$s->vfdata($fs);
foreach my $e (@$fa) {
next if !defined($e->{$fn}) || ($e->{$fn} ne $fv);
$r =$e;
last
}
lib/ARSObject.pm view on Meta::CPAN
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $ft =defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
push @$fa, {$f->{-namedb} ? ($f->{-namedb}=>$r) : ()
,map { &$ffc($s, $_) ||(exists($_->{-vfstore}) && !$_->{-vfstore})
? ()
: ($_->{-namedb} => &$fvu($s, $_, $ft))
} cfpused($s)};
lib/ARSObject.pm view on Meta::CPAN
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $ft =defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
foreach my $e (@$fa) {
next if !defined($e->{$fn}) || ($e->{$fn} ne $fv);
foreach my $f1 (cfpused($s)) {
next if &$ffc($s, $f1) ||(exists($f1->{-vfstore}) && !$f1->{-vfstore});
$e->{$f1->{-namedb}} =&$fvu($s, $f1, $ft);
lib/ARSObject.pm view on Meta::CPAN
eval{$s->vfclear($fs); $s->vfrenew($fs)}
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
my ($i,$j) =(0, undef);
foreach my $e (@$fa) {
if (defined($e->{$fn}) && ($e->{$fn} eq $fv)) {
$j =$i;
last;
ARSperl
view release on metacpan or search on metacpan
}
if(0) {
while($#_) {
my ($f, $v) = (shift @_, shift @_);
my $fh = ars_GetField($c, $s, $f);
if(($fh->{'dataType'} eq "char") ||
($fh->{'dataType'} eq "diary")) {
$v = "\"$v\"";
}
}
}
print "walktree..\n";
( run in 0.492 second using v1.01-cache-2.11-cpan-8d75d55dd25 )