[Rt-commit] r10630 - rt/branches/3.999-DANGEROUS/temp_refactoring_tools

[ruz at bestpractical.com]

Author: ruz
Date: Thu Jan 31 19:40:53 2008
New Revision: 10630

Modified:
   rt/branches/3.999-DANGEROUS/temp_refactoring_tools/crazy_ppi_way.pl

Log:
* update ppi script

Modified: rt/branches/3.999-DANGEROUS/temp_refactoring_tools/crazy_ppi_way.pl
==============================================================================
--- rt/branches/3.999-DANGEROUS/temp_refactoring_tools/crazy_ppi_way.pl	(original)
+++ rt/branches/3.999-DANGEROUS/temp_refactoring_tools/crazy_ppi_way.pl	Thu Jan 31 19:40:53 2008
@@ -9,14 +9,53 @@
 
     my $doc = PPI::Document->new( $f );
     my $subs = $doc->find('PPI::Statement::Sub');
-    guess_sub_args($_) foreach @$subs;
+    if ( $subs && @$subs ) {
+        process_sub_args($_) foreach @$subs;
+        $doc->save($f);
+        $doc = PPI::Document->new( $f );
+    } else {
+        print "no subs found in the file\n";
+    }
+
+    process_calls($doc);
     $doc->save($f);
 }
 
+sub process_calls {
+    my $doc = shift;
+#    dumpe($doc);
+    my $method_calls = $doc->find(sub {
+        return 0 unless $_[1]->isa('PPI::Token::Operator') && $_[1] eq '->';
+        my $sib = $_[1]->next_sibling;
+        return 0 unless $sib && $sib->isa('PPI::Token::Word');
+        $sib = $sib->next_sibling;
+        return 0 unless $sib && $sib->isa('PPI::Structure::List');
+    });
+    unless ( $method_calls && @$method_calls ) {
+        print "no method calls\n";
+        return;
+    }
+    foreach my $call ( @$method_calls ) {
+        print 'call to '. $call->next_sibling->literal ."\n";
+        my $list = $call->next_sibling->next_sibling;
+        next unless $list->find_first('PPI::Statement::Expression');
+        foreach my $word ( grep $_->isa('PPI::Token::Word'), $list->find_first('PPI::Statement::Expression')->schildren ) {
+            my $sib = $word->snext_sibling;
+            next unless $sib && $sib->isa('PPI::Token::Operator') && $sib eq '=>';
+            next unless $word->literal =~ /[A-Z][a-z]/;
+            $word->set_content( low_api( $word->literal) );
+#            dumpe($word);
+        }
+    }
+
+#    dumpe($_->statement) foreach @$method_calls;
+}
+
 
 
-sub guess_sub_args {
+sub process_sub_args {
     my $sub = shift;
+#    return unless $sub->name eq 'set_from_config';
     print $sub->name ."\n";
     my $block = $sub->block;
     my @children = $block->schildren;
@@ -50,6 +89,7 @@
     my @names;
     while ( my $token = shift @tokens ) {
         next if $token->isa('PPI::Token::Whitespace');
+        dumpe( $token );
         unless ( $state ) {
             unless ( $token->isa('PPI::Token::Word') ) {
                 if ( $token->isa('PPI::Token::Magic') && $token eq '@_' ) {
@@ -92,6 +132,10 @@
         return 0 unless $sib->isa('PPI::Structure::Subscript');
         return 1;
     });
+    unless ( $usages && @$usages ) {
+        print "no usages found\n";
+        return;
+    }
     foreach my $u ( @$usages ) {
         my $subscript = $u->next_sibling;
         my $quotes = $subscript->find(sub{
@@ -102,7 +146,15 @@
             print "no quoted string or more then one\n";
             next;
         }
-        next unless my $replacement = $convs{ $quotes->[0]->string };
+        my $replacement = $convs{ $quotes->[0]->string };
+        unless ( $replacement ) {
+            if ( $quotes->[0]->string =~ /[A-Z][a-z]/ ) {
+                print "WARNING!!! potential bug\n";
+                $replacement = low_api( $quotes->[0]->string );
+            } else {
+                next;
+            }
+        }
         $quotes->[0]->set_content( "'". $replacement ."'");
     }
 }