Convert Tcl Keyed List to Perl

[bkobs39]

Hi, I'm using the Tcl module to execute a few commands, communicating with an RPC Server through a Tcl API. I am being returned a keyed list. Is there anyway to convert this list into something useful in Perl where I can retrieve values.

Here is the keyed list that I have a handle on in Perl:

Stats: {{Register {{CumulativeActive(calls)(In) 0} {CumulativeSuccessf
+ullyEstablished(calls)(In) 0} {CumulativeSuccessfullyCompleted(calls)
+(In) 0} {CumulativeUnsuccessful(calls)(In) 0} }}} {{{Make Cal
l} {{CumulativeActive(calls)(In) 0} {CumulativeSuccessfullyEstablished
+(calls)(In) 0} {CumulativeSuccessfullyCompleted(calls)(In) 0} {Cumula
+tiveUnsuccessful(calls)(In) 0} }}} {{Initiating {{CumulativeA
ctive(calls)(In) 0} {CumulativeSuccessfullyEstablished(calls)(In) 0} {
+CumulativeSuccessfullyCompleted(calls)(In) 0} {CumulativeUnsuccessful
+(calls)(In) 0} }}} {{Summary {{CumulativeActive(calls)(In) 0}
 {CumulativeSuccessfullyEstablished(calls)(In) 0} {CumulativeSuccessfu
+llyCompleted(calls)(In) 0} {CumulativeUnsuccessful(calls)(In) 0} }}}

What would be the easiest way for me to get the value of Make Call->CumulativeSuccessfullyEstablished(calls)(In) for example?

[LanX]

Wow, seems like John Ousterhout really loved LISP

I was so kind to format your data with emacs

$kl_string=<<__KL__
{
  {Register {
    {CumulativeActive(calls)(In) 0}
    {CumulativeSuccessfullyEstablished(calls)(In) 0}
    {CumulativeSuccessfullyCompleted(calls)(In) 0}
    {CumulativeUnsuccessful(calls)(In) 0}
  }
 }
}
{
  {
    {Make Cal l}
    {
      {CumulativeActive(calls)(In) 0}
      {CumulativeSuccessfullyEstablished(calls)(In) 0}
      {CumulativeSuccessfullyCompleted(calls)(In) 0}
      {CumulativeUnsuccessful(calls)(In) 0}
    }
  }
}
{
  {Initiating {
    {CumulativeA ctive(calls)(In) 0}
    {CumulativeSuccessfullyEstablished(calls)(In) 0}
    {CumulativeSuccessfullyCompleted(calls)(In) 0}
    {CumulativeUnsuccessful(calls)(In) 0}
  }
 }
}
{
  {Summary {
    {CumulativeActive(calls)(In) 0}
    {CumulativeSuccessfullyEstablished(calls)(In) 0}
    {CumulativeSuccessfullyCompleted(calls)(In) 0}
    {CumulativeUnsuccessful(calls)(In) 0}
  }
 }
}
__KL__

and as it turns out it's a mixture of nested lists and keyed lists.¹

What's worse, I can't easily see a way to automatically distinguish between the two ...

(OK it's more than a decade that I used TCL for the last time.)

So w/o deeper information of the schema I'd rather recommend to try to find a JSON interface for TCL.

¹) I suppose you want a nested data structure with Perl arrays and hashes

[LanX]

this is a hack, no warranty whatsoever!

$tcl_data =~ s/([^{}\s]+)/'$1',/g;    # quote words + comma
$tcl_data =~ s/{/[/g;                 # start list
$tcl_data =~ s/}/],/g;                # end list + comma

#print $tcl_data;

my @perl_arr = eval($tcl_data);       # interpret as Array of AoAoA...

use Data::Dump 'pp';

pp @perl_arr;

thats the output

(
  [
    [
      "Register",
      [
        ["CumulativeActive(calls)(In)", 0],
        ["CumulativeSuccessfullyEstablished(calls)(In)", 0],
        ["CumulativeSuccessfullyCompleted(calls)(In)", 0],
        ["CumulativeUnsuccessful(calls)(In)", 0],
      ],
    ],
  ],
  [
    [
      ["Make", "Cal", "l"],
      [
        ["CumulativeActive(calls)(In)", 0],
        ["CumulativeSuccessfullyEstablished(calls)(In)", 0],
        ["CumulativeSuccessfullyCompleted(calls)(In)", 0],
        ["CumulativeUnsuccessful(calls)(In)", 0],
      ],
    ],
  ],
  [
    [
      "Initiating",
      [
        ["CumulativeActive(calls)(In)", 0],
        ["CumulativeSuccessfullyEstablished(calls)(In)", 0],
        ["CumulativeSuccessfullyCompleted(calls)(In)", 0],
        ["CumulativeUnsuccessful(calls)(In)", 0],
      ],
    ],
  ],
  [
    [
      "Summary",
      [
        ["CumulativeActive(calls)(In)", 0],
        ["CumulativeSuccessfullyEstablished(calls)(In)", 0],
        ["CumulativeSuccessfullyCompleted(calls)(In)", 0],
        ["CumulativeUnsuccessful(calls)(In)", 0],
      ],
    ],
  ],
)

you might wanna dig in and try to identify "arrays of two element arrays where the first element is a scalar" ( the "definition" of keyed lists), to convert them into hashes in the next step.

[jaredor]

According to Abelson, Greenspun and Sandon, Ousterhout's love was a touch impure & practical. Per the slightly rueful historical assessment at the end of their Introduction to Tcl for Web Nerds:

Lisp Without a Brain

If in reading this introduction, you've come to realize that "Hey, Tcl is just like Lisp, but without a brain, and with syntax on steroids", you might wonder why Lisp isn't a more popular scripting language than Tcl. Lisp hasn't been a complete failure, by the way; it is used as an extension language by users of some popular programs, notably AutoCAD. But Tcl has been much more successful. It has been compiled into hundreds of larger programs, including AOLserver, which is why we wrote this book.

I wonder what "Perl Without a Brain" would be?

[LanX]

> I wonder what "Perl Without a Brain" would be?

LOL ... brilliant analogy! xD

[hdb]

Re-using a parser I have applied on PM several times now:

use strict; 
use warnings; 
use Data::Dumper;

my %tcl;
my $ptr;
my $threshold = 3;

sub store_word {
  my ( $level, $word ) = @_;
  $word =~ s/^\s+//g; 
  $word =~ s/\s+$//g; 
  return "" unless $word;
  if( $level <= $threshold ) {
    $tcl{$word} = {} if not defined $tcl{$word};
    $ptr = $tcl{$word};
  } else {
    my ( $call, $value ) = split / /, $word;
    $ptr->{ $call } = $value;
  }
  return "";
}

while(my $input = <DATA>){ 
  my $level  = 0; 
  my $word   = ""; 
  my %action = ( 
                '{'       => sub { $word = store_word( $level++, $word
+ ) }, 
                '}'       => sub { $word = store_word( $level--, $word
+ ) }, 
                'default' => sub { $word .= shift }, 
               ); 
  
  ( $action{$_} // $action{'default'} )->($_) for $input =~ /./g; 
} 

print Dumper(\%tcl);
print $tcl{'Make Cal l'}{'CumulativeSuccessfullyEstablished(calls)(In)
+'}, "\n";

__DATA__ 
{{Register {{CumulativeActive(calls)(In) 0} {CumulativeSuccessfullyEst
+ablished(calls)(In) 0} {CumulativeSuccessfullyCompleted(calls)(In) 0}
+ {CumulativeUnsuccessful(calls)(In) 0} }}} {{{Make Cal l} {{Cumulativ
+eActive(calls)(In) 0} {CumulativeSuccessfullyEstablished(calls)(In) 0
+} {CumulativeSuccessfullyCompleted(calls)(In) 0} {CumulativeUnsuccess
+ful(calls)(In) 0} }}} {{Initiating {{CumulativeA ctive(calls)(In) 0} 
+{CumulativeSuccessfullyEstablished(calls)(In) 0} {CumulativeSuccessfu
+llyCompleted(calls)(In) 0} {CumulativeUnsuccessful(calls)(In) 0} }}} 
+{{Summary {{CumulativeActive(calls)(In) 0} {CumulativeSuccessfullyEst
+ablished(calls)(In) 0} {CumulativeSuccessfullyCompleted(calls)(In) 0}
+ {CumulativeUnsuccessful(calls)(In) 0} }}}

[LanX]

It's irritating, you joined the elements of a list {Make Cal l} to form a hash-key.

While this might be intended it doesn't seem to be the correct format of "keyed lists"! ³

A keyed list is a list in which each element contains a key and value pair. These element pairs are stored as lists themselves, where the key is the first element of the list, and the value is the second. The key-value pairs are referred to as fields. This is an example of a keyed list:

% package require Tclx
8.4
% keylset person NAME {Frank Zappa} JOB {musician and composer}
% list $person
 {{NAME {Frank Zappa}} {JOB {musician and composer}}}

Fields may contain subfields; `.' is the separator character. Subfields are actually fields where the value is another keyed list. Thus the following list has the top level fields ID and NAME, and subfields NAME.FIRST and NAME.LAST:

 {ID 106} {NAME {{FIRST Frank} {LAST Zappa}}}

The difficulty to find valid information on TCL¹ plus the broken data the OP (or his TCL application) provided made me stop working on this task.²

But I like your recursive parser, it's only usable for this special thread (hardcoded levels) , but nevertheless nicely made! =)

¹) glad to be a Perler...

²) to be honest I finished a kl2hash parser but I don't intend to publish.

³) Never mind, it's legal string syntax in TCL. There is no big difference between lists and strings in that language.

[space_monk]

Can't you tie the tcl result to a Perl hash?

It's been *cough* years since I needed to know Tcl and I think I've forgotten it all :-(

[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
}

[james2vegas]

If you're already using the Tcl module, can't you just tie your result to a perl variable with Tcl::Var?