| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Hub::Parse::DataExtractor; | 
| 2 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 31 |  | 
| 3 | 1 |  |  | 1 |  | 5 | use Hub qw/:lib/; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | push our @ISA, qw(Hub::Parse::Parser); | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our %EVALUATORS; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | sub get_evaluator { | 
| 10 | 0 | 0 |  | 0 | 1 | 0 | my $evaluator = defined $EVALUATORS{$_[1]} | 
| 11 |  |  |  |  |  |  | ? $EVALUATORS{$_[1]} | 
| 12 |  |  |  |  |  |  | : &Hub::Parse::Parser::get_evaluator(@_); | 
| 13 |  |  |  |  |  |  | # Avoid undefined parser directive warnings | 
| 14 | 0 | 0 |  | 0 |  | 0 | return defined $evaluator ? $evaluator : sub {}; | 
|  | 0 |  |  |  |  | 0 |  | 
| 15 |  |  |  |  |  |  | } | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | $EVALUATORS{'define'} = sub { | 
| 18 |  |  |  |  |  |  | my ($self, $params, $result) = @_; | 
| 19 |  |  |  |  |  |  | my ($outer_str, $fields, $pos, $text, $parents, $valdata) = @$params; | 
| 20 |  |  |  |  |  |  | my ($opts, %directive) = Hub::hashopts($fields); | 
| 21 |  |  |  |  |  |  | my $varname = $directive{'define'}; | 
| 22 |  |  |  |  |  |  | my ($end_p, $block) = | 
| 23 |  |  |  |  |  |  | $self->_get_block($$pos + length($outer_str), $text, 'define'); | 
| 24 |  |  |  |  |  |  | $$result{'width'} = $end_p - $$pos; | 
| 25 |  |  |  |  |  |  | $directive{'as'} = 'HASH' unless defined $directive{'as'}; | 
| 26 |  |  |  |  |  |  | my $data = (); | 
| 27 |  |  |  |  |  |  | if ($directive{'as'} =~ /^(DATA|HASH)$/i) { | 
| 28 |  |  |  |  |  |  | if (defined $varname) { | 
| 29 |  |  |  |  |  |  | $self->{'data'}{$varname} ||= mkinst('SortedHash'); | 
| 30 |  |  |  |  |  |  | Hub::hparse($block, -into => $self->{'data'}{$varname}); | 
| 31 |  |  |  |  |  |  | } else { | 
| 32 |  |  |  |  |  |  | Hub::hparse($block, -into => $self->{'data'}); | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  | } elsif ($directive{'as'} =~ /^(LIST|ARRAY)$/i) { | 
| 35 |  |  |  |  |  |  | if (defined $varname) { | 
| 36 |  |  |  |  |  |  | $self->{'data'}{$varname} ||= []; | 
| 37 |  |  |  |  |  |  | die "Cannot parse array data into: $self->{'data'}{$varname}" | 
| 38 |  |  |  |  |  |  | unless isa($self->{'data'}{$varname}, 'ARRAY'); | 
| 39 |  |  |  |  |  |  | Hub::hparse($block, -into => $self->{'data'}{$varname}); | 
| 40 |  |  |  |  |  |  | } else { | 
| 41 |  |  |  |  |  |  | die "Cannot use root element as: $directive{'as'}\n"; | 
| 42 |  |  |  |  |  |  | } | 
| 43 |  |  |  |  |  |  | } elsif ($directive{'as'} =~ /^(TEXT|SCALAR)$/i) { | 
| 44 |  |  |  |  |  |  | if (defined $varname) { | 
| 45 |  |  |  |  |  |  | $self->{'data'}{$varname} = $block; | 
| 46 |  |  |  |  |  |  | } else { | 
| 47 |  |  |  |  |  |  | die "Cannot use root element as: $directive{'as'}\n"; | 
| 48 |  |  |  |  |  |  | } | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  | }; | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | sub get_value { | 
| 53 | 0 |  |  | 0 | 1 | 0 | return ''; | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | # ------------------------------------------------------------------------------ | 
| 57 |  |  |  |  |  |  | # get_data - Return extracted data | 
| 58 |  |  |  |  |  |  | # ------------------------------------------------------------------------------ | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | sub get_data { | 
| 61 | 7 |  |  | 7 | 1 | 170 | my ($self,$opts) = Hub::objopts(\@_); | 
| 62 | 7 |  | 50 |  |  | 24 | $$self{'data'} ||= {}; | 
| 63 | 7 |  |  |  |  | 42 | $self->populate(); | 
| 64 | 7 |  |  |  |  | 62 | return $$self{'data'}; | 
| 65 |  |  |  |  |  |  | }#get_data | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | 1; |