The only JS and json data left in Windows style: 14:19:58 ✔ taurus:(master)~/sipwise/git/ngcp-panel$ ack -l "\r\n" share/static/js/jquery.loadJSON.js share/static/js/libs/svg-edit/config-sample.js share/static/js/libs/svg-edit/canvg/canvg.js share/static/js/libs/svg-edit/contextmenu/jquery.contextMenu.js share/static/js/libs/svg-edit/jquery-ui/jquery-ui-1.8.custom.js share/static/js/libs/svg-edit/extensions/webappfind-icon.svg share/static/js/libs/svg-edit/extensions/shapelib/animal.json share/static/js/libs/svg-edit/extensions/shapelib/object.json share/static/js/libs/svg-edit/extensions/shapelib/electronics.json share/static/js/libs/svg-edit/extensions/shapelib/misc.json share/static/js/libs/svg-edit/extensions/shapelib/game.json share/static/js/libs/svg-edit/extensions/shapelib/flowchart.json share/static/js/libs/svg-edit/extensions/shapelib/raphael.txt share/static/js/libs/svg-edit/extensions/shapelib/raphael_1.json share/static/js/libs/svg-edit/extensions/shapelib/symbol.json share/static/js/libs/svg-edit/extensions/shapelib/music.json share/static/js/libs/svg-edit/extensions/shapelib/arrow.json share/static/js/libs/svg-edit/extensions/shapelib/raphael_2.json share/static/js/libs/svg-edit/extensions/shapelib/math.json share/static/js/libs/svg-edit/extensions/shapelib/dialog_balloon.json share/static/js/libs/svg-edit/extensions/ext-xdomain-messaging.js share/static/js/libs/svg-edit-2.6/jquery-ui/jquery-ui-1.8.custom.js share/static/js/jquery.dump.js 14:19:58 ✔ taurus:(master)~/sipwise/git/ngcp-panel$ Change-Id: Ia6245db0528abf0902fe5e62cff26de294510dd4changes/16/21216/4
Alexander Lutay
8 years ago
parent
cdbc01978c
commit
a9b94c4808
@ -1,71 +1,71 @@
|
||||
package NGCP::Panel::Role::Journal;
|
||||
|
||||
use Sipwise::Base;
|
||||
|
||||
use NGCP::Panel::Utils::Journal;
|
||||
|
||||
sub add_create_journal_item_hal {
|
||||
my ($self,$c,@args) = @_;
|
||||
return NGCP::Panel::Utils::Journal::add_journal_item_hal($self,$c,NGCP::Panel::Utils::Journal::CREATE_JOURNAL_OP,@args);
|
||||
}
|
||||
|
||||
sub add_update_journal_item_hal {
|
||||
my ($self,$c,@args) = @_;
|
||||
return NGCP::Panel::Utils::Journal::add_journal_item_hal($self,$c,NGCP::Panel::Utils::Journal::UPDATE_JOURNAL_OP,@args);
|
||||
}
|
||||
|
||||
sub add_delete_journal_item_hal {
|
||||
my ($self,$c,@args) = @_;
|
||||
return NGCP::Panel::Utils::Journal::add_journal_item_hal($self,$c,NGCP::Panel::Utils::Journal::DELETE_JOURNAL_OP,@args);
|
||||
}
|
||||
|
||||
sub get_journal_action_config {
|
||||
my ($class,$resource_name,$action_template) = @_;
|
||||
my $cfg = NGCP::Panel::Utils::Journal::get_journal_resource_config(NGCP::Panel->config,$resource_name);
|
||||
if ($cfg->{journal_resource_enabled}) {
|
||||
return NGCP::Panel::Utils::Journal::get_api_journal_action_config('api/' . $resource_name,$action_template,$class->get_journal_methods);
|
||||
}
|
||||
return [];
|
||||
}
|
||||
|
||||
sub get_journal_query_params {
|
||||
my ($class,$query_params) = @_;
|
||||
return NGCP::Panel::Utils::Journal::get_api_journal_query_params($query_params);
|
||||
}
|
||||
|
||||
sub handle_item_base_journal {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_item_base_journal(@_);
|
||||
}
|
||||
|
||||
sub handle_journals_get {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journals_get(@_);
|
||||
}
|
||||
|
||||
sub handle_journalsitem_get {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journalsitem_get(@_);
|
||||
}
|
||||
|
||||
sub handle_journals_options {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journals_options(@_);
|
||||
}
|
||||
|
||||
sub handle_journalsitem_options {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journalsitem_options(@_);
|
||||
}
|
||||
|
||||
sub handle_journals_head {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journals_head(@_);
|
||||
}
|
||||
|
||||
sub handle_journalsitem_head {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journalsitem_head(@_);
|
||||
}
|
||||
|
||||
sub get_journal_relation_link {
|
||||
my $cfg = NGCP::Panel::Utils::Journal::get_journal_resource_config(NGCP::Panel->config,$_[0]->resource_name);
|
||||
if ($cfg->{journal_resource_enabled}) {
|
||||
return NGCP::Panel::Utils::Journal::get_journal_relation_link(@_);
|
||||
}
|
||||
return ();
|
||||
}
|
||||
1;
|
||||
package NGCP::Panel::Role::Journal;
|
||||
|
||||
use Sipwise::Base;
|
||||
|
||||
use NGCP::Panel::Utils::Journal;
|
||||
|
||||
sub add_create_journal_item_hal {
|
||||
my ($self,$c,@args) = @_;
|
||||
return NGCP::Panel::Utils::Journal::add_journal_item_hal($self,$c,NGCP::Panel::Utils::Journal::CREATE_JOURNAL_OP,@args);
|
||||
}
|
||||
|
||||
sub add_update_journal_item_hal {
|
||||
my ($self,$c,@args) = @_;
|
||||
return NGCP::Panel::Utils::Journal::add_journal_item_hal($self,$c,NGCP::Panel::Utils::Journal::UPDATE_JOURNAL_OP,@args);
|
||||
}
|
||||
|
||||
sub add_delete_journal_item_hal {
|
||||
my ($self,$c,@args) = @_;
|
||||
return NGCP::Panel::Utils::Journal::add_journal_item_hal($self,$c,NGCP::Panel::Utils::Journal::DELETE_JOURNAL_OP,@args);
|
||||
}
|
||||
|
||||
sub get_journal_action_config {
|
||||
my ($class,$resource_name,$action_template) = @_;
|
||||
my $cfg = NGCP::Panel::Utils::Journal::get_journal_resource_config(NGCP::Panel->config,$resource_name);
|
||||
if ($cfg->{journal_resource_enabled}) {
|
||||
return NGCP::Panel::Utils::Journal::get_api_journal_action_config('api/' . $resource_name,$action_template,$class->get_journal_methods);
|
||||
}
|
||||
return [];
|
||||
}
|
||||
|
||||
sub get_journal_query_params {
|
||||
my ($class,$query_params) = @_;
|
||||
return NGCP::Panel::Utils::Journal::get_api_journal_query_params($query_params);
|
||||
}
|
||||
|
||||
sub handle_item_base_journal {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_item_base_journal(@_);
|
||||
}
|
||||
|
||||
sub handle_journals_get {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journals_get(@_);
|
||||
}
|
||||
|
||||
sub handle_journalsitem_get {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journalsitem_get(@_);
|
||||
}
|
||||
|
||||
sub handle_journals_options {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journals_options(@_);
|
||||
}
|
||||
|
||||
sub handle_journalsitem_options {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journalsitem_options(@_);
|
||||
}
|
||||
|
||||
sub handle_journals_head {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journals_head(@_);
|
||||
}
|
||||
|
||||
sub handle_journalsitem_head {
|
||||
return NGCP::Panel::Utils::Journal::handle_api_journalsitem_head(@_);
|
||||
}
|
||||
|
||||
sub get_journal_relation_link {
|
||||
my $cfg = NGCP::Panel::Utils::Journal::get_journal_resource_config(NGCP::Panel->config,$_[0]->resource_name);
|
||||
if ($cfg->{journal_resource_enabled}) {
|
||||
return NGCP::Panel::Utils::Journal::get_journal_relation_link(@_);
|
||||
}
|
||||
return ();
|
||||
}
|
||||
1;
|
||||
|
||||
@ -1,111 +1,111 @@
|
||||
package NGCP::Panel::Utils::API::Calllist;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use HTTP::Status qw(:constants);
|
||||
|
||||
|
||||
sub get_owner_data {
|
||||
my ($self, $c, $schema, $source) = @_;
|
||||
|
||||
my $ret;
|
||||
$source //= $c->req->params;
|
||||
my $src_subscriber_id = $source->{subscriber_id};
|
||||
my $src_customer_id = $source->{customer_id};
|
||||
|
||||
if($c->user->roles eq "admin" || $c->user->roles eq "reseller") {
|
||||
if($src_subscriber_id) {
|
||||
my $sub = $schema->resultset('voip_subscribers')->find($src_subscriber_id);
|
||||
unless($sub) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
if($c->user->roles eq "reseller" && $sub->contract->contact->reseller_id != $c->user->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => $sub,
|
||||
customer => $sub->contract,
|
||||
};
|
||||
} elsif($src_customer_id) {
|
||||
my $cust = $schema->resultset('contracts')->find($src_customer_id);
|
||||
unless($cust && $cust->contact->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'customer_id'.");
|
||||
return;
|
||||
}
|
||||
if($c->user->roles eq "reseller" && $cust->contact->reseller_id != $c->user->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'customer_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => undef,
|
||||
customer => $cust,
|
||||
};
|
||||
} else {
|
||||
$self->error($c, HTTP_UNPROCESSABLE_ENTITY, "Mandatory parameter 'subscriber_id' or 'customer_id' missing in request");
|
||||
return;
|
||||
}
|
||||
} elsif($c->user->roles eq "subscriberadmin") {
|
||||
if($src_subscriber_id) {
|
||||
my $sub = $schema->resultset('voip_subscribers')->find($src_subscriber_id);
|
||||
unless($sub) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
if($sub->contract_id != $c->user->account_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => $sub,
|
||||
customer => $sub->contract,
|
||||
};
|
||||
} else {
|
||||
my $cust = $schema->resultset('contracts')->find($c->user->account_id);
|
||||
unless($cust && $cust->contact->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'customer_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => undef,
|
||||
customer => $cust,
|
||||
};
|
||||
}
|
||||
} elsif($c->user->roles eq "subscriber") {
|
||||
return {
|
||||
subscriber => $c->user->voip_subscriber,
|
||||
customer => $c->user->voip_subscriber->contract,
|
||||
};
|
||||
} else {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Unknown role '".$c->user->roles."' of the user.");
|
||||
return;
|
||||
}
|
||||
}
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
NGCP::Panel::Utils::API::Calllist
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A temporary helper to manipulate calls related data in REST API modules
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 get_owner_data
|
||||
|
||||
Check if mandatory calls list parameters customer_id or subscriber_id are presented and get proper objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Irina Peshinskaya
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
This library is free software. You can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
# vim: set tabstop=4 expandtab:
|
||||
package NGCP::Panel::Utils::API::Calllist;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use HTTP::Status qw(:constants);
|
||||
|
||||
|
||||
sub get_owner_data {
|
||||
my ($self, $c, $schema, $source) = @_;
|
||||
|
||||
my $ret;
|
||||
$source //= $c->req->params;
|
||||
my $src_subscriber_id = $source->{subscriber_id};
|
||||
my $src_customer_id = $source->{customer_id};
|
||||
|
||||
if($c->user->roles eq "admin" || $c->user->roles eq "reseller") {
|
||||
if($src_subscriber_id) {
|
||||
my $sub = $schema->resultset('voip_subscribers')->find($src_subscriber_id);
|
||||
unless($sub) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
if($c->user->roles eq "reseller" && $sub->contract->contact->reseller_id != $c->user->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => $sub,
|
||||
customer => $sub->contract,
|
||||
};
|
||||
} elsif($src_customer_id) {
|
||||
my $cust = $schema->resultset('contracts')->find($src_customer_id);
|
||||
unless($cust && $cust->contact->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'customer_id'.");
|
||||
return;
|
||||
}
|
||||
if($c->user->roles eq "reseller" && $cust->contact->reseller_id != $c->user->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'customer_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => undef,
|
||||
customer => $cust,
|
||||
};
|
||||
} else {
|
||||
$self->error($c, HTTP_UNPROCESSABLE_ENTITY, "Mandatory parameter 'subscriber_id' or 'customer_id' missing in request");
|
||||
return;
|
||||
}
|
||||
} elsif($c->user->roles eq "subscriberadmin") {
|
||||
if($src_subscriber_id) {
|
||||
my $sub = $schema->resultset('voip_subscribers')->find($src_subscriber_id);
|
||||
unless($sub) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
if($sub->contract_id != $c->user->account_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'subscriber_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => $sub,
|
||||
customer => $sub->contract,
|
||||
};
|
||||
} else {
|
||||
my $cust = $schema->resultset('contracts')->find($c->user->account_id);
|
||||
unless($cust && $cust->contact->reseller_id) {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Invalid 'customer_id'.");
|
||||
return;
|
||||
}
|
||||
return {
|
||||
subscriber => undef,
|
||||
customer => $cust,
|
||||
};
|
||||
}
|
||||
} elsif($c->user->roles eq "subscriber") {
|
||||
return {
|
||||
subscriber => $c->user->voip_subscriber,
|
||||
customer => $c->user->voip_subscriber->contract,
|
||||
};
|
||||
} else {
|
||||
$self->error($c, HTTP_NOT_FOUND, "Unknown role '".$c->user->roles."' of the user.");
|
||||
return;
|
||||
}
|
||||
}
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
NGCP::Panel::Utils::API::Calllist
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A temporary helper to manipulate calls related data in REST API modules
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 get_owner_data
|
||||
|
||||
Check if mandatory calls list parameters customer_id or subscriber_id are presented and get proper objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Irina Peshinskaya
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
This library is free software. You can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
# vim: set tabstop=4 expandtab:
|
||||
|
||||
@ -1,66 +1,66 @@
|
||||
package NGCP::Panel::Utils::API::Subscribers;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use HTTP::Status qw(:constants);
|
||||
|
||||
sub get_active_subscriber{
|
||||
my($api, $c, $id, $params) = @_;
|
||||
|
||||
my $sub_rs = $c->model('DB')->resultset('voip_subscribers')->search({
|
||||
'me.id' => $id,
|
||||
'me.status' => { '!=' => 'terminated' },
|
||||
});
|
||||
if($c->user->roles eq "admin") {
|
||||
} elsif($c->user->roles eq "reseller") {
|
||||
$sub_rs = $sub_rs->search({
|
||||
'contact.reseller_id' => $c->user->reseller_id,
|
||||
},{
|
||||
join => { contract => 'contact' },
|
||||
});
|
||||
} elsif($c->user->roles eq "subscriberadmin") {
|
||||
$sub_rs = $sub_rs->search({
|
||||
'contract.id' => $c->user->account_id,
|
||||
},{
|
||||
join => { 'contract' },
|
||||
});
|
||||
} elsif($c->user->roles eq "subscriber") {
|
||||
$sub_rs = $sub_rs->search({
|
||||
'me.uuid' => $c->user->uuid,
|
||||
});
|
||||
}
|
||||
my $sub = $sub_rs->first;
|
||||
unless($sub && $sub->provisioning_voip_subscriber) {
|
||||
$c->log->error($params->{error_log} ? $params->{error_log} : "invalid subscriber_id '$id'"); # TODO: user, message, trace, ...
|
||||
$api->error($c, HTTP_UNPROCESSABLE_ENTITY, $params->{error} ? $params->{error} : "No subscriber for subscriber_id found");
|
||||
return;
|
||||
}
|
||||
return $sub;
|
||||
}
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
NGCP::Panel::Utils::API::Subscribers
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A temporary helper to manipulate subscribers related data in REST API modules
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 get_active_subscriber
|
||||
|
||||
Get subscriber NGCP::Schema::Result object of the active subscriber by the mandatory form parameter subscriber_id.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Irina Peshinskaya
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
This library is free software. You can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
# vim: set tabstop=4 expandtab:
|
||||
package NGCP::Panel::Utils::API::Subscribers;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use HTTP::Status qw(:constants);
|
||||
|
||||
sub get_active_subscriber{
|
||||
my($api, $c, $id, $params) = @_;
|
||||
|
||||
my $sub_rs = $c->model('DB')->resultset('voip_subscribers')->search({
|
||||
'me.id' => $id,
|
||||
'me.status' => { '!=' => 'terminated' },
|
||||
});
|
||||
if($c->user->roles eq "admin") {
|
||||
} elsif($c->user->roles eq "reseller") {
|
||||
$sub_rs = $sub_rs->search({
|
||||
'contact.reseller_id' => $c->user->reseller_id,
|
||||
},{
|
||||
join => { contract => 'contact' },
|
||||
});
|
||||
} elsif($c->user->roles eq "subscriberadmin") {
|
||||
$sub_rs = $sub_rs->search({
|
||||
'contract.id' => $c->user->account_id,
|
||||
},{
|
||||
join => { 'contract' },
|
||||
});
|
||||
} elsif($c->user->roles eq "subscriber") {
|
||||
$sub_rs = $sub_rs->search({
|
||||
'me.uuid' => $c->user->uuid,
|
||||
});
|
||||
}
|
||||
my $sub = $sub_rs->first;
|
||||
unless($sub && $sub->provisioning_voip_subscriber) {
|
||||
$c->log->error($params->{error_log} ? $params->{error_log} : "invalid subscriber_id '$id'"); # TODO: user, message, trace, ...
|
||||
$api->error($c, HTTP_UNPROCESSABLE_ENTITY, $params->{error} ? $params->{error} : "No subscriber for subscriber_id found");
|
||||
return;
|
||||
}
|
||||
return $sub;
|
||||
}
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
NGCP::Panel::Utils::API::Subscribers
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A temporary helper to manipulate subscribers related data in REST API modules
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 get_active_subscriber
|
||||
|
||||
Get subscriber NGCP::Schema::Result object of the active subscriber by the mandatory form parameter subscriber_id.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Irina Peshinskaya
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
This library is free software. You can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
# vim: set tabstop=4 expandtab:
|
||||
|
||||
@ -1,251 +1,251 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
use NGCP::Schema;
|
||||
use NGCP::Panel::Utils::Subscriber;
|
||||
use NGCP::Panel::Utils::Preferences;
|
||||
use Test::More;
|
||||
use Data::HAL qw();
|
||||
use Data::HAL::Link qw();
|
||||
use Safe::Isa qw($_isa);
|
||||
use NGCP::Panel::Form::CFSimpleAPI;
|
||||
|
||||
my $schema = NGCP::Schema->connect();
|
||||
my $ql_exists = 0;
|
||||
my ($ql,$ana);
|
||||
|
||||
if($ql_exists){
|
||||
#use DBIx::Class::QueryLog;
|
||||
#use DBIx::Class::QueryLog::Analyzer;
|
||||
my $ql = DBIx::Class::QueryLog->new;
|
||||
$schema->storage->debugobj($ql);
|
||||
$schema->storage->debug(1);
|
||||
my $ana = DBIx::Class::QueryLog::Analyzer->new({ querylog => $ql });
|
||||
$ql->bucket('origin');
|
||||
}
|
||||
|
||||
my $time = time();
|
||||
print "start;\n";
|
||||
#print Dumper($schema);
|
||||
|
||||
my $item_rs = $schema->resultset('voip_subscribers')->search( {
|
||||
'me.status' => { '!=' => 'terminated' }
|
||||
},{
|
||||
prefetch => { 'provisioning_voip_subscriber'=>'voip_cf_mappings'},
|
||||
#prefetch => 'provisioning_voip_subscriber',
|
||||
rows => 200,
|
||||
},
|
||||
);
|
||||
my (@arr_orig,@arr_opt);
|
||||
for my $item ($item_rs->all) {
|
||||
# print Dumper({$item->get_inflated_columns});
|
||||
my %resource = ();
|
||||
my $prov_subs = $item->provisioning_voip_subscriber;
|
||||
for my $cf_type (qw/cfu cfb cft cfna cfs/) {
|
||||
my $mapping = $schema->resultset('voip_cf_mappings')->search({
|
||||
subscriber_id => $prov_subs->id,
|
||||
type => $cf_type,
|
||||
})->first;
|
||||
if ($mapping) {
|
||||
$resource{$cf_type} = _contents_from_cfm($mapping, $item);
|
||||
} else {
|
||||
$resource{$cf_type} = {};
|
||||
}
|
||||
}
|
||||
if(keys %{$resource{cft}}){
|
||||
my $ringtimeout_preference = NGCP::Panel::Utils::Preferences::get_usr_preference_rs(
|
||||
c => undef, attribute => 'ringtimeout', prov_subscriber => $prov_subs, schema => $schema )->first;
|
||||
$ringtimeout_preference = $ringtimeout_preference ? $ringtimeout_preference->value : undef;
|
||||
$resource{cft}{ringtimeout} = $ringtimeout_preference;
|
||||
}
|
||||
additional_processing($item, \%resource);
|
||||
push @arr_orig, \%resource;
|
||||
}
|
||||
print "1.time=".(time()-$time).";\n";
|
||||
#exit;
|
||||
if($ql_exists){
|
||||
$ql->bucket('optimized');
|
||||
}
|
||||
$time = time();
|
||||
|
||||
for my $item ($item_rs->all) {
|
||||
my %resource = ();
|
||||
my $prov_subs = $item->provisioning_voip_subscriber;
|
||||
@resource{qw/cfu cfb cft cfna cfs/} = ({}) x 5;
|
||||
for my $item_cf ($item->provisioning_voip_subscriber->voip_cf_mappings->all){
|
||||
$resource{$item_cf->type} = _contents_from_cfm($item_cf, $item);
|
||||
}
|
||||
if(keys %{$resource{cft}}){
|
||||
my $ringtimeout_preference = NGCP::Panel::Utils::Preferences::get_usr_preference_rs(
|
||||
c => undef, attribute => 'ringtimeout', prov_subscriber => $prov_subs, schema => $schema )->first;
|
||||
$ringtimeout_preference = $ringtimeout_preference ? $ringtimeout_preference->value : undef;
|
||||
$resource{cft}{ringtimeout} = $ringtimeout_preference;
|
||||
}
|
||||
additional_processing($item, \%resource);
|
||||
push @arr_opt, \%resource;
|
||||
}
|
||||
print "2.time=".(time()-$time).";\n";
|
||||
|
||||
is_deeply(\@arr_orig, \@arr_opt, "check that arrays are equiv");
|
||||
#print Dumper[\@arr_orig, \@arr_opt];
|
||||
if($ql_exists){
|
||||
print Dumper $ana->get_totaled_queries_by_bucket;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub additional_processing{
|
||||
my($item,$resource) = @_;
|
||||
my $type='';
|
||||
my %resource=%$resource;
|
||||
my $hal = Data::HAL->new(
|
||||
links => [
|
||||
Data::HAL::Link->new(
|
||||
relation => 'curies',
|
||||
href => 'http://purl.org/sipwise/ngcp-api/#rel-{rel}',
|
||||
name => 'ngcp',
|
||||
templated => 1,
|
||||
),
|
||||
Data::HAL::Link->new(relation => 'collection', href => sprintf("%s", '')),
|
||||
Data::HAL::Link->new(relation => 'profile', href => 'http://purl.org/sipwise/ngcp-api/'),
|
||||
Data::HAL::Link->new(relation => 'self', href => sprintf("%s%s", '', $item->id)),
|
||||
Data::HAL::Link->new(relation => "ngcp:$type", href => sprintf("/api/%s/%s", $type, $item->id)),
|
||||
Data::HAL::Link->new(relation => 'ngcp:subscribers', href => sprintf("/api/subscribers/%d", $item->id)),
|
||||
],
|
||||
relation => 'ngcp:callforwards',
|
||||
);
|
||||
my $form=NGCP::Panel::Form::CFSimpleAPI->new();
|
||||
|
||||
validate_form(
|
||||
form => $form,
|
||||
resource => \%resource,
|
||||
run => 0,
|
||||
);
|
||||
|
||||
$hal->resource(\%resource);
|
||||
|
||||
}
|
||||
sub _contents_from_cfm {
|
||||
my ($cfm_item, $sub) = @_;
|
||||
my (@times, @destinations);
|
||||
my $timeset_item = $cfm_item->time_set;
|
||||
my $dset_item = $cfm_item->destination_set;
|
||||
for my $time ($timeset_item ? $timeset_item->voip_cf_periods->all : () ) {
|
||||
push @times, {$time->get_inflated_columns};
|
||||
delete @{$times[-1]}{'time_set_id', 'id'};
|
||||
}
|
||||
for my $dest ($dset_item ? $dset_item->voip_cf_destinations->all : () ) {
|
||||
my ($d, $duri) = NGCP::Panel::Utils::Subscriber::destination_to_field($dest->destination);
|
||||
my $deflated;
|
||||
if($d eq "uri") {
|
||||
$deflated = NGCP::Panel::Utils::Subscriber::uri_deflate(undef, $duri,$sub) if $d eq "uri";
|
||||
$d = $dest->destination;
|
||||
}
|
||||
push @destinations, {$dest->get_inflated_columns,
|
||||
destination => $d,
|
||||
$deflated ? (simple_destination => $deflated) : (),
|
||||
};
|
||||
delete @{$destinations[-1]}{'destination_set_id', 'id'};
|
||||
}
|
||||
return {times => \@times, destinations => \@destinations};
|
||||
}
|
||||
sub validate_form {
|
||||
my (%params) = @_;
|
||||
|
||||
my $resource = $params{resource};
|
||||
my $form = $params{form};
|
||||
my $run = $params{run} // 1;
|
||||
my $exceptions = $params{exceptions} // [];
|
||||
my $form_params = $params{form_params} // {};
|
||||
push @{ $exceptions }, "external_id";
|
||||
|
||||
my @normalized = ();
|
||||
|
||||
# move {xxx_id} into {xxx}{id} for FormHandler
|
||||
foreach my $key(keys %{ $resource } ) {
|
||||
my $skip_normalize = grep {/^$key$/} @{ $exceptions };
|
||||
if($key =~ /^(.+)_id$/ && !$skip_normalize && !exists $resource->{$1}) {
|
||||
push @normalized, $1;
|
||||
$resource->{$1}{id} = delete $resource->{$key};
|
||||
}
|
||||
}
|
||||
|
||||
# remove unknown keys
|
||||
my %fields = map { $_->name => $_ } $form->fields;
|
||||
validate_fields($resource, \%fields, $run);
|
||||
|
||||
if($run) {
|
||||
# check keys/vals
|
||||
$form->process(params => $resource, posted => 1, %{$form_params} );
|
||||
unless($form->validated) {
|
||||
my $e = join '; ', map {
|
||||
sprintf 'field=\'%s\', input=\'%s\', errors=\'%s\'',
|
||||
($_->parent->$_isa('HTML::FormHandler::Field') ? $_->parent->name . '_' : '') . $_->name,
|
||||
$_->input // '',
|
||||
join('', @{ $_->errors })
|
||||
} $form->error_fields;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# move {xxx}{id} back into {xxx_id} for DB
|
||||
foreach my $key(@normalized) {
|
||||
next unless(exists $resource->{$key});
|
||||
$resource->{$key . '_id'} = defined($resource->{$key}{id}) ?
|
||||
int($resource->{$key}{id}) :
|
||||
$resource->{$key}{id};
|
||||
delete $resource->{$key};
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub validate_fields {
|
||||
my ($resource, $fields, $run) = @_;
|
||||
|
||||
for my $k (keys %{ $resource }) {
|
||||
#if($resource->{$k}->$_isa('JSON::XS::Boolean') || $resource->{$k}->$_isa('JSON::PP::Boolean')) {
|
||||
if($resource->{$k}->$_isa('JSON::PP::Boolean')) {
|
||||
$resource->{$k} = $resource->{$k} ? 1 : 0;
|
||||
}
|
||||
unless(exists $fields->{$k}) {
|
||||
delete $resource->{$k};
|
||||
}
|
||||
$resource->{$k} = DateTime::Format::RFC3339->format_datetime($resource->{$k})
|
||||
if $resource->{$k}->$_isa('DateTime');
|
||||
$resource->{$k} = $resource->{$k} + 0
|
||||
if(defined $resource->{$k} && (
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Integer') ||
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Money') ||
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Float')) &&
|
||||
(is_int($resource->{$k}) || is_decimal($resource->{$k})));
|
||||
|
||||
if (defined $resource->{$k} &&
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Repeatable') &&
|
||||
"ARRAY" eq ref $resource->{$k} ) {
|
||||
for my $elem (@{ $resource->{$k} }) {
|
||||
my ($subfield_instance) = $fields->{$k}->fields;
|
||||
my %subfields = map { $_->name => $_ } $subfield_instance->fields;
|
||||
validate_fields($elem, \%subfields, $run);
|
||||
}
|
||||
}
|
||||
|
||||
# only do this for converting back from obj to hal
|
||||
# otherwise it breaks db fields with the \0 and \1 notation
|
||||
unless($run) {
|
||||
$resource->{$k} = $resource->{$k} ? JSON::true : JSON::false
|
||||
if(defined $resource->{$k} &&
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Boolean'));
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
use NGCP::Schema;
|
||||
use NGCP::Panel::Utils::Subscriber;
|
||||
use NGCP::Panel::Utils::Preferences;
|
||||
use Test::More;
|
||||
use Data::HAL qw();
|
||||
use Data::HAL::Link qw();
|
||||
use Safe::Isa qw($_isa);
|
||||
use NGCP::Panel::Form::CFSimpleAPI;
|
||||
|
||||
my $schema = NGCP::Schema->connect();
|
||||
my $ql_exists = 0;
|
||||
my ($ql,$ana);
|
||||
|
||||
if($ql_exists){
|
||||
#use DBIx::Class::QueryLog;
|
||||
#use DBIx::Class::QueryLog::Analyzer;
|
||||
my $ql = DBIx::Class::QueryLog->new;
|
||||
$schema->storage->debugobj($ql);
|
||||
$schema->storage->debug(1);
|
||||
my $ana = DBIx::Class::QueryLog::Analyzer->new({ querylog => $ql });
|
||||
$ql->bucket('origin');
|
||||
}
|
||||
|
||||
my $time = time();
|
||||
print "start;\n";
|
||||
#print Dumper($schema);
|
||||
|
||||
my $item_rs = $schema->resultset('voip_subscribers')->search( {
|
||||
'me.status' => { '!=' => 'terminated' }
|
||||
},{
|
||||
prefetch => { 'provisioning_voip_subscriber'=>'voip_cf_mappings'},
|
||||
#prefetch => 'provisioning_voip_subscriber',
|
||||
rows => 200,
|
||||
},
|
||||
);
|
||||
my (@arr_orig,@arr_opt);
|
||||
for my $item ($item_rs->all) {
|
||||
# print Dumper({$item->get_inflated_columns});
|
||||
my %resource = ();
|
||||
my $prov_subs = $item->provisioning_voip_subscriber;
|
||||
for my $cf_type (qw/cfu cfb cft cfna cfs/) {
|
||||
my $mapping = $schema->resultset('voip_cf_mappings')->search({
|
||||
subscriber_id => $prov_subs->id,
|
||||
type => $cf_type,
|
||||
})->first;
|
||||
if ($mapping) {
|
||||
$resource{$cf_type} = _contents_from_cfm($mapping, $item);
|
||||
} else {
|
||||
$resource{$cf_type} = {};
|
||||
}
|
||||
}
|
||||
if(keys %{$resource{cft}}){
|
||||
my $ringtimeout_preference = NGCP::Panel::Utils::Preferences::get_usr_preference_rs(
|
||||
c => undef, attribute => 'ringtimeout', prov_subscriber => $prov_subs, schema => $schema )->first;
|
||||
$ringtimeout_preference = $ringtimeout_preference ? $ringtimeout_preference->value : undef;
|
||||
$resource{cft}{ringtimeout} = $ringtimeout_preference;
|
||||
}
|
||||
additional_processing($item, \%resource);
|
||||
push @arr_orig, \%resource;
|
||||
}
|
||||
print "1.time=".(time()-$time).";\n";
|
||||
#exit;
|
||||
if($ql_exists){
|
||||
$ql->bucket('optimized');
|
||||
}
|
||||
$time = time();
|
||||
|
||||
for my $item ($item_rs->all) {
|
||||
my %resource = ();
|
||||
my $prov_subs = $item->provisioning_voip_subscriber;
|
||||
@resource{qw/cfu cfb cft cfna cfs/} = ({}) x 5;
|
||||
for my $item_cf ($item->provisioning_voip_subscriber->voip_cf_mappings->all){
|
||||
$resource{$item_cf->type} = _contents_from_cfm($item_cf, $item);
|
||||
}
|
||||
if(keys %{$resource{cft}}){
|
||||
my $ringtimeout_preference = NGCP::Panel::Utils::Preferences::get_usr_preference_rs(
|
||||
c => undef, attribute => 'ringtimeout', prov_subscriber => $prov_subs, schema => $schema )->first;
|
||||
$ringtimeout_preference = $ringtimeout_preference ? $ringtimeout_preference->value : undef;
|
||||
$resource{cft}{ringtimeout} = $ringtimeout_preference;
|
||||
}
|
||||
additional_processing($item, \%resource);
|
||||
push @arr_opt, \%resource;
|
||||
}
|
||||
print "2.time=".(time()-$time).";\n";
|
||||
|
||||
is_deeply(\@arr_orig, \@arr_opt, "check that arrays are equiv");
|
||||
#print Dumper[\@arr_orig, \@arr_opt];
|
||||
if($ql_exists){
|
||||
print Dumper $ana->get_totaled_queries_by_bucket;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub additional_processing{
|
||||
my($item,$resource) = @_;
|
||||
my $type='';
|
||||
my %resource=%$resource;
|
||||
my $hal = Data::HAL->new(
|
||||
links => [
|
||||
Data::HAL::Link->new(
|
||||
relation => 'curies',
|
||||
href => 'http://purl.org/sipwise/ngcp-api/#rel-{rel}',
|
||||
name => 'ngcp',
|
||||
templated => 1,
|
||||
),
|
||||
Data::HAL::Link->new(relation => 'collection', href => sprintf("%s", '')),
|
||||
Data::HAL::Link->new(relation => 'profile', href => 'http://purl.org/sipwise/ngcp-api/'),
|
||||
Data::HAL::Link->new(relation => 'self', href => sprintf("%s%s", '', $item->id)),
|
||||
Data::HAL::Link->new(relation => "ngcp:$type", href => sprintf("/api/%s/%s", $type, $item->id)),
|
||||
Data::HAL::Link->new(relation => 'ngcp:subscribers', href => sprintf("/api/subscribers/%d", $item->id)),
|
||||
],
|
||||
relation => 'ngcp:callforwards',
|
||||
);
|
||||
my $form=NGCP::Panel::Form::CFSimpleAPI->new();
|
||||
|
||||
validate_form(
|
||||
form => $form,
|
||||
resource => \%resource,
|
||||
run => 0,
|
||||
);
|
||||
|
||||
$hal->resource(\%resource);
|
||||
|
||||
}
|
||||
sub _contents_from_cfm {
|
||||
my ($cfm_item, $sub) = @_;
|
||||
my (@times, @destinations);
|
||||
my $timeset_item = $cfm_item->time_set;
|
||||
my $dset_item = $cfm_item->destination_set;
|
||||
for my $time ($timeset_item ? $timeset_item->voip_cf_periods->all : () ) {
|
||||
push @times, {$time->get_inflated_columns};
|
||||
delete @{$times[-1]}{'time_set_id', 'id'};
|
||||
}
|
||||
for my $dest ($dset_item ? $dset_item->voip_cf_destinations->all : () ) {
|
||||
my ($d, $duri) = NGCP::Panel::Utils::Subscriber::destination_to_field($dest->destination);
|
||||
my $deflated;
|
||||
if($d eq "uri") {
|
||||
$deflated = NGCP::Panel::Utils::Subscriber::uri_deflate(undef, $duri,$sub) if $d eq "uri";
|
||||
$d = $dest->destination;
|
||||
}
|
||||
push @destinations, {$dest->get_inflated_columns,
|
||||
destination => $d,
|
||||
$deflated ? (simple_destination => $deflated) : (),
|
||||
};
|
||||
delete @{$destinations[-1]}{'destination_set_id', 'id'};
|
||||
}
|
||||
return {times => \@times, destinations => \@destinations};
|
||||
}
|
||||
sub validate_form {
|
||||
my (%params) = @_;
|
||||
|
||||
my $resource = $params{resource};
|
||||
my $form = $params{form};
|
||||
my $run = $params{run} // 1;
|
||||
my $exceptions = $params{exceptions} // [];
|
||||
my $form_params = $params{form_params} // {};
|
||||
push @{ $exceptions }, "external_id";
|
||||
|
||||
my @normalized = ();
|
||||
|
||||
# move {xxx_id} into {xxx}{id} for FormHandler
|
||||
foreach my $key(keys %{ $resource } ) {
|
||||
my $skip_normalize = grep {/^$key$/} @{ $exceptions };
|
||||
if($key =~ /^(.+)_id$/ && !$skip_normalize && !exists $resource->{$1}) {
|
||||
push @normalized, $1;
|
||||
$resource->{$1}{id} = delete $resource->{$key};
|
||||
}
|
||||
}
|
||||
|
||||
# remove unknown keys
|
||||
my %fields = map { $_->name => $_ } $form->fields;
|
||||
validate_fields($resource, \%fields, $run);
|
||||
|
||||
if($run) {
|
||||
# check keys/vals
|
||||
$form->process(params => $resource, posted => 1, %{$form_params} );
|
||||
unless($form->validated) {
|
||||
my $e = join '; ', map {
|
||||
sprintf 'field=\'%s\', input=\'%s\', errors=\'%s\'',
|
||||
($_->parent->$_isa('HTML::FormHandler::Field') ? $_->parent->name . '_' : '') . $_->name,
|
||||
$_->input // '',
|
||||
join('', @{ $_->errors })
|
||||
} $form->error_fields;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# move {xxx}{id} back into {xxx_id} for DB
|
||||
foreach my $key(@normalized) {
|
||||
next unless(exists $resource->{$key});
|
||||
$resource->{$key . '_id'} = defined($resource->{$key}{id}) ?
|
||||
int($resource->{$key}{id}) :
|
||||
$resource->{$key}{id};
|
||||
delete $resource->{$key};
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub validate_fields {
|
||||
my ($resource, $fields, $run) = @_;
|
||||
|
||||
for my $k (keys %{ $resource }) {
|
||||
#if($resource->{$k}->$_isa('JSON::XS::Boolean') || $resource->{$k}->$_isa('JSON::PP::Boolean')) {
|
||||
if($resource->{$k}->$_isa('JSON::PP::Boolean')) {
|
||||
$resource->{$k} = $resource->{$k} ? 1 : 0;
|
||||
}
|
||||
unless(exists $fields->{$k}) {
|
||||
delete $resource->{$k};
|
||||
}
|
||||
$resource->{$k} = DateTime::Format::RFC3339->format_datetime($resource->{$k})
|
||||
if $resource->{$k}->$_isa('DateTime');
|
||||
$resource->{$k} = $resource->{$k} + 0
|
||||
if(defined $resource->{$k} && (
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Integer') ||
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Money') ||
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Float')) &&
|
||||
(is_int($resource->{$k}) || is_decimal($resource->{$k})));
|
||||
|
||||
if (defined $resource->{$k} &&
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Repeatable') &&
|
||||
"ARRAY" eq ref $resource->{$k} ) {
|
||||
for my $elem (@{ $resource->{$k} }) {
|
||||
my ($subfield_instance) = $fields->{$k}->fields;
|
||||
my %subfields = map { $_->name => $_ } $subfield_instance->fields;
|
||||
validate_fields($elem, \%subfields, $run);
|
||||
}
|
||||
}
|
||||
|
||||
# only do this for converting back from obj to hal
|
||||
# otherwise it breaks db fields with the \0 and \1 notation
|
||||
unless($run) {
|
||||
$resource->{$k} = $resource->{$k} ? JSON::true : JSON::false
|
||||
if(defined $resource->{$k} &&
|
||||
$fields->{$k}->$_isa('HTML::FormHandler::Field::Boolean'));
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@ -1,13 +1,13 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
use NGCP::Panel::Form::CFSimpleAPI;
|
||||
|
||||
for(my $i=0; $i<200;$i++){
|
||||
my $form=NGCP::Panel::Form::CFSimpleAPI->new();
|
||||
}
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
use NGCP::Panel::Form::CFSimpleAPI;
|
||||
|
||||
for(my $i=0; $i<200;$i++){
|
||||
my $form=NGCP::Panel::Form::CFSimpleAPI->new();
|
||||
}
|
||||
1;
|
||||
@ -1,58 +1,58 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
use NGCP::Schema;
|
||||
use NGCP::Panel::Utils::Preferences;
|
||||
use NGCP::Panel::Utils::Generic qw(:all);
|
||||
use Safe::Isa qw($_isa);
|
||||
|
||||
my $logger = Log::Log4perl->get_logger('NGCP::Panel');
|
||||
my $schema = NGCP::Schema->connect();
|
||||
my $dbh = $schema->storage->dbh;
|
||||
use Test::MockObject;
|
||||
my $c_mock = Test::MockObject->new();
|
||||
my $user_mock = Test::MockObject->new();
|
||||
$user_mock->set_always( 'roles' => 'reseller' );
|
||||
$c_mock->set_always( 'log' => $logger )->set_always( 'model' => $schema )->set_always( 'user' => $user_mock );
|
||||
|
||||
|
||||
|
||||
my $cnt = 1000;
|
||||
my $devmod_id = 1;
|
||||
|
||||
|
||||
my $time = time;
|
||||
for(my $i=0; $i<$cnt; $i++){
|
||||
my $dev_pref_rs = NGCP::Panel::Utils::Preferences::get_preferences_rs(
|
||||
c => $c_mock,
|
||||
type => 'dev',
|
||||
id => $devmod_id,
|
||||
);
|
||||
my $pref_values = get_inflated_columns_all($dev_pref_rs,'hash' => 'attribute', 'column' => 'value', 'force_array' => 1);
|
||||
}
|
||||
print "pure.time=".(time-$time).";\n";
|
||||
|
||||
my $time = time;
|
||||
for(my $i=0; $i<$cnt; $i++){
|
||||
my $devprof_pref_rs = $c_mock->model('DB')
|
||||
->resultset('voip_preferences')
|
||||
->search({
|
||||
'profile.id' => $devmod_id,
|
||||
},{
|
||||
prefetch => {'voip_devprof_preferences' => 'profile'},
|
||||
});
|
||||
my %pref_values;
|
||||
foreach my $value($devprof_pref_rs->all) {
|
||||
$pref_values{$value->attribute} =
|
||||
[ map {$_->value} $value->voip_devprof_preferences->all ];
|
||||
}
|
||||
}
|
||||
print "DBIx.time=".(time-$time).";\n";
|
||||
|
||||
#pure.time=5;
|
||||
#DBIx.time=14;
|
||||
r
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
use NGCP::Schema;
|
||||
use NGCP::Panel::Utils::Preferences;
|
||||
use NGCP::Panel::Utils::Generic qw(:all);
|
||||
use Safe::Isa qw($_isa);
|
||||
|
||||
my $logger = Log::Log4perl->get_logger('NGCP::Panel');
|
||||
my $schema = NGCP::Schema->connect();
|
||||
my $dbh = $schema->storage->dbh;
|
||||
use Test::MockObject;
|
||||
my $c_mock = Test::MockObject->new();
|
||||
my $user_mock = Test::MockObject->new();
|
||||
$user_mock->set_always( 'roles' => 'reseller' );
|
||||
$c_mock->set_always( 'log' => $logger )->set_always( 'model' => $schema )->set_always( 'user' => $user_mock );
|
||||
|
||||
|
||||
|
||||
my $cnt = 1000;
|
||||
my $devmod_id = 1;
|
||||
|
||||
|
||||
my $time = time;
|
||||
for(my $i=0; $i<$cnt; $i++){
|
||||
my $dev_pref_rs = NGCP::Panel::Utils::Preferences::get_preferences_rs(
|
||||
c => $c_mock,
|
||||
type => 'dev',
|
||||
id => $devmod_id,
|
||||
);
|
||||
my $pref_values = get_inflated_columns_all($dev_pref_rs,'hash' => 'attribute', 'column' => 'value', 'force_array' => 1);
|
||||
}
|
||||
print "pure.time=".(time-$time).";\n";
|
||||
|
||||
my $time = time;
|
||||
for(my $i=0; $i<$cnt; $i++){
|
||||
my $devprof_pref_rs = $c_mock->model('DB')
|
||||
->resultset('voip_preferences')
|
||||
->search({
|
||||
'profile.id' => $devmod_id,
|
||||
},{
|
||||
prefetch => {'voip_devprof_preferences' => 'profile'},
|
||||
});
|
||||
my %pref_values;
|
||||
foreach my $value($devprof_pref_rs->all) {
|
||||
$pref_values{$value->attribute} =
|
||||
[ map {$_->value} $value->voip_devprof_preferences->all ];
|
||||
}
|
||||
}
|
||||
print "DBIx.time=".(time-$time).";\n";
|
||||
|
||||
#pure.time=5;
|
||||
#DBIx.time=14;
|
||||
r
|
||||
1;
|
||||
@ -1,29 +1,29 @@
|
||||
package Parent;
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = 1.23;
|
||||
|
||||
sub VERSION { $VERSION }
|
||||
|
||||
sub child_version { $_[0]->VERSION }
|
||||
|
||||
package Child;
|
||||
use base qw(Parent);
|
||||
|
||||
our $VERSION = 5.43;
|
||||
|
||||
sub VERSION { $VERSION }
|
||||
|
||||
sub new { bless {}, $_[0]; }
|
||||
|
||||
sub parent_version { $_[0]->SUPER::VERSION }
|
||||
|
||||
|
||||
print "Child version is ", Child->VERSION, "\n"; # 5.43
|
||||
my $child = Child->new;
|
||||
|
||||
print "Child version: ", $child->VERSION, "\n"; # 5.43
|
||||
print "Parent version: ", $child->parent_version, "\n"; # 1.23
|
||||
package Parent;
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
our $VERSION = 1.23;
|
||||
|
||||
sub VERSION { $VERSION }
|
||||
|
||||
sub child_version { $_[0]->VERSION }
|
||||
|
||||
package Child;
|
||||
use base qw(Parent);
|
||||
|
||||
our $VERSION = 5.43;
|
||||
|
||||
sub VERSION { $VERSION }
|
||||
|
||||
sub new { bless {}, $_[0]; }
|
||||
|
||||
sub parent_version { $_[0]->SUPER::VERSION }
|
||||
|
||||
|
||||
print "Child version is ", Child->VERSION, "\n"; # 5.43
|
||||
my $child = Child->new;
|
||||
|
||||
print "Child version: ", $child->VERSION, "\n"; # 5.43
|
||||
print "Parent version: ", $child->parent_version, "\n"; # 1.23
|
||||
print "Child version: ", $child->child_version, "\n"; # 5.43
|
||||
@ -1,39 +1,39 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::Collection;
|
||||
use Test::FakeData;
|
||||
use Test::More;
|
||||
use Data::Dumper;
|
||||
|
||||
#use NGCP::Panel::Utils::Subscriber;
|
||||
|
||||
my $test_machine = Test::Collection->new(
|
||||
name => 'reminders',
|
||||
);
|
||||
my $fake_data = Test::FakeData->new;
|
||||
|
||||
$test_machine->methods->{collection}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS POST)};
|
||||
$test_machine->methods->{item}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS PUT PATCH DELETE)};
|
||||
|
||||
$fake_data->set_data_from_script({
|
||||
'reminders' => {
|
||||
'data' => {
|
||||
subscriber_id => sub { return shift->get_id('subscribers',@_); },
|
||||
recur => 'weekdays',#never' (only once)|'weekdays' (on weekdays)|'always' (everyday)
|
||||
'time' => '14:00',
|
||||
},
|
||||
'query' => ['subscriber_id'],
|
||||
},
|
||||
});
|
||||
|
||||
$test_machine->DATA_ITEM_STORE($fake_data->process('reminders'));
|
||||
$test_machine->form_data_item();
|
||||
$test_machine->check_create_correct( 1, );
|
||||
$test_machine->check_get2put();
|
||||
$test_machine->check_bundle();
|
||||
$test_machine->clear_test_data_all();#fake data aren't registered in this test machine, so they will stay.
|
||||
done_testing;
|
||||
|
||||
|
||||
# vim: set tabstop=4 expandtab:
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::Collection;
|
||||
use Test::FakeData;
|
||||
use Test::More;
|
||||
use Data::Dumper;
|
||||
|
||||
#use NGCP::Panel::Utils::Subscriber;
|
||||
|
||||
my $test_machine = Test::Collection->new(
|
||||
name => 'reminders',
|
||||
);
|
||||
my $fake_data = Test::FakeData->new;
|
||||
|
||||
$test_machine->methods->{collection}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS POST)};
|
||||
$test_machine->methods->{item}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS PUT PATCH DELETE)};
|
||||
|
||||
$fake_data->set_data_from_script({
|
||||
'reminders' => {
|
||||
'data' => {
|
||||
subscriber_id => sub { return shift->get_id('subscribers',@_); },
|
||||
recur => 'weekdays',#never' (only once)|'weekdays' (on weekdays)|'always' (everyday)
|
||||
'time' => '14:00',
|
||||
},
|
||||
'query' => ['subscriber_id'],
|
||||
},
|
||||
});
|
||||
|
||||
$test_machine->DATA_ITEM_STORE($fake_data->process('reminders'));
|
||||
$test_machine->form_data_item();
|
||||
$test_machine->check_create_correct( 1, );
|
||||
$test_machine->check_get2put();
|
||||
$test_machine->check_bundle();
|
||||
$test_machine->clear_test_data_all();#fake data aren't registered in this test machine, so they will stay.
|
||||
done_testing;
|
||||
|
||||
|
||||
# vim: set tabstop=4 expandtab:
|
||||
|
||||
@ -1,86 +1,86 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::Collection;
|
||||
use Test::FakeData;
|
||||
use Test::More;
|
||||
use Data::Dumper;
|
||||
|
||||
use NGCP::Panel::Utils::DateTime;
|
||||
|
||||
|
||||
#init test_machine
|
||||
my $test_machine = Test::Collection->new(
|
||||
name => 'subscriberregistrations',
|
||||
ALLOW_EMPTY_COLLECTION => 1,
|
||||
);
|
||||
my $fake_data = Test::FakeData->new;
|
||||
|
||||
$test_machine->methods->{collection}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS POST)};
|
||||
$test_machine->methods->{item}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS PUT PATCH DELETE)};
|
||||
|
||||
my $expires = NGCP::Panel::Utils::DateTime::current_local();
|
||||
|
||||
$fake_data->set_data_from_script({
|
||||
'subscriberregistrations' => {
|
||||
data => {
|
||||
'contact' => 'test',
|
||||
'expires' => $expires->ymd('-') . ' ' . $expires->hms(':'),
|
||||
'q' => 0.5,
|
||||
'subscriber_id' => sub { return shift->get_id('subscribers', @_); },
|
||||
},
|
||||
'update_change_fields' => [qw/_links expires id/],#expires seems like timezone difference
|
||||
},
|
||||
});
|
||||
|
||||
$test_machine->DATA_ITEM_STORE($fake_data->process('subscriberregistrations'));
|
||||
$test_machine->form_data_item( );
|
||||
|
||||
# create 3 new vouchers from DATA_ITEM
|
||||
$test_machine->check_create_correct( 3, sub{ $_[0]->{contact} .= time().'_'.$_[1]->{i} ; } );
|
||||
|
||||
#order of [check_bundle, check_get2put ] is important here:
|
||||
#subscriberregistrations really is just a wrapper arounf kamailio rpc calls,
|
||||
#and update of the existing item is made as delete+create. So, on every PUT or PATCH we delete item, and create new.
|
||||
#It makes internal Collection list of created items misordered with real data in db,
|
||||
#because Collection just keeps all created item, and doesn't try to recreate them on every update
|
||||
$test_machine->check_bundle();
|
||||
$test_machine->clear_test_data_all();
|
||||
|
||||
$test_machine->check_create_correct( 1, sub{ $_[0]->{contact} .= time().'_'.$_[1]->{i} ; } );
|
||||
|
||||
for (my $i=0; $i < 15; $i++) {
|
||||
$test_machine->check_get2put(undef, undef, { ignore_fields => [qw/id _links/] });
|
||||
}
|
||||
$test_machine->clear_data_created();
|
||||
|
||||
$test_machine->check_create_correct( 1, sub{ $_[0]->{contact} .= time().'_'.$_[1]->{i} ; } );
|
||||
{
|
||||
my($res, $content) = $test_machine->check_item_post(sub{$_[0]->{q} = 2;$_[0]->{contact} .= time().'_MT14779_1' ;});
|
||||
$test_machine->http_code_msg(422, "check creation of the subscriber registration with q > 1. MT#14779",$res,$content);
|
||||
}
|
||||
{
|
||||
my($res, $content) = $test_machine->check_item_post(sub{$_[0]->{q} = -2;$_[0]->{contact} .= time().'_MT14779_2' ;});
|
||||
$test_machine->http_code_msg(422, "check creation of the subscriber registration with q < -1. MT#14779",$res,$content);
|
||||
}
|
||||
{
|
||||
# Default value should be used.
|
||||
my($res, $content) = $test_machine->check_item_post(sub{delete $_[0]->{q};$_[0]->{contact} .= time().'_MT14779_3';});
|
||||
$test_machine->http_code_msg(201, "check creation of the subscriber registration without q. MT#14779.",$res,$content);
|
||||
}
|
||||
{
|
||||
my($res, $content) = $test_machine->check_item_post(sub{delete $_[0]->{expires};$_[0]->{contact} .= time().'_MT14891_1';});
|
||||
$test_machine->http_code_msg(422, "check creation of the subscriber registration without required expires. MT#14891.",$res,$content);
|
||||
}
|
||||
|
||||
#api doesn't deny extra fields
|
||||
#{
|
||||
# my($res, $content) = $test_machine->check_item_post(sub{$_[0]->{user_agent} = 'Test User Agent';$_[0]->{contact} .= time().'_MT14789' ;});
|
||||
# $test_machine->http_code_msg(422, "check creation of the subscriber registration with already removed "user_agent". MT#14789.",$res,$content);
|
||||
#}
|
||||
|
||||
$test_machine->clear_test_data_all();
|
||||
|
||||
done_testing;
|
||||
|
||||
# vim: set tabstop=4 expandtab:
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::Collection;
|
||||
use Test::FakeData;
|
||||
use Test::More;
|
||||
use Data::Dumper;
|
||||
|
||||
use NGCP::Panel::Utils::DateTime;
|
||||
|
||||
|
||||
#init test_machine
|
||||
my $test_machine = Test::Collection->new(
|
||||
name => 'subscriberregistrations',
|
||||
ALLOW_EMPTY_COLLECTION => 1,
|
||||
);
|
||||
my $fake_data = Test::FakeData->new;
|
||||
|
||||
$test_machine->methods->{collection}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS POST)};
|
||||
$test_machine->methods->{item}->{allowed} = {map {$_ => 1} qw(GET HEAD OPTIONS PUT PATCH DELETE)};
|
||||
|
||||
my $expires = NGCP::Panel::Utils::DateTime::current_local();
|
||||
|
||||
$fake_data->set_data_from_script({
|
||||
'subscriberregistrations' => {
|
||||
data => {
|
||||
'contact' => 'test',
|
||||
'expires' => $expires->ymd('-') . ' ' . $expires->hms(':'),
|
||||
'q' => 0.5,
|
||||
'subscriber_id' => sub { return shift->get_id('subscribers', @_); },
|
||||
},
|
||||
'update_change_fields' => [qw/_links expires id/],#expires seems like timezone difference
|
||||
},
|
||||
});
|
||||
|
||||
$test_machine->DATA_ITEM_STORE($fake_data->process('subscriberregistrations'));
|
||||
$test_machine->form_data_item( );
|
||||
|
||||
# create 3 new vouchers from DATA_ITEM
|
||||
$test_machine->check_create_correct( 3, sub{ $_[0]->{contact} .= time().'_'.$_[1]->{i} ; } );
|
||||
|
||||
#order of [check_bundle, check_get2put ] is important here:
|
||||
#subscriberregistrations really is just a wrapper arounf kamailio rpc calls,
|
||||
#and update of the existing item is made as delete+create. So, on every PUT or PATCH we delete item, and create new.
|
||||
#It makes internal Collection list of created items misordered with real data in db,
|
||||
#because Collection just keeps all created item, and doesn't try to recreate them on every update
|
||||
$test_machine->check_bundle();
|
||||
$test_machine->clear_test_data_all();
|
||||
|
||||
$test_machine->check_create_correct( 1, sub{ $_[0]->{contact} .= time().'_'.$_[1]->{i} ; } );
|
||||
|
||||
for (my $i=0; $i < 15; $i++) {
|
||||
$test_machine->check_get2put(undef, undef, { ignore_fields => [qw/id _links/] });
|
||||
}
|
||||
$test_machine->clear_data_created();
|
||||
|
||||
$test_machine->check_create_correct( 1, sub{ $_[0]->{contact} .= time().'_'.$_[1]->{i} ; } );
|
||||
{
|
||||
my($res, $content) = $test_machine->check_item_post(sub{$_[0]->{q} = 2;$_[0]->{contact} .= time().'_MT14779_1' ;});
|
||||
$test_machine->http_code_msg(422, "check creation of the subscriber registration with q > 1. MT#14779",$res,$content);
|
||||
}
|
||||
{
|
||||
my($res, $content) = $test_machine->check_item_post(sub{$_[0]->{q} = -2;$_[0]->{contact} .= time().'_MT14779_2' ;});
|
||||
$test_machine->http_code_msg(422, "check creation of the subscriber registration with q < -1. MT#14779",$res,$content);
|
||||
}
|
||||
{
|
||||
# Default value should be used.
|
||||
my($res, $content) = $test_machine->check_item_post(sub{delete $_[0]->{q};$_[0]->{contact} .= time().'_MT14779_3';});
|
||||
$test_machine->http_code_msg(201, "check creation of the subscriber registration without q. MT#14779.",$res,$content);
|
||||
}
|
||||
{
|
||||
my($res, $content) = $test_machine->check_item_post(sub{delete $_[0]->{expires};$_[0]->{contact} .= time().'_MT14891_1';});
|
||||
$test_machine->http_code_msg(422, "check creation of the subscriber registration without required expires. MT#14891.",$res,$content);
|
||||
}
|
||||
|
||||
#api doesn't deny extra fields
|
||||
#{
|
||||
# my($res, $content) = $test_machine->check_item_post(sub{$_[0]->{user_agent} = 'Test User Agent';$_[0]->{contact} .= time().'_MT14789' ;});
|
||||
# $test_machine->http_code_msg(422, "check creation of the subscriber registration with already removed "user_agent". MT#14789.",$res,$content);
|
||||
#}
|
||||
|
||||
$test_machine->clear_test_data_all();
|
||||
|
||||
done_testing;
|
||||
|
||||
# vim: set tabstop=4 expandtab:
|
||||
|
||||
@ -1,138 +1,138 @@
|
||||
package Test::HTTPRequestAsCurl;
|
||||
use 5.008005;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = "0.03";
|
||||
|
||||
use Carp;
|
||||
use String::ShellQuote qw/ shell_quote /;
|
||||
#use Win32::ShellQuote qw/ cmd_escape /;
|
||||
use Exporter::Shiny qw/ as_curl /;
|
||||
|
||||
sub as_curl {
|
||||
my ($request, %params) = @_;
|
||||
|
||||
my $content = $request->content;
|
||||
my @data = split '&', $content;
|
||||
my $method = $request->method;
|
||||
my $uri = $request->uri;
|
||||
my $headers = $request->headers;
|
||||
my $user = $headers->authorization_basic || ( $params{credentials} ? join(':', @{$params{credentials}}{qw/user password/}) : '');
|
||||
#my @h = grep { $_ !~ /(authorization|content-length|content-type)/i }
|
||||
my @h = grep { $_ !~ /(authorization|content-length)/i }
|
||||
$headers->header_field_names;
|
||||
|
||||
my @cmd = (["curl"]);
|
||||
push(@cmd, ["--request", $method, $uri]);
|
||||
push(@cmd, ["--dump-header", "-"]);
|
||||
push(@cmd, ["--insecure"]) if $user;
|
||||
push(@cmd, ["--user", $user]) if $user;
|
||||
push(@cmd, ["--header", "$_: " . $headers->header($_)]) for sort @h;
|
||||
push(@cmd, ["--data", $_]) for sort @data;
|
||||
|
||||
#return map { @$_ } @cmd unless keys %params;
|
||||
|
||||
return _make_it_pretty(\@cmd, %params);
|
||||
}
|
||||
|
||||
sub _make_it_pretty {
|
||||
my ($cmd, %params) = @_;
|
||||
|
||||
$params{shell} = $params{shell} || _default_shell_escape();
|
||||
#$params{newline} = $params{newline} || "\\ \n";
|
||||
$params{newline} = $params{newline} || "";
|
||||
|
||||
my $string;
|
||||
for my $part (@$cmd) {
|
||||
#if ($params{shell} eq 'win32') {
|
||||
# $string .= cmd_escape join " ", @$part;
|
||||
# $string .= ' ^' . $params{newline};
|
||||
#}
|
||||
#els
|
||||
if ($params{shell} eq 'bourne') {
|
||||
$string .= shell_quote @$part;
|
||||
$string .= ' ' . $params{newline};
|
||||
}
|
||||
else {
|
||||
croak "this shell is not currently supported: $params{shell}";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub _default_shell_escape { $^O eq 'MSWin32' ? 'win32' : 'bourne' }
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=encoding utf-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
HTTP::Request::AsCurl - Generate a curl command from an HTTP::Request object.
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use HTTP::Request::Common;
|
||||
use HTTP::Request::AsCurl qw/as_curl/;
|
||||
|
||||
my $request = POST('api.earth.defense/weapon1', {
|
||||
target => 'mothership',
|
||||
when => 'now'
|
||||
});
|
||||
|
||||
system as_curl($request);
|
||||
|
||||
print as_curl($request, pretty => 1, newline => "\n", shell => 'bourne');
|
||||
# curl \
|
||||
# --request POST api.earth.defense/weapon1 \
|
||||
# --dump-header - \
|
||||
# --data target=mothership \
|
||||
# --data when=now
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module converts an HTTP::Request object to a curl command. It can be used
|
||||
for debugging REST APIs.
|
||||
|
||||
It handles headers and basic authentication.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 as_curl($request, %params)
|
||||
|
||||
Accepts an HTTP::Request object and converts it to a curl command. If there
|
||||
are no C<%params>, C<as_curl()> returns the cmd as an array suitable for being
|
||||
passed to system().
|
||||
|
||||
If there are C<%params>, C<as_curl()> returns a formatted string. The string's
|
||||
format defaults to using "\n" for newlines and escaping the curl command using
|
||||
bourne shell rules unless you are on a win32 system in which case it defaults
|
||||
to using win32 cmd.exe escaping rules.
|
||||
|
||||
Available params are as follows
|
||||
|
||||
newline: defaults to "\n"
|
||||
shell: currently available options are 'bourne' and 'win32'
|
||||
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright (C) Eric Johnson.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Eric Johnson E<lt>eric.git@iijo.orgE<gt>
|
||||
|
||||
=cut
|
||||
package Test::HTTPRequestAsCurl;
|
||||
use 5.008005;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = "0.03";
|
||||
|
||||
use Carp;
|
||||
use String::ShellQuote qw/ shell_quote /;
|
||||
#use Win32::ShellQuote qw/ cmd_escape /;
|
||||
use Exporter::Shiny qw/ as_curl /;
|
||||
|
||||
sub as_curl {
|
||||
my ($request, %params) = @_;
|
||||
|
||||
my $content = $request->content;
|
||||
my @data = split '&', $content;
|
||||
my $method = $request->method;
|
||||
my $uri = $request->uri;
|
||||
my $headers = $request->headers;
|
||||
my $user = $headers->authorization_basic || ( $params{credentials} ? join(':', @{$params{credentials}}{qw/user password/}) : '');
|
||||
#my @h = grep { $_ !~ /(authorization|content-length|content-type)/i }
|
||||
my @h = grep { $_ !~ /(authorization|content-length)/i }
|
||||
$headers->header_field_names;
|
||||
|
||||
my @cmd = (["curl"]);
|
||||
push(@cmd, ["--request", $method, $uri]);
|
||||
push(@cmd, ["--dump-header", "-"]);
|
||||
push(@cmd, ["--insecure"]) if $user;
|
||||
push(@cmd, ["--user", $user]) if $user;
|
||||
push(@cmd, ["--header", "$_: " . $headers->header($_)]) for sort @h;
|
||||
push(@cmd, ["--data", $_]) for sort @data;
|
||||
|
||||
#return map { @$_ } @cmd unless keys %params;
|
||||
|
||||
return _make_it_pretty(\@cmd, %params);
|
||||
}
|
||||
|
||||
sub _make_it_pretty {
|
||||
my ($cmd, %params) = @_;
|
||||
|
||||
$params{shell} = $params{shell} || _default_shell_escape();
|
||||
#$params{newline} = $params{newline} || "\\ \n";
|
||||
$params{newline} = $params{newline} || "";
|
||||
|
||||
my $string;
|
||||
for my $part (@$cmd) {
|
||||
#if ($params{shell} eq 'win32') {
|
||||
# $string .= cmd_escape join " ", @$part;
|
||||
# $string .= ' ^' . $params{newline};
|
||||
#}
|
||||
#els
|
||||
if ($params{shell} eq 'bourne') {
|
||||
$string .= shell_quote @$part;
|
||||
$string .= ' ' . $params{newline};
|
||||
}
|
||||
else {
|
||||
croak "this shell is not currently supported: $params{shell}";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub _default_shell_escape { $^O eq 'MSWin32' ? 'win32' : 'bourne' }
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=encoding utf-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
HTTP::Request::AsCurl - Generate a curl command from an HTTP::Request object.
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use HTTP::Request::Common;
|
||||
use HTTP::Request::AsCurl qw/as_curl/;
|
||||
|
||||
my $request = POST('api.earth.defense/weapon1', {
|
||||
target => 'mothership',
|
||||
when => 'now'
|
||||
});
|
||||
|
||||
system as_curl($request);
|
||||
|
||||
print as_curl($request, pretty => 1, newline => "\n", shell => 'bourne');
|
||||
# curl \
|
||||
# --request POST api.earth.defense/weapon1 \
|
||||
# --dump-header - \
|
||||
# --data target=mothership \
|
||||
# --data when=now
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module converts an HTTP::Request object to a curl command. It can be used
|
||||
for debugging REST APIs.
|
||||
|
||||
It handles headers and basic authentication.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 as_curl($request, %params)
|
||||
|
||||
Accepts an HTTP::Request object and converts it to a curl command. If there
|
||||
are no C<%params>, C<as_curl()> returns the cmd as an array suitable for being
|
||||
passed to system().
|
||||
|
||||
If there are C<%params>, C<as_curl()> returns a formatted string. The string's
|
||||
format defaults to using "\n" for newlines and escaping the curl command using
|
||||
bourne shell rules unless you are on a win32 system in which case it defaults
|
||||
to using win32 cmd.exe escaping rules.
|
||||
|
||||
Available params are as follows
|
||||
|
||||
newline: defaults to "\n"
|
||||
shell: currently available options are 'bourne' and 'win32'
|
||||
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright (C) Eric Johnson.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Eric Johnson E<lt>eric.git@iijo.orgE<gt>
|
||||
|
||||
=cut
|
||||
|
||||
Loading…
Reference in new issue