# -*- coding: utf-8 -*- use Win32; use strict; Win32::CopyFile( 'brick_rumpf.pm' , 'brick.pm' , 1); my %data_types; open my $OUT,">>:encoding(utf8)",'brick.pm'; local $/; my (%function,%callback); for my $tag ( qw / brick bricklet/) { open my $IN,"<:encoding(utf8)","Bindings/${tag}_commonconfig.py"; my $buff = <$IN>; close $IN; my ($common_function,$common_callback) = ('',''); for my $func ( split /common_packets.append\(\{/, $buff ) { my ($type) = $func =~ /^'type': '(.*)',/m; next if !$type; my ($f_id) = $func =~ /^'function_id': (.*),/m; next if !$f_id; my (@f_name) = $func =~ /^'name': \('(.+)',\s*'(.+)'\),/m; $f_name[1] = "CALLBACK_".uc $f_name[1] if $type =~ /callback/i; my ($para) = $func =~ /'elements': \[([\w,'()\s]+)\]/; my ( @para, @resp) ; if ($para) { for my $p ( split /\)\s*,\s*\(/, $para ) { my ($v_nam, $v_typ, $v_len, $in_out ) = $p =~ /'(.+)'\s*,\s*'(.+)'\s*,\s*(.+)\s*,\s*'(.+)'/; push @para , $v_typ.($v_len > 1 ? "[$v_len]":'') if $in_out =~ /in/i; push @resp , $v_typ.($v_len > 1 ? "[$v_len]":'') if $in_out =~ /out/i; } } $callback{$tag} .= "\n\t\t\t$f_id => '$f_name[1]'," if( $type =~ /callback/i ); $function{$tag} .= "\t\t\t$f_name[1] =>".("\t"x(12 - int((length($f_name[1])+3)/4)))."{ id => $f_id, ".(@para ? "para => [qw/ @para/], ":'').(@resp ? "resp => [qw/ @resp/],":'')."},\n"; } } for my $file ( glob( "Bindings/*.py") ) { next if $file =~/brick.*_commonconfig\.py/; open my $IN, "<:encoding(utf8)", $file; my $buff = <$IN>; close $IN; my $function_id = 1; my ($cat) = $buff =~ /^\s+'category': '(.*)',$/m; my @name = $buff =~ /^\s+'name': \('(.+)',\s*'(.+)',\s*'(.+)'\),/m; if ( @name ) { my $name = $name[1]; print $OUT < 1 ? "[$v_len]":'')}++; push @para , $v_typ.($v_len > 1 ? "[$v_len]":'') if $in_out =~ /in/i; push @resp , $v_typ.($v_len > 1 ? "[$v_len]":'') if $in_out =~ /out/i; } } $callback .= "\n\t\t\t$f_id => '$f_name[1]'," if( $type =~ /callback/i ); print $OUT "\t\t\t$f_name[1] =>".("\t"x(12 - int((length($f_name[1])+3)/4)))."{ id => $f_id, ".(@para ? "para => [qw/ @para/], ":'').(@resp ? "resp => [qw/ @resp/], ":'')."},\n"; } if ( $cat =~ /^Brick$/ ) { print $OUT "$function{brick}\t\t};\n"; } else { print $OUT "$function{bricklet}\t\t};\n"; } print $OUT ' return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_);'; print $OUT "\n\t}\n"; if( $cat =~ /^Brick$/ ) { $callback .= $callback{brick}; } else { $callback .= $callback{bricklet}; } if( $callback ) { print $OUT <{\$id}) { return \$cb_list->{\$id}; } else { return \$class->SUPER::callback(\@_); } } oet } } print $OUT "\n\n1;"; for my $i ( sort keys %data_types ) { print "$i\t$data_types{$i}\n"; }