Pragmatic Perl

Выпуск 30. Август 2015

Работаем с legacy. Паттерн «извлечение функции» и оценка результатов

Из личного опыта рефакторинга устаревшего кода

Когда ты работаешь с унаследованным кодом, то постоянно возникают ситуации, когда просто не понимаешь, что происходит с данными. Да, ты понимаешь, что происходит что-то не то, но непонятно где. Была у меня ситуация, что в хеше что-то меняет значение, но просто беглым взглядом по коду найти это было невозможно. Эта история обогатила мой инструментарий работы с наследием, о чем я и расскажу в этой статье.

Допустим, у меня есть вот такой код, состоящий из скрипта и пары модулей:

example.pl

use Utils;
my $row = { user => { name => 'kate', age => 55 } };
if (check($row)) {
    say 'OK';
    # do something
}
else {
    say 'NO';
}
exit(0);

Utils.pm

package Utils;
use strict; use warnings;
use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(check);
use Uts;

sub check {
    my ($row) = shift;
    format_row($row->{user});
    return $row->{user}->{age} > 18 ? 1 : 0;
}

Uts.pm

package Uts;
use strict; use warnings;
use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(format_row);

my $modifiers = { 
    age => 10, 
    grade => 'high',
};
sub format_row {
    my ($row) = shift;
    #... много-много кода
    $row->{$_} = $modifiers->{$_} for keys %$modifiers;
    #... много-много кода
    return;
}

Конечно, как и всегда, код пришлось придумать. А теперь представьте, что кроме этих маленьких функций там еще по 2-3К кода вокруг, а сами функции длиной по 500 строк. Но чтение такой статьи вряд ли бы доставило удовольствие, поэтому ограничимся таким простым примером.

И вот я запускаю свой код:

$ perl example.pl 
NO

Вообще-то у меня в $row задано “age => 55” и я должна получить OK. Тут что-то явно не так. Сейчас всем нужно сделать вид, что этот код прочитать и понять невозможно =) Даже добавив say Dumper $row; вот так:

if (check($row)) {
    say 'OK';
    # do something
}
else {
    say 'NO';
}
say Dumper $row;

я вижу совсем не то, что ожидаю:

$VAR1 = {
          'user' => {
                      'age' => 10,
                      'name' => 'kate',
                      'grade' => 'high'
                    }
        };

Посмотрим, что происходит со значением $row->{user}->{age}. Если бы у меня был объект класса User, у котого через аксессор меняются атрибуты, то все было бы куда проще. А здесь применим tie (http://perldoc.perl.org/perltie.html).

В этом примере я хочу отследить, что у меня происходит со скаляром. Значит мне нужен новый класс, который может быть использован tie для привязки к скаляру. Класс должен реализовывать методы: TIESCALAR, STORE и FETCH.

Вот так он выглядит: user.pm

package user;
use feature qw/say/;
use Carp qw/longmess/;
sub TIESCALAR {
    my $class = shift;
    return bless {}, $class;
}
sub STORE {
    my $self = shift;
    my $value = shift;
    $self->{value} = $value;
    say longmess('SET '.$value);
}
sub FETCH {
    my $self = shift;
    return $self->{value};
}
1;

Что здесь происходит: tie связывает указанную переменную с заданным объектом. В результате исходный код совершенно не меняется (это огромный плюс), а у нас есть возможность сделать собственную реализацию методов установки и извлечения значения, добавив туда разный диагностический код.

Объект класса user это самый обычный объект, который будет хранить в себе значение переменной $row->{user}->{age} в своем атрибуте value. (Если этот код непонятен, тогда вам сюда http://perldoc.perl.org/perlobj.html)

Итак. Меня интересует, в каком же месте кода изменилось мое значение $row->{user}->{age}. Я сделала класс user, который будет обеспечивать внутреннюю реализацию, а так же писать сообщения с информацией о том, в каком же месте кода моя переменная получает новое значение.

Carp::longmess - возвращает стек вызовов как строку.

Теперь осталось только подменить переменную объектом:

example.pl

use Utils;
use user;
my $row = { user => { name => 'kate', age => 55 } };
tie $row->{user}->{age}, 'user';
if (check($row)) {
...

Запускаем!

$ perl example.pl 
SET 10 at Uts.pm line 13.
    Uts::format_row('HASH(0x84ecb8)') called at Utils.pm line 8
    Utils::check('HASH(0x86da78)') called at example.pl line 7

NO

Вот и наш виновник: Uts.pm line 13 с чего-то вдруг установил значение 10!

В Uts.pm:13 находится вот это:

$row->{$_} = $modifiers->{$_} for keys %$modifiers;

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

Итак. У нас есть фрагмент кода, который нужно поправить. Давайте сделаем, чтобы он в цикле проверял - если ключ существует в хеше, то пропустить присвоение, а если нет - добавить в хеш. У нас вокруг этого фрагмента еще есть много-много кода-кода, поэтому применим паттерн extract function (Извлечение функции).

Применим автоматизацию. В perl это всегда очень забавно.

У нас есть строка кода, которую мы ходим превратить в функцию. Используем модуль Devel::Refactor.

use Devel::Refactor;
my $refactory = Devel::Refactor->new;
# описываем внутренности нашей будущей функции
my $old_code = <<'end';
$row->{$_} = $modifiers->{$_} for keys %$modifiers;
end

my ($call, $code) = $refactory->extract_subroutine('apply_modifiers', $old_code);
say ($call, $code);

И вот такой результат:

my () = apply_modifiers ($row, $_, $modifiers);
sub apply_modifiers {
    my $row = shift;
    my $_ = shift;
    my $modifiers = shift;

$row->{$_} = $modifiers->{$_} for keys %$modifiers;

    return ();
}

Конечно, не восторг, и в таком виде это не совсем подходит, но если внутри фрагмент кода обрабатывает 5-6 значений, то это сэкономит усилия.

Вопрос: зачем нужно было выносить фрагмент кода в отдельную функцию?

Ответ: рефакторинг наследия можно осуществлять двумя способами “Edit and pray” (редактируй и молись), или “Cover and modify” (Покрывай и меняй).

Мы идем по второму пути. После того, как код выделен в отдельную функцию, описываем для нее тесты, следуя методологии TDD (Как писать юнит-тесты уже, наверное, все знают, не будем отклоняться от темы), затем определяем новое более правильное поведение.

И вот так выглядит новый код:

sub format_row {
    my ($row) = shift;
    #... много-много кода
    apply_modifiers ($row, $modifiers);
    #... много-много кода
    return;
}

sub apply_modifiers {
    my $row = shift;
    my $modifiers = shift;
    for my $attr (keys %$modifiers) {
        next if exists $row->{ $attr };
        $row->{ $attr } = $modifiers->{ $attr };
    }
    return;
}

Она стала более читаемая, покрыта тестами, и дальнейшая модификация будет уже проще.

Но один тест все же будет. Даже не тест, а замер. Производительность важна, и если о ней не заботиться, то внезапно наступает момент, когда ее падение заметно для человека, хотя код развивался эволюционно.

Меряем:

use Benchmark qw(cmpthese);
use Uts;
my $modifiers = {
    age => 10,
    grade => 'high',
};

cmpthese(-1, {
    'old' => sub {
        my $row = { user => { name => 'kate', age => 55 } };
        $row->{$_} = $modifiers->{$_} for keys %$modifiers;
    },
    'new' => sub {
        my $row = { user => { name => 'kate', age => 55 } };
        Uts::apply_modifiers ($row, $modifiers);
    },
});

И результат:

$ perl bench.t 
        Rate  new  old
new 590160/s   -- -18%
old 721308/s  22%   --

Выводы: наш код стал чище и работает правильнее, но за счет потери в производительности. Как решать эту проблему, чтобы снова не превратить код в нечитаемый кошмар, это уже другой вопрос.

Итог: всегда лучше иметь представление какую цену вы платите за улучшение кода. А вообще рефакторинг это всегда увлекательное приключение!

Весь код и текст можно найти на https://github.com/name2rnd/pragmatic.

■ Наталья Савенкова