96 |
$Element->isa('PPI::Token::Word') or return ''; |
$Element->isa('PPI::Token::Word') or return ''; |
97 |
$Element->content eq 'lookup' or return ''; |
$Element->content eq 'lookup' or return ''; |
98 |
|
|
99 |
print "#*** expansion: ", $Element->snext_sibling,$/; |
$log->debug("expansion: ", $Element->snext_sibling); |
100 |
|
|
101 |
my $args = $Element->snext_sibling; |
my $args = $Element->snext_sibling; |
102 |
|
|
103 |
my @e = $args->child(0)->elements; |
my @e = $args->child(0)->elements; |
104 |
print "hum, expect at least 8 elements, got ", scalar @e, " in $args\n" if ($#e < 8); |
$log->logdie("hum, expect at least 8 elements, got ", scalar @e, " in $args") if ($#e < 8); |
105 |
|
|
106 |
print "# found ", scalar @e, " elements:\n"; |
if ($log->is_debug) { |
107 |
|
my $report = "found " . scalar @e . " elements:\n"; |
108 |
|
|
109 |
foreach my $i ( 0 .. $#e ) { |
foreach my $i ( 0 .. $#e ) { |
110 |
printf("# %-2d: %-30s %s\n", $i, ( $e[$i] || 'undef' ), $e[$i]->class ); |
$report .= sprintf("# %-2d: %-30s %s\n", $i, ( $e[$i] || 'undef' ), $e[$i]->class ); |
111 |
|
} |
112 |
|
|
113 |
|
$log->debug($report); |
114 |
} |
} |
115 |
|
|
116 |
my $key_element = $e[8]->clone; |
my $key_element = $e[8]->clone; |
117 |
|
|
118 |
die "key element must be PPI::Structure::Block" unless $key_element->isa('PPI::Structure::Block'); |
$log->logdie("key element must be PPI::Structure::Block") unless $key_element->isa('PPI::Structure::Block'); |
119 |
|
|
120 |
print "## key part: ", $key_element, $/; |
$log->debug("key part: ", $key_element); |
121 |
|
|
122 |
my @key; |
my @key; |
123 |
|
|
128 |
|
|
129 |
my $kf = $e->snext_sibling; |
my $kf = $e->snext_sibling; |
130 |
|
|
131 |
print "## key fragment = $kf\n"; |
$log->debug("key fragment = $kf"); |
132 |
|
|
133 |
push @key, eval $kf; |
push @key, eval $kf; |
134 |
print "ERROR: can't eval { $kf }: $@" if ($@); |
$log->logdie("can't eval { $kf }: $@") if ($@); |
135 |
|
|
136 |
return 1; |
return 1; |
137 |
}); |
}); |
138 |
|
|
139 |
my $key = join('-', @key ) || print "ERROR: no key found!"; |
my $key = join('-', @key ) || $log->logdie("no key found!"); |
140 |
|
|
141 |
print "key = $key\n"; |
$log->debug("key = $key"); |
142 |
|
|
143 |
my $create = ' |
my $create = ' |
144 |
$coderef = ' . $e[7] . $e[8] . '; |
$coderef = ' . $e[7] . $e[8] . '; |
148 |
} |
} |
149 |
'; |
'; |
150 |
|
|
151 |
print "create: $create\n"; |
$log->debug("create: $create"); |
152 |
|
|
153 |
$create =~ s/\s+/ /gs; |
$create =~ s/\s+/ /gs; |
154 |
$eval_create->{ $e[3] }->{ $e[5] } .= $create; |
$eval_create->{ $e[3] }->{ $e[5] } .= $create; |
164 |
$e[8]->remove; |
$e[8]->remove; |
165 |
|
|
166 |
|
|
167 |
print "# >>> ", $Element->snext_sibling, "\n"; |
$log->debug(">>> ", $Element->snext_sibling); |
168 |
}); |
}); |
169 |
|
|
170 |
print "-----\ncreate: ", dump($eval_create), "\n"; |
$log->info("create: ", dump($eval_create) ); |
171 |
print "-----\nlookup: ", $Document->serialize, "\n"; |
$log->info("lookup: ", $Document->serialize ); |
|
print "-----\n"; |
|
172 |
|
|
173 |
my $Dumper = PPI::Dumper->new( $Document ); |
if ($self->{debug}) { |
174 |
$Dumper->print; |
my $Dumper = PPI::Dumper->new( $Document ); |
175 |
|
$Dumper->print; |
176 |
|
} |
177 |
|
|
178 |
|
return 1; |
179 |
} |
} |
180 |
|
|
181 |
=head1 AUTHOR |
=head1 AUTHOR |