Perlの静的解析入門とPerlリファクタリングツールApp::PRTのご紹介

Cc696ce673253d3bd21b3aa9e7927f39?s=47 hitode909
August 30, 2014

 Perlの静的解析入門とPerlリファクタリングツールApp::PRTのご紹介

YAPC::Asia Tokyo 2014で発表しました

Cc696ce673253d3bd21b3aa9e7927f39?s=128

hitode909

August 30, 2014
Tweet

Transcript

  1. 35.

    %FWFM3FGBDUPS my $regex1 = '(\W)(' . $old_name . ')(\W)'; my

    $regex2 = "^$old_name(" . '\W)'; while (<$fh>) { $line_number++; if (/$regex1/o or /$regex2/o) { my $new_line = $_; $new_line =~ s/$regex1/$1$new_name$3/g; $new_line =~ s/$regex2/$new_name$1/; ਖ਼نදݱͰஔ׵ 14೥8݄30೔౔༵೔
  2. 36.

    %FWFM3FGBDUPS sub _syntax_check{ my $self = shift; my $tmp; my

    $eval_stmt = "my (". join ', ', @{$self->{parms}}; $eval_stmt .= ");\n"; $eval_stmt .= $self->get_sub_call(); $eval_stmt .= $self->get_new_code(); $self->{eval_code} = $eval_stmt; eval " $eval_stmt "; if ($@) { $self->{eval_err} = $@; FWBMͯ͠੒ޭ͔ͨ͠ݟΔ ͱʹ͔͘ϫΠϧυ 14೥8݄30೔౔༵೔
  3. 44.

    TFE͸ਫ਼౓௿͍ my $blog = shift; print $blog->{id}; print $blog->{user_id}; my

    $blog = shift; print $blog->{article_id}; print $blog->{user_article_id}; sed -e “s/id/article_id/” 14೥8݄30೔౔༵೔
  4. 53.

    ‘;’ ߏจ໦ ‘print’ ‘ ‘ List ‘ ‘ ‘ ‘

    ‘1’ ‘ ‘ ‘*’ ‘ ‘ ‘2’ ‘+’ ‘3’ Statement Document print (1 * 2) + 3; 14೥8݄30೔౔༵೔
  5. 55.

    ‘;’ ߏจ໦ ‘print’ ‘ ‘ Statement Document print "(1 *

    2) + 3"; ‘"(1 * 2) + 3"’ 14೥8݄30೔౔༵೔
  6. 62.

    11*Ͱߏจ໦ݟ͍ͨ print (1 * 2) + 3; 11*%PDVNFOU 11*4UBUFNFOU 11*5PLFO8PSEQSJOU

    11*5PLFO8IJUFTQBDF 11*4USVDUVSF-JTU  11*4UBUFNFOU&YQSFTTJPO 11*5PLFO/VNCFS 11*5PLFO8IJUFTQBDF 11*5PLFO0QFSBUPS  11*5PLFO8IJUFTQBDF 11*5PLFO/VNCFS 11*5PLFO8IJUFTQBDF 11*5PLFO0QFSBUPS  11*5PLFO8IJUFTQBDF 11*5PLFO/VNCFS 11*5PLFO4USVDUVSF 11*5PLFO8IJUFTQBDFaO use PPI; use PPI::Dumper; my $document = PPI::Document->new($ARGV[0]); my $dumper = PPI::Dumper->new($document); $dumper->print; 14೥8݄30೔౔༵೔
  7. 63.

    ‘;’ Ͱ͖ͨ ‘print’ ‘ ‘ List ‘ ‘ ‘ ‘

    ‘1’ ‘ ‘ ‘*’ ‘ ‘ ‘2’ ‘+’ ‘3’ Statement Document print (1 * 2) + 3; 14೥8݄30೔౔༵೔
  8. 64.

    11*Ͱ໋ྩ਺ݟ͍ͨ my $document = PPI::Document->new($ARGV[0]); my $statements = $document->find('PPI::Statement'); my

    $statement_count = @$statements; say "count: $statement_count"; 14೥8݄30೔౔༵೔
  9. 65.

    11*Ͱ'J[[#V[[Λഁյ͍ͨ͠ use PPI; my $path = $ARGV[0]; my $document =

    PPI::Document->new($path); my $tokens = $document->find('PPI::Token'); for my $token (@$tokens) { if (ref $token eq 'PPI::Token::Number') { $token->set_content($token->content * 2); } } $document->save("broken-$path"); 14೥8݄30೔౔༵೔
  10. 66.

    11*Ͱ'J[[#V[[Λഁյ͍ͨ͠ use PPI; my $path = $ARGV[0]; my $document =

    PPI::Document->new($path); my $tokens = $document->find('PPI::Token'); for my $token (@$tokens) { if (ref $token eq 'PPI::Token::Number') { $token->set_content($token->content * 2); } } $document->save("broken-$path"); ਺ࣈΛݟ͚ͭͨΒ ͱΓ͋͑ͣഒʹ͢Δ 14೥8݄30೔౔༵೔
  11. 67.

    ͜Ε͕ use strict; use warnings; for my $i (1..20) {

    my $message = ""; $message .= "Fizz" unless $i % 3; $message .= "Buzz" unless $i % 5; $message = $i unless $message; print "$message\n"; } 14೥8݄30೔౔༵೔
  12. 68.

    ͜͏ use strict; use warnings; for my $i (2..40) {

    my $message = ""; $message .= "Fizz" unless $i % 6; $message .= "Buzz" unless $i % 10; $message = $i unless $message; print "$message\n"; } 14೥8݄30೔౔༵೔
  13. 69.

    -(5.  'J[[    #V[[  'J[[ 

        'J[[  #V[[    'J[[      'J[[#V[[      'J[[  14೥8݄30೔౔༵೔
  14. 72.

    my $app = sub { return [ 200, [ 'Content-Type'

    => 'text/plain' ], [ 'Hello World' ] ]; }; 14೥8݄30೔౔༵೔
  15. 73.

    my $app = sub { return [ 400, [ 'Content-Type'

    => 'text/plain' ], [ 'Hello World' ] ]; }; 14೥8݄30೔౔༵೔
  16. 74.

    my $app = sub { return [ 400, [ 'Content-Type'

    => 'text/plain' ], [ 'Hello World' ] ]; }; ഒ 14೥8݄30೔౔༵೔
  17. 81.

    งғؾ my $doc = PPI::Document->new($file); my $statements = $doc->find('PPI::Statement'); grep

    { my $tokens = [ $_->children ]; any { $_ eq $self->word; } @$tokens; } @$statements; 14೥8݄30೔౔༵೔
  18. 85.

    package Antipop; use strict; use warnings; our $VERSION = '0.01';

    sub talk { return q{ҿΈʹߦͧ͘!!1}; } !!1; __END__ 14೥8݄30೔౔༵೔
  19. 89.

    1FSM$SJUJD1PMJDZ.PEVMFT3FRVJSF&OE8JUI0OF sub violates { my ( $self, $elem, $doc )

    = @_; # Last statement should be just "1;" my @significant = grep { _is_code($_) } $doc->schildren(); my $match = $significant[-1]; return if !$match; return if ((ref $match) eq 'PPI::Statement' && $match =~ m{\A 1 \s* ; \z}xms ); # Must be a violation... return $self->violation( $DESC, $EXPL, $match ); } 14೥8݄30೔౔༵೔
  20. 109.
  21. 111.
  22. 113.
  23. 115.
  24. 135.

    Service::User->find_user_by_name($r, $name); sub find_user_by_name { my ($class, $r, $name) =

    @_; $r->db->select(..., $name); } CFGPSF 14೥8݄30೔౔༵೔
  25. 136.
  26. 138.

    Service::User->find_user_by_name($r->db, $name); sub find_user_by_name { my ($class, $db, $name) =

    @_; $db->select(..., $name); } ݺͼग़͠ݩͰ $r → $r->db ݺͼग़͠ઌͰ $r → $db $r->db → $db 14೥8݄30೔౔༵೔
  27. 140.

    sub aaa { my ($class, $r = @_; AnotherService->bbb($r); $r->db->select(...,

    $user->name); } ΄͔ͷϝιουʹS౉ͯ͠Δ 14೥8݄30೔౔༵೔
  28. 141.

    sub aaa { my ($class, $r) = @_; AnotherService->bbb($r->db); $r->db->select(...,

    $user->name); } ΄͔ͷϝιουʹS౉ͯ͠Δ ઌʹ"OPUIFS4FSWJDFΛ ϦϑΝΫλϦϯά 14೥8݄30೔౔༵೔
  29. 142.

    sub aaa { my ($class, $db) = @_; AnotherService->bbb($db); $db->select(...,

    $user->name); } ΄͔ͷϝιουʹS౉ͯ͠Δ ઌʹ"OPUIFS4FSWJDFΛ ϦϑΝΫλϦϯά ϝιου಺͕શͯSECͳΒॻ͖׵͑ΒΕΔ 14೥8݄30೔౔༵೔
  30. 143.

    sub aaa { my ($class, $r) = @_; my $user

    = $r->user; $r->db->select(..., $user->name); } ECҎ֎΋࢖ͬͯΔ 14೥8݄30೔౔༵೔
  31. 144.

    sub aaa { my ($class, $r, $user) = @_; $r->db->select(...,

    $user->name); } ECҎ֎΋࢖ͬͯΔ VTFS΋ड͚औΔ ͜Ε͸ػցతʹ͸Ͱ͖ͳ͍ͷͰख࡞ۀ 14೥8݄30೔౔༵೔
  32. 147.

    ࢦఆ͞ΕͨϑΝΠϧ ॱ൪ʹݟΔ sub replace_all { for my $file (@ARGV) {

    my $document = PPI::Document->new($file); my $package = $document->find_first( 'PPI::Statement::Package' ); my $package_name = $package->namespace; my $methods = $document->find( 'PPI::Statement::Sub' ); for my $method (@$methods) { my $document = PPI::Document->new($file); ...; } } } 14೥8݄30೔౔༵೔
  33. 148.

    SECΛECʹஔ׵ sub r_db_to_db { my ($statement) = @_; my $tokens

    = [$statement->children]; for my $token (@$tokens) { if ($token eq '$r') { if ($token->next_token eq '->') { if ($token->next_token->next_token eq 'db') { $token->set_content('$db'); $token->next_token->set_content(''); $token->next_token->next_token->set_content(''); } else { die "->@{[ $token->next_token->next_token ]}"; } } else { die "@{[ $token->next_token ]}"; } } } } 14೥8݄30೔౔༵೔
  34. 149.

    ݺͼग़͠ݩͷมߋ $command = 'prt replace_token \'' . $package_name . '->'

    . $method_name . '($r\' \'' . $package_name . '->' . $method_name . '($r->db\' --in- statement ' . $method_name . ' $(git grep --name-only ' . $method_name . ')'; system $command; 14೥8݄30೔౔༵೔
  35. 150.

    Ϋϥε಺Ͱͷݺͼग़͠มߋ $command = 'prt replace_token \'$class' . '->' . $method_name

    . '($r\' \'$class' . '->' . $method_name . '($r->db\' --in- statement ' . $method_name . ' ' . $file; system $command; 14೥8݄30೔౔༵೔
  36. 151.

    มߋՕॴΛςετͯ͠ίϛοτ if (`git diff --name-only t/**.t`) { system('carton exec --

    prove $(git diff -- name-only t/**.t)') and die "test failed"; } else { warn 'skip test'; } system "git commit -am '$package_name\ͷ $method_name\Λ\$db Λड͚औΔΑ͏ʹมߋ'"; system "git push"; 14೥8݄30೔౔༵೔