Re: Convert Tcl Keyed List to Perl (Tkx, dadum, t2p)

[Anonymous Monk]

Yeah, this if from a few months back -- it's why I dislike Tkx and think Tcl::pTk is sweet :) (and Tcl is ick)

Doesn't deal with escapes/quoted string, not that I've ever seen any such Tcl beasties, but Regexp::Common is there for that

http://cpansearch.perl.org/src/SREZIC/Tk-804.030/HList/Tix2perl didn't work on this data

#!/usr/bin/perl --
use strict; use warnings;
use Data::Dump;

my $str = '{{Register {{CumulativeActive(calls)(In) 0} {CumulativeSucc
+essfullyEstablished(calls)(In) 0} {CumulativeSuccessfullyCompleted(ca
+lls)(In) 0} {CumulativeUnsuccessful(calls)(In) 0} }}} {{{Make Call} {
+{CumulativeActive(calls)(In) 0} {CumulativeSuccessfullyEstablished(ca
+lls)(In) 0} {CumulativeSuccessfullyCompleted(calls)(In) 0} {Cumulativ
+eUnsuccessful(calls)(In) 0} }}} {{Initiating {{CumulativeActive(calls
+)(In) 0} {CumulativeSuccessfullyEstablished(calls)(In) 0} {Cumulative
+SuccessfullyCompleted(calls)(In) 0} {CumulativeUnsuccessful(calls)(In
+) 0} }}} {{Summary {{CumulativeActive(calls)(In) 0} {CumulativeSucces
+sfullyEstablished(calls)(In) 0} {CumulativeSuccessfullyCompleted(call
+s)(In) 0} {CumulativeUnsuccessful(calls)(In) 0} }}}';

eval{require Tkx;1} and dd(  dadum( "$str" ) );
dd( t2p( "$str" ) );

sub dadum {
    my @da = Tkx::SplitList( $_[0] );
    for my $d ( @da ){
        if( $d =~ m{\{.*?\}} ){
            $d = dadum( $d );
        }
    }
    return \@da;
}


sub t2p {
    local $_ = $_[0];
    my $last = my $root = [];
    my @prev;
    pos($_)=0;
    while( length > pos ){
        if( m{ \G \s+ }gscx ){
            next; # ignore space
        } elsif( m{ \G \{ }gscx ){
            push @$last, my $new = [];
            push @prev, $last;
            $last = $new;
        } elsif( m{ \G \} }gscx ){
            $last = pop @prev;
        } elsif( m{ \G ( [^\s\{\}]+ ) }gscx ){
            push @$last, $1;
        } elsif( m{ \G (.) }gscx ){
            push @$last, { error => $1 };
        }
    }
    $root
}
__END__

[Anonymous Monk]

Shows how well I know tcl (i dont)

use Regexp::Common;
sub t2p {
    local $_ = $_[0];
    my $last = my $root = [];
    my @prev;
    pos($_)=0;
    while( length > pos ){
        if( m{ \G \s+ }gscx ){
            next; # ignore space
        } elsif( m{ \G \{ }gscx ){
            push @$last, my $new = [];
            push @prev, $last;
            $last = $new;
        } elsif( m{ \G \} }gscx ){
            $last = pop @prev;
#~         } elsif( m{ \G ( [^\s\{\}]+ ) }gscx ){
        } elsif( m{ \G ( $RE{quoted} ) }gscx ){
            push @$last, $1;
#~         } elsif( m{ \G ( [^\s\{\}]+ ) }gscx ){
        } elsif( m{ \G ( [^\{\}\\]+ | \\[\{\}] ) }gscx ){
            push @$last, $1;
        } elsif( m{ \G (.) }gscx ){
            push @$last, { error => $1 };
        }
    }
    $root
}