aboutsummaryrefslogtreecommitdiffstats
path: root/docs/buildsig2.pl
diff options
context:
space:
mode:
authorTom Feist <shabble@metavore.org>2010-10-14 20:42:31 +0000
committerTom Feist <shabble@metavore.org>2010-10-14 20:42:31 +0000
commit91585163e7f7cd886b2bce4c98dbc3d14b9d3c2e (patch)
treead714832c76eb1c72537db47c1a309261d2385ab /docs/buildsig2.pl
parentuberprompt: removed dead code from startup func. (diff)
downloadirssi-scripts-91585163e7f7cd886b2bce4c98dbc3d14b9d3c2e.tar.gz
irssi-scripts-91585163e7f7cd886b2bce4c98dbc3d14b9d3c2e.zip
misc: tidying up my working dir
Diffstat (limited to 'docs/buildsig2.pl')
-rwxr-xr-xdocs/buildsig2.pl140
1 files changed, 140 insertions, 0 deletions
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;
+}