From 91585163e7f7cd886b2bce4c98dbc3d14b9d3c2e Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Thu, 14 Oct 2010 21:42:31 +0100
Subject: misc: tidying up my working dir

---
 docs/buildsig2.pl | 140 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 140 insertions(+)
 create mode 100755 docs/buildsig2.pl

(limited to 'docs/buildsig2.pl')

diff --git a/docs/buildsig2.pl b/docs/buildsig2.pl
new file mode 100755
index 0000000..b1c7268
--- /dev/null
+++ b/docs/buildsig2.pl
@@ -0,0 +1,140 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+#use Pod::Simple::Debug (3);
+use Data::Dumper;
+use Pod::Simple::SimpleTree;
+use Carp qw/croak/;
+$|++;
+
+#package Pod::Simple::Tree;
+
+
+#package main;
+
+my $input_file = $ARGV[0] // 'General/Signals.pod';
+my $parser = Pod::Simple::SimpleTree->new;
+
+$parser->accept_targets('irssi_signal_defs', 'irssi_signal_types');
+my $root = $parser->parse_file($input_file)->root;
+
+#print Dumper($root);
+my @sig_tree;
+
+my $in_list = 0;
+foreach my $node (get_children($root)) {
+    #print name($node), "\n";
+
+    if (name($node) eq 'for') {
+
+        if (attr($node)->{target} eq 'irssi_signal_defs') {
+            print "Found For\n";
+            my $text = text(get_children($node));
+
+            if ($text =~ /START OF SIGNAL DEFINITIONS/) {
+                print "start of defs\n";
+                $in_list = 1;
+                next;
+            } elsif ($text =~ /END OF SIGNAL DEFINITIONS/) {
+                print "end of defs\n";
+                $in_list = 0;
+                next;
+            }
+        }
+
+    }
+    push @sig_tree, $node if $in_list;
+
+}
+# we've got what we came for
+undef $root;
+undef $parser;
+
+my $module = '';
+my $file = '';
+
+
+print Dumper(\@sig_tree), "\n\n";
+
+foreach my $node (@sig_tree) {
+    my $name = name($node);
+
+    if ($name eq 'head2') {
+        $module = text($node);
+        print "Module: $module\n";
+    } elsif ($name eq 'head3') {
+        $file = text(get_children($node));
+        print "File: $file\n";
+    } elsif ($name eq 'over-text') {
+        my @children = get_children($node);
+        while (@children) {
+
+            # fetch in pairs $sig => $parameter list
+            my ($signal, $params) = (shift @children, shift @children);
+            print "Signal: ", Dumper($signal), $/;
+            print "Params: ", Dumper($params), $/;
+
+            my $sig_name = text(get_children($signal));
+
+            print "Sig: $sig_name\n";
+
+            my @param_list = get_children($params);
+            foreach my $param (@param_list) {
+                $param = get_children($param);
+                print "Param: ", Dumper($param), "\n";
+                my $type = '';
+                my $var = '';
+                if (!ref $param->[0]) {
+                    $type = $param->[0];
+                    my @param_array = @$param;
+                    foreach my $thing (@param_array) {
+                        $var = text($thing);
+                        last if $var =~ m/\$\w+/;
+                    }
+                } elsif (name($param->[0]) eq 'B') {
+                    # skip
+                    next;
+                } elsif (name($param->[0]) eq 'L') {
+                    $type = text($param->[0]);
+                    #$var = text($param->[1]);
+                    my @param_array = @$param;
+                    foreach my $thing (@param_array) {
+                        $var = text($thing);
+                        last if $var =~ m/\$\w+/;
+                    }
+                } else {
+                    $var = text($param->[0]);
+                }
+                $type =~ s/\s*(\w+)\s*/$1/;
+                $var  =~ s/\s*(\w+)\s*/$1/;
+
+                print "Type: $type, Var: >$var<\n";
+            }
+        }
+    }
+}
+
+sub attr {
+    my $node = shift;
+    return $node->[1];
+}
+sub name {
+    my $node = shift;
+    return $node->[0];
+}
+
+sub text {
+    my $node = shift;
+    my $text = ref $node ? $node->[2] : '' ;
+    croak("text() called on non-terminal: " . Dumper($node)) if ref($text);
+    return $text;
+}
+
+sub get_children {
+    my $node = shift;
+
+    my @node_arr = ref $node ? @$node : ();
+    my @child_slice = @node_arr[2..$#node_arr];
+    return wantarray ? @child_slice : \@child_slice;
+}
-- 
cgit v1.2.3