#!C:\Perl\bin\perl.exe
use strict;
use warnings;
use Data::Dumper; 

my $fh = \*DATA; 

print Dumper parse_constant_spec( $fh ); 


# Parse a constant spec file. 
# Pass in a handle to process. 
# As long as it acts like a file handle,it will work. 
sub parse_constant_spec { 
    my $fh = shift; 

    my %spec; 

    # Until file is done: 
        # Read in a whole block 
    while( my $block = read_block($fh) ) { 

        # Parse the and return key/value pairs for a hash. 
        my %constant = parse_block( $block ); 

        # Store a ref to the hash in a big hash of all blocks,keyed by constant_name. 
        $spec{ $constant{const_name} } = \%constant; 

    } 

    # Return ref to big hash with all block data 
    return \%spec; 
} 

# Read a constant definition block from a file handle. 
# void return when there is no data left in the file. 
# Otherwise return an array ref containing lines to in the block.  
sub read_block { 
    my $fh = shift; 

    my @lines; 
    my $block_started = 0; 

    while( my $line = <$fh> ) { 

        $block_started++ if $line =~ /^constant/; 

        if( $block_started ) { 

            last if $line =~ /^\s*$/; 

            push @lines,$line; 
        } 
    } 

    return \@lines if @lines; 

    return; 
} 


sub parse_block { 
    my $block = shift; 
    my ($start_line,@attribs) = @$block; 

    my %constant; 

    # Break down first line: 
    # First separate assignment from option list. 
    my ($start_head,$start_tail) = split /=/,$start_line; 

    # work on option list 
    my @options = split /\s+/,$start_head; 

    # Recover constant_name from options: 
    $constant{const_name} = pop @options; 
    $constant{options} = \@options; 

    # Now we parse the value/type specifier 
    @constant{'type','value' } = parse_type_value_specifier( $start_tail ); 

    # Parse attribute lines. 
    # since we've already got multiple per line,get them all at once. 
    chomp @attribs; 
    my $attribs = join ' ',@attribs; 

    #  we have one long line of mixed key = "value" or key = <TYPE VALUE>  

    @attribs = $attribs =~ /\s*(\w+\s+=\s+\w+\s+|\w+\s+=\s+".*?"|\w+\s+=\s+<.*?>)\s*/g; 

    for my $attrib ( @attribs ) { 
        warn "$attrib\n"; 
        my ($name,$value) = split /\s*=\s*/,$attrib; 

        if( $value =~ /^"/ ) {  
            $value =~ s/^"|"\s*$//g; 
        } 
        elsif( $value =~ /^</ ) { 
           $value = [ parse_type_value_specifier( $start_tail ) ]; 
        } 
        else { 
            warn "Bad line"; 
        } 

        $constant{ $name } = $value; 
    } 

    return %constant; 
} 

sub parse_type_value_specifier { 
    my $tvs = shift; 

    my ($type,$value) = $tvs =~ /<(\w+)\s+(.*?)>/; 

    return $type,$value; 
} 

__DATA__ 
constant fixup GemEstabCommDelay = <U2 20> 
    vid = 6 
    name = "ESTABLISHCOMMUNICATIONSTIMEOUT" 
    units = "s" 
    min = <U2 0> 
    max = <U2 1800> 
    default = <U2 20> 


constant fixup private GemConstantFileName = <A "C:\\TMP\\CONST.LOG"> 
    vid = 4 
    name = ""  units = "" 


constant fixup private GemAlarmFileName = <A "C:\\TMP\\ALARM.LOG"> 
    vid = 0 
    name = "" 
    units = ""

输出：

D:\learning\perl>hello1.pl
vid = 6
Bad line at D:\learning\perl\hello1.pl line 102,<DATA> line 8.
name = "ESTABLISHCOMMUNICATIONSTIMEOUT"
units = "s"
min = <U2 0>
max = <U2 1800>
default = <U2 20>
vid = 4
Bad line at D:\learning\perl\hello1.pl line 102,<DATA> line 13.
name = ""
units = ""
vid = 0
Bad line at D:\learning\perl\hello1.pl line 102,<DATA> line 18.
name = ""
units = ""
$VAR1 = {
          'GemAlarmFileName' => {
                                  'vid' => '0      ','options' => [
                                                 'constant','fixup','private'
                                               ],'value' => '"C:\\\\TMP\\\\ALARM.LOG"','name' => '','type' => 'A','const_name' => 'GemAlarmFileName','units' => ''
                                },'GemEstabCommDelay' => {
                                   'vid' => '6      ','options' => [
                                                  'constant','fixup'
                                                ],'value' => '20','min' => [
                                              'U2','20'
                                            ],'name' => 'ESTABLISHCOMMUNICATIONSTIMEOUT','max' => [
                                              'U2','default' => [
                                                  'U2','20'
                                                ],'type' => 'U2','units' => 's','const_name' => 'GemEstabCommDelay'
                                 },'GemConstantFileName' => {
                                     'vid' => '4      ','options' => [
                                                    'constant','private'
                                                  ],'value' => '"C:\\\\TMP\\\\CONST.LOG"','const_name' => 'GemConstantFileName','units' => ''
                                   }
        };

D:\learning\perl>

你可以注意到’vid’=> ‘0’,(注意空格)

上面的代码从the answer.我正在研究它. 原文链接：https://www.f2er.com/Perl/172595.html