diff --git a/Build.PL b/Build.PL index bdf9f69556..f864d67bcf 100644 --- a/Build.PL +++ b/Build.PL @@ -22,14 +22,16 @@ __END__ =encoding UTF-8 -=head1 NGCP-Panel - -A completely overhauled provisioning interface for the NGCP system. - =head1 NAME Build.PL - NGCP-Panel build system including test fixtures +=head1 DESCRIPTION + +NGCP-Panel + +A completely overhauled provisioning interface for the NGCP system. + =head1 SYNOPSIS perl ./Build @@ -92,3 +94,10 @@ In case your language did not exist already: msginit --input=lib/NGCP/Panel/I18N/messages.pot --output=lib/NGCP/Panel/I18N/$LANG.po --locale=$LANG +=head1 AUTHOR + +Sipwise Development Team . + +=head1 LICENSE + +GPL-3+, Sipwise GmbH, Austria. \ No newline at end of file diff --git a/lib/NGCP/Panel/Controller/API/BillingFeesItem.pm b/lib/NGCP/Panel/Controller/API/BillingFeesItem.pm index bd77982db2..2dc7ef6364 100644 --- a/lib/NGCP/Panel/Controller/API/BillingFeesItem.pm +++ b/lib/NGCP/Panel/Controller/API/BillingFeesItem.pm @@ -45,9 +45,8 @@ sub GET :Allow { # TODO: we don't need reseller stuff here! my $response = HTTP::Response->new(HTTP_OK, undef, HTTP::Headers->new( (map { # XXX Data::HAL must be able to generate links with multiple relations - s|rel="(http://purl.org/sipwise/ngcp-api/#rel-resellers)"|rel="item $1"|; - s/rel=self/rel="item self"/; - $_ + s|rel="(http://purl.org/sipwise/ngcp-api/#rel-resellers)"|rel="item $1"|r =~ + s/rel=self/rel="item self"/r; } $hal->http_headers), ), $hal->as_json); $c->response->headers($response->headers); diff --git a/lib/NGCP/Panel/Controller/API/EmailTemplatesItem.pm b/lib/NGCP/Panel/Controller/API/EmailTemplatesItem.pm index 7df3d16aed..962ec2ba50 100644 --- a/lib/NGCP/Panel/Controller/API/EmailTemplatesItem.pm +++ b/lib/NGCP/Panel/Controller/API/EmailTemplatesItem.pm @@ -44,9 +44,8 @@ sub GET :Allow { my $response = HTTP::Response->new(HTTP_OK, undef, HTTP::Headers->new( (map { # XXX Data::HAL must be able to generate links with multiple relations - s|rel="(http://purl.org/sipwise/ngcp-api/#rel-resellers)"|rel="item $1"|; - s/rel=self/rel="item self"/; - $_ + s|rel="(http://purl.org/sipwise/ngcp-api/#rel-resellers)"|rel="item $1"|r =~ + s/rel=self/rel="item self"/r; } $hal->http_headers), ), $hal->as_json); $c->response->headers($response->headers); diff --git a/lib/NGCP/Panel/Controller/CallRouting.pm b/lib/NGCP/Panel/Controller/CallRouting.pm index c4a908bbe3..e620dc629a 100644 --- a/lib/NGCP/Panel/Controller/CallRouting.pm +++ b/lib/NGCP/Panel/Controller/CallRouting.pm @@ -250,10 +250,9 @@ sub callroutingverify :Chained('/') :PathPart('callroutingverify') :Args(0) { } } } - my $match = map { local $_ = $_; - $_ =~ s/\*/.*/g; - $_ =~ s/\?/.?/g; - $data->{caller_in} =~ /^$_$/; + my $match = map { my $val = s/\*/.*/gr; + $val =~ s/\?/.?/g; + $data->{caller_in} =~ /^$val$/; } @{$usr_prefs{allowed_clis}}; if ($match) { push @log, sprintf diff --git a/lib/NGCP/Panel/Form/Sound/LoadDefault.pm b/lib/NGCP/Panel/Form/Sound/LoadDefault.pm index 0a962a57da..d7c7cd82a3 100644 --- a/lib/NGCP/Panel/Form/Sound/LoadDefault.pm +++ b/lib/NGCP/Panel/Form/Sound/LoadDefault.pm @@ -33,7 +33,7 @@ sub build_langs { ->not(File::Find::Rule->new->name(qr/^\.\.?$/)) ->in('/var/lib/ngcp-soundsets/system'); - @options = map { $_ =~ s/^.+\///; { label => $_, value => $_ } } @dirs; + @options = map { my $val = s/^.+\///r; { label => $val, value => $val } } @dirs; return \@options; } diff --git a/lib/NGCP/Panel/Role/API/Conversations.pm b/lib/NGCP/Panel/Role/API/Conversations.pm index 4fc883b260..f58fefe769 100644 --- a/lib/NGCP/Panel/Role/API/Conversations.pm +++ b/lib/NGCP/Panel/Role/API/Conversations.pm @@ -804,7 +804,7 @@ sub process_hal_resource { })->first->mailboxuser->provisioning_voip_subscriber->voip_subscriber->id; # type is last item of path like /var/spool/asterisk/voicemail/default/uuid/INBOX my $filename = NGCP::Panel::Utils::Subscriber::get_voicemail_filename($c,$item_mock_obj); - my @p = split '/', $item_mock_obj->dir; + my @p = split /\//, $item_mock_obj->dir; $resource->{folder} = pop @p; $resource->{direction} = 'in'; $resource->{filename} = $filename; diff --git a/lib/NGCP/Panel/Role/API/PhonebookEntries.pm b/lib/NGCP/Panel/Role/API/PhonebookEntries.pm index bd3d60dd0c..be4f7c2caf 100644 --- a/lib/NGCP/Panel/Role/API/PhonebookEntries.pm +++ b/lib/NGCP/Panel/Role/API/PhonebookEntries.pm @@ -15,11 +15,16 @@ sub _item_rs { my ($self, $c) = @_; my($owner,$type,$parameter,$value) = $self->check_owner_params($c); return unless $owner; - my $method = 'get_'.$type.'_phonebook_rs'; my ($list_rs,$item_rs); - { - no strict 'refs'; - ($list_rs,$item_rs) = &$method($c, $value, $type); + + if ($type eq 'reseller') { + ($list_rs,$item_rs) = get_reseller_phonebook_rs($c, $value, $type); + } elsif ($type eq 'contract') { + ($list_rs,$item_rs) = get_contract_phonebook_rs($c, $value, $type); + } elsif ($type eq 'subscriber') { + ($list_rs,$item_rs) = get_subscriber_phonebook_rs($c, $value, $type); + } else { + die 'This shouln\'t happen'; } return $list_rs; } diff --git a/lib/NGCP/Panel/Role/API/Voicemails.pm b/lib/NGCP/Panel/Role/API/Voicemails.pm index 80eeb3d101..76d14d2991 100644 --- a/lib/NGCP/Panel/Role/API/Voicemails.pm +++ b/lib/NGCP/Panel/Role/API/Voicemails.pm @@ -83,7 +83,7 @@ sub resource_from_item { $resource{subscriber_id} = int($item->mailboxuser->provisioning_voip_subscriber->voip_subscriber->id); # type is last item of path like /var/spool/asterisk/voicemail/default/uuid/INBOX - my @p = split '/', $item->dir; + my @p = split /\//, $item->dir; $resource{folder} = pop @p; return \%resource; diff --git a/lib/NGCP/Panel/Utils/Device.pm b/lib/NGCP/Panel/Utils/Device.pm index 83c54675b2..327ad9c231 100644 --- a/lib/NGCP/Panel/Utils/Device.pm +++ b/lib/NGCP/Panel/Utils/Device.pm @@ -149,7 +149,7 @@ sub process_connectable_models{ push @$connectable_models_ids, $name_or_id; } } - my @columns = ('device_id' , 'extension_id'); + my @columns = qw(device_id extension_id); if('extension' eq $devmod->type){ #extension can be connected to other extensions? If I remember right - yes. @columns = reverse @columns; diff --git a/lib/NGCP/Panel/Utils/Generic.pm b/lib/NGCP/Panel/Utils/Generic.pm index 74576c85e9..32be65a94b 100644 --- a/lib/NGCP/Panel/Utils/Generic.pm +++ b/lib/NGCP/Panel/Utils/Generic.pm @@ -121,12 +121,14 @@ sub hash2obj { } $classname = __PACKAGE__ . '::' . $classname unless $classname =~ /::/; bless($obj,$classname); - no strict "refs"; + no strict "refs"; ## no critic (ProhibitNoStrict) return $obj if scalar %{$classname . '::'}; + use strict "refs"; #print "registering class $classname\n"; $accessors //= {}; foreach my $accessor (keys %$accessors) { #print "registering accessor $classname::$accessor\n"; + no strict "refs"; ## no critic (ProhibitNoStrict) *{$classname . '::' . $accessor} = sub { my $self = shift; return &{$accessors->{$accessor}}($self,@_); diff --git a/lib/NGCP/Panel/Utils/InvoiceTemplate.pm b/lib/NGCP/Panel/Utils/InvoiceTemplate.pm index 4d6e91e765..767d894e7d 100644 --- a/lib/NGCP/Panel/Utils/InvoiceTemplate.pm +++ b/lib/NGCP/Panel/Utils/InvoiceTemplate.pm @@ -23,7 +23,7 @@ sub svg_pdf { push @pagefiles, $pagefile; open($fh, ">", $pagefile); - binmode($fh, ":utf8"); + binmode($fh, ":encoding(UTF-8)"); print $fh $page; close $fh; diff --git a/lib/NGCP/Panel/Utils/Message.pm b/lib/NGCP/Panel/Utils/Message.pm index 0fb5161501..c1f8ff7456 100644 --- a/lib/NGCP/Panel/Utils/Message.pm +++ b/lib/NGCP/Panel/Utils/Message.pm @@ -36,7 +36,7 @@ sub get_log_params { my $caller = (caller 2)[3]; $caller !~ /::/ and $caller = (caller 3)[3]; if ($caller) { - my @caller = split('::', $caller); + my @caller = split(/::/, $caller); $#caller >= 3 and $called = join('::', @caller[-3...-1]); } } diff --git a/lib/NGCP/Panel/Utils/Utf8.pm b/lib/NGCP/Panel/Utils/Utf8.pm index e743f7b18a..99a7450fc3 100644 --- a/lib/NGCP/Panel/Utils/Utf8.pm +++ b/lib/NGCP/Panel/Utils/Utf8.pm @@ -10,6 +10,8 @@ use charnames ':full'; our $VERSION = "1.01"; +## no critic (Subroutines::ProhibitSubroutinePrototypes) + # A Regexp string to match valid UTF8 bytes # this info comes from page 78 of "The Unicode Standard 4.0" # published by the Unicode Consortium diff --git a/sandbox/banlist.pl b/sandbox/banlist.pl index 5c8077d073..11a21bb714 100755 --- a/sandbox/banlist.pl +++ b/sandbox/banlist.pl @@ -6,7 +6,7 @@ use XML::Mini::Document; use Data::Printer; my $f = 'banlist.xml'; -my $data = do { local $/ = undef; open my $fh, $f or die $!; <$fh> }; +my $data = do { local $/ = undef; open (my $fh, '<', $f) or die $!; <$fh> }; my $xmlDoc = XML::Mini::Document->new(); $xmlDoc->parse($data); my $xmlHash = $xmlDoc->toHash(); diff --git a/sandbox/billing_mapping_effective_date.t b/sandbox/billing_mapping_effective_date.t index ab5f15ec31..1af09c493e 100644 --- a/sandbox/billing_mapping_effective_date.t +++ b/sandbox/billing_mapping_effective_date.t @@ -462,7 +462,7 @@ sub test_contracts { my $old_contract_id = undef; my $contract = undef; while (my $row = <$fh>) { - my @cleaned = map { $_ =~ s/\\N//g; $_ =~ s/[\r\n]//gi; $_; } split(/,/,$row); + my @cleaned = map { s/\\N//gr =~ s/[\r\n]//gir; } split(/,/,$row); my ($now,$contract_id,$contract_create,$bm_actual_id,$id,$start_date,$end_date, $profile_id,$profile_name,$network_id,$network_name,$product_id,$product_class) = @cleaned; #print join("\t",@cleaned) . "\n"; diff --git a/sandbox/hash2obj.pl b/sandbox/hash2obj.pl index b41bd2222f..dc4e46eaa4 100644 --- a/sandbox/hash2obj.pl +++ b/sandbox/hash2obj.pl @@ -73,8 +73,10 @@ sub hash2obj { } $classname = __PACKAGE__ . '::' . $classname unless $classname =~ /::/; bless($obj,$classname); - no strict "refs"; # for below and to register new methods in package + # for below and to register new methods in package + no strict "refs"; ## no critic (ProhibitNoStrict) return $obj if scalar %{$classname . '::'}; + use strict "refs"; print "registering class $classname\n"; $accessors //= {}; my %accessors = ( (map { $_ => undef; } keys %$obj), %$accessors); # create accessors for fields too @@ -82,6 +84,7 @@ sub hash2obj { print "registering accessor $classname::$accessor\n"; # see http://search.cpan.org/~gsar/perl-5.6.1/pod/perltootc.pod # accessor can be a coderef ... + no strict "refs"; ## no critic (ProhibitNoStrict) *{$classname . '::' . $accessor} = sub { my $self = shift; &{$accessors{$accessor}}($self,shift) if scalar @_; #setter @@ -93,6 +96,7 @@ sub hash2obj { $self->{$accessors{$accessor}} = shift if scalar @_; #setter return $self->{$accessors{$accessor}}; #getter } if '' eq ref $accessors{$accessor}; + use strict "refs"; } return $obj; } \ No newline at end of file diff --git a/share/tools/api_dump.pl b/share/tools/api_dump.pl index 5a158a054b..baf051c2f9 100755 --- a/share/tools/api_dump.pl +++ b/share/tools/api_dump.pl @@ -96,19 +96,18 @@ sub main { if (BALANCEINTERVALS_MODE eq $mode) { - my @cols = ( - 'subscriber_id', - 'subscriber_status', - 'primary_number', - 'contract_id', - 'contract_status', - #'has_actual_balance_interval', - 'interval_start', - 'interval_stop', - 'cash_balance', - 'notopup_discard_expiry', - 'package_id', - ); + my @cols = qw/ + subscriber_id + subscriber_status + primary_number + contract_id + contract_status + interval_start + interval_stop + cash_balance + notopup_discard_expiry + package_id + /; my $rowcount = 0; my ($fh,$filename) = prepare_file($mode,$output_filename,\@cols); @@ -161,28 +160,26 @@ sub main { } elsif (TOPUPLOG_MODE eq $mode) { - my @cols = ( - 'username', - 'timestamp', - 'request_token', - #'subscriber_id', - #'primary_number', - 'contract_id', - 'outcome', - 'message', - 'type', - 'voucher_id', - 'voucher_code', - 'amount', - 'cash_balance_before', - 'cash_balance_after', - 'lock_level_before', - 'lock_level_after', - 'package_before', - 'package_after', - 'profile_before', - 'profile_after', - ); + my @cols = qw/ + username + timestamp + request_token + contract_id + outcome + message + type + voucher_id + voucher_code + amount + cash_balance_before + cash_balance_after + lock_level_before + lock_level_after + package_before + package_after + profile_before + profile_after + /; my $rowcount = 0; my ($fh,$filename) = prepare_file($mode,$output_filename,\@cols); diff --git a/t/api-rest/api-all.t b/t/api-rest/api-all.t index 987c54c530..b38a90415e 100644 --- a/t/api-rest/api-all.t +++ b/t/api-rest/api-all.t @@ -143,7 +143,7 @@ sub get_opt{#get $opt "test-groups" , ) or pod2usage(2); my @opt_keys = keys %$opt_in; - @{$opt}{ map{my $k=$_;$k=~s/\-/_/;$k;} @opt_keys } = map {my $v = $opt_in->{$_}; $v={ map {$_=>1;} split(/[^[:alnum:]]+/,$v ) }; $v;} @opt_keys ; + @{$opt}{ map{ s/\-/_/; } @opt_keys } = map {my $v = $opt_in->{$_}; $v={ map {$_=>1;} split(/[^[:alnum:]]+/,$v ) }; $v;} @opt_keys ; print Dumper $opt; pod2usage(1) if $opt->{help}; pod2usage(1) unless( 1 @@ -203,7 +203,7 @@ sub init_config{#init config ->mindepth(1) ->maxdepth(1) ->name('api-*.t'); - %test_exists = map {$_=~s/\Q$dir\/\E//;$_ => 1} $rule->in($dir); + %test_exists = map { s/\Q$dir\/\E//r => 1} $rule->in($dir); } $config->{tests_exists} = \%test_exists; $config->{tests_exclude} = \%test_exclude; diff --git a/t/lib/Test/FakeData.pm b/t/lib/Test/FakeData.pm index a37d0c766c..1ad93fef40 100644 --- a/t/lib/Test/FakeData.pm +++ b/t/lib/Test/FakeData.pm @@ -591,7 +591,7 @@ sub set_data_from_script{ } #dirty hack, part 2 if(grep {/^load_data_only$/} @ARGV){ - no strict "vars"; + no strict "vars"; ## no critic (ProhibitNoStrict) $data_out = $data_in; die; } diff --git a/t/lib/Test/HTTPRequestAsCurl.pm b/t/lib/Test/HTTPRequestAsCurl.pm index ae8d0a416d..0cfa22368c 100644 --- a/t/lib/Test/HTTPRequestAsCurl.pm +++ b/t/lib/Test/HTTPRequestAsCurl.pm @@ -14,7 +14,7 @@ sub as_curl { my ($request, %params) = @_; my $content = $request->content; - my @data = split '&', $content; + my @data = split /&/, $content; my $method = $request->method; my $uri = $request->uri; my $headers = $request->headers;