in reply to Re^10: parse lisp style config
in thread parse lisp style config
Every line can only brankets closed if not open or pure ')'package MyPairList; use strict; use warnings; use feature 'state'; use Data::Dumper; use List::Util qw(all none); use Exporter 'import'; use feature 'current_sub'; our @EXPORT = qw(pair_list_parse); sub pair_list_parse { my $string = shift; my sub get_tokens { my $string = shift; my @tokens = $string =~ /([()\n]|[^()\s]+)/g; } my @tokens = get_tokens $string; my sub check_tokens { my $line; my @line; for my $token (@tokens) { if ($token eq "\n") { $line++; my $left = scalar grep {$_ eq '('} @line; my $right = scalar grep {$_ eq ')'} @line; my $is_open = $line[-1] eq '('; my $is_all_right = $right && not $left; my $is_closed = $right == $left; die "config line $line wrong" unless ( $is_open or $is_all_ +right or $is_closed); @line = (); } else { push @line, $token } } } check_tokens; my sub parse_list { my @list; while (my $token = shift @tokens) { if ($token eq "\n") { next; } elsif ($token eq '(') { push @list, __SUB__->(); } elsif ($token eq ')') { return \@list; } else { push @list, $token; } } return \@list; } my $list = parse_list; my sub parse_nested_list { my ($list) = @_; my %hash; if (none {ref $_} @$list) { if (@$list == 1) { return $list->[0]; } elsif (@$list == 2) { return { $list->[0] => $list->[1] }; } else { return $list } } elsif (all {ref $_} @$list) { return [ map { __SUB__->($_) } @$list ]; } else { my ($key, $ref, @remain) = @$list; die 'wrong key ', Dumper $key if ref $key; die 'wrong value ', Dumper $ref unless ref $ref; die 'redundant value', Dumper \@remain if @remain; $hash{$key} = __SUB__->($ref); } return \%hash; } return parse_nested_list($list) } 1;
|
|---|