Переменная Perl меняется без какой-либо записи в нее - PullRequest
0 голосов
/ 15 октября 2018

У меня есть следующий скрипт:

use Modern::Perl;
use List::Compare;
use Set::IntSpan;
use List::Util qw/first/;
use List::MoreUtils qw/firstidx onlyidx/;
use Data::Dumper;

sub get_index_by_data {
    my ( $data, $arr ) = @_;
    return onlyidx { $_ eq $data } @$arr;
}

sub detect_busy_intervals {
  my %params = @_;

  $params{epoch_key} = 'epoch' if ( !defined $params{epoch_key} ) ;

  my @all_epochs = @ { $params{all_epochs} };
  my @free_epochs = map { $_->{ $params{epoch_key} } } @{ $params{data} };
  my $lc = List::Compare->new( $params{all_epochs}, \@free_epochs );
  my @busy_epochs = $lc->get_Lonly;

  @all_epochs = sort { $a <=> $b } @all_epochs;
  @free_epochs = sort { $a <=> $b } @free_epochs;
  @busy_epochs = sort { $a <=> $b } @busy_epochs;

  my @busy_indexes_list = map { get_index_by_data( $_, \@all_epochs) } @busy_epochs;

  my $int_span = Set::IntSpan->new(join ",", @busy_indexes_list);
  my @spans = spans $int_span;

  my @res = ();

  for my $i ( @spans ) {
    my $busy_start_idx = $i->[0];
    my $busy_finish_idx = $i->[1];

    my $busy_start_time = $all_epochs[ $busy_start_idx ];
    my $busy_finish_time = $all_epochs[ $busy_finish_idx ];

    my $prev_free_time_idx = $busy_start_idx - 1;
    my $next_free_time_idx = $busy_finish_idx + 1;

    my $route = {};

    $route->{start} = first { $_->{ $params{epoch_key} } == $all_epochs[$prev_free_time_idx] } @{ $params{data} } ;
    $route->{finish} = first { $_->{ $params{epoch_key} } == $all_epochs[$next_free_time_idx] } @{ $params{data} } ;

    $route->{start}{epoch} = $params{all_epochs}->[ $busy_start_idx ];
    $route->{finish}{epoch} = $params{all_epochs}->[ $busy_finish_idx ];

    push @res, $route;
  }

  return \@res;
}


my @checks_arr = ( 100, 200, 300, 400, 500 );

my $data = [
  { 'epoch' => 100, 'cron_data_id' => 1 },
  { 'epoch' => 500, 'cron_data_id' => 5 },
];

print "Data 1: ".Dumper $data;

my $res = [
  { 'start' => { 'epoch' => 200, 'cron_data_id' => 1 }, 'finish' => { 'epoch' => 400, 'cron_data_id' => 5 } },
];

my $a = detect_busy_intervals( data => $data, all_epochs => \@checks_arr );
print "Result: ".Dumper $a;
print "Data 2: ".Dumper $data;

После использования переменной $data в функции detect_busy_intervals $data изменилось ее значение (в частности, значение epoch отличается).Но никаких писем к $params{data} внутри detect_busy_intervals sub!

enter image description here

Есть идеи, что может быть не так?

Я проверялкод с помощью perlcritic, возможно, я сделал некоторую опечатку синтаксиса, которая приводит к изменению переменной, но проблем не обнаружено.

1 Ответ

0 голосов
/ 15 октября 2018

В этих строках:

$route->{start} = first { $_->{ $params{epoch_key} } == $all_epochs[$prev_free_time_idx] } @{ $params{data} } ;
$route->{finish} = first { $_->{ $params{epoch_key} } == $all_epochs[$next_free_time_idx] } @{ $params{data} } ;

Вы присваиваете хеш-значения из параметра data в свою структуру $route.Это мелкие копии, поэтому они ссылаются на те же хэши, на которые ссылается параметр data.Это означает, что следующие строки:

$route->{start}{epoch} = $params{all_epochs}->[ $busy_start_idx ];
$route->{finish}{epoch} = $params{all_epochs}->[ $busy_finish_idx ];

изменяют исходные хэши.

Вместо этого можно назначить копии (как минимум, один уровень копирования) из параметра data, разыменовав хеш-ссылку (%{}) затем создание новой ссылки на хеш, содержащей результирующий список ({}):

my $start = first { $_->{ $params{epoch_key} } == $all_epochs[$prev_free_time_idx] } @{ $params{data} } ;
my $finish = first { $_->{ $params{epoch_key} } == $all_epochs[$next_free_time_idx] } @{ $params{data} } ;
$route->{start} = { %{ $start // {} } };
$route->{finish} = { %{ $finish // {} } };

// {} гарантирует, что даже если ваши вызовы first вернут undef (когда он не найдетсоответствовать), что разыменование просто приведет к пустому списку.

Если ваша структура данных может иметь дополнительные вложенные ссылки, общим решением будет глубокая копия из модулей, таких как , перечисленных здесь .

use Sereal::Dclone 'dclone';
$route->{start} = dclone first { $_->{ $params{epoch_key} } == $all_epochs[$prev_free_time_idx] } @{ $params{data} } ;
$route->{finish} = dclone first { $_->{ $params{epoch_key} } == $all_epochs[$next_free_time_idx] } @{ $params{data} } ;
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...