#!/usr/bin/env perl use strict; use warnings; #use Pod::Simple::Debug (3); use Data::Dumper; $|++; package Pod::Simple::IrssiSignalParser; $|++; use base qw/Pod::Simple::PullParser/; use Carp qw/cluck/; use Data::Dumper; sub new { my $self = __PACKAGE__->SUPER::new(@_); $self->{__type_mapping} = {}; $self->{__signals} = {}; return bless $self, __PACKAGE__; } sub run { my $self = shift; # my ($seen_start, $seen_end) = (0,0); my $text_token; Token: while(my $token = $self->get_token()) { #print "PRocessing token: $token\n"; if ($token->is_start) { if ($token->tag eq 'Data') { print "Start Data token: ", $token->dump, "\n"; $text_token = $self->get_token; print "next token: ", $text_token->dump, "\n"; if ($text_token->is_text && $text_token->text =~ /START OF (.*)$/) { print "Found start of $1!\n\n"; my $type = $1; if ($type eq 'SIGNAL TYPES') { $self->process_types; } elsif ($type eq 'SIGNAL DEFINITIONS') { $self->process_definitions; } } } } } } sub process_types { my $self = shift; my $list_ended = 0; my $list_started = 0; print "Processing signal types\n"; while (!$list_ended) { my $token = $self->get_token; if (!$list_started) { if ($token->is_start && $token->tag eq 'over-text') { $list_started = 1; } else { next; } } else { if ($token->is_end && $token->tag eq 'over-text') { $list_ended = 1; } else { $self->unget_token($token); # do tag processing here print "Processing token ", $token->dump, $/; $self->process_type_entry; } } } print "Done Processing signal types\n"; } sub validate_token { my ($self, $token, $expected, $type) = @_; unless ($token->type eq $type && $token->is_tag($expected)) { cluck "Eeek. Expected $expected: $type, got " . $token->dump(); # cluck("Invalid token. " # on line " . $token->attr('start_line') # . "expected $expected $type, got " . $token->tag # . " " . $token->type . " : " . $token->dump); } } sub process_type_entry { my $self = shift; my $token = $self->get_token; $self->validate_token($token, 'item-text', 'start'); $token = $self->get_token; $self->validate_token($token, 'C', 'start'); $token = $self->get_token; my $c_type = $token->text; $token = $self->get_token; $self->validate_token($token, 'C', 'end'); $token = $self->get_token; # consume the separator whitespace. die "incorrect separator" unless $token->text =~ /^\s+$/; $token = $self->get_token; $self->validate_token($token, 'C', 'start'); $token = $self->get_token; my $perl_type = $token->text; $token = $self->get_token; $self->validate_token($token, 'C', 'end'); $token = $self->get_token; $self->validate_token($token, 'item-text', 'end'); print "*** Creating mapping for $c_type => $perl_type\n"; $self->{__type_mapping}->{$c_type} = $perl_type; } sub process_definitions { my $self = shift; my $list_ended = 0; my $list_started = 0; print "Processing signal definitions\n"; while (!$list_ended) { my $token = $self->get_token; $list_ended = 1 unless $token; if (!$list_started) { if ($token->is_start && $token->tag eq 'over-text') { $list_started = 1; } else { next; } } else { if ($token->is_end && $token->tag eq 'over-text') { $list_ended = 1; } else { $self->unget_token($token); # do tag processing here print "Processing token ", $token->dump, $/; $self->process_def_entry; } } } print "Done Processing signal defs\n"; } sub process_def_entry { my $self = shift; my $token; print "Processing definition entry\n"; while ($token = $self->get_token()) { print "Token is ", $token->dump, "\n"; last if $token->is_end && $token->tag eq 'item-text'; $self->validate_token($token, 'item-text', 'start'); $token = $self->get_token(); $self->validate_token($token, 'C', 'start'); $token = $self->get_token(); if ($token->is_text) { my $sig_name = $token->text; print "Signal: $sig_name\n"; } $token = $self->get_token(); $self->validate_token($token, 'C', 'end'); $token = $self->get_token(); print "matched end of code\n"; $self->validate_token($token, 'item-text', 'end'); $token = $self->get_token(); print "matched end of header list\n"; $self->validate_token($token, 'over-text', 'start'); $token = $self->get_token(); print "matched start of args list\n"; $self->validate_token($token, 'item-text', 'start'); $token = $self->get_token(); # consume argument list. until ($token->is_end && $token->tag eq 'over-text') { $token = $self->get_token(); print "waiting for arglist Token: " . $token->dump() . "\n"; } print "Token now: ", $token->dump(), $/; print "consumed arg list\n"; $token = $self->get_token(); print "Token now: ", $token->dump(), $/; $self->validate_token($token, 'item-text', 'end'); $token = $self->get_token(); } #$self->unget_token($token); print "Done Processing definition entry\n"; } package main; my $input_file = $ARGV[0] // 'General/Signals.pod'; my $parser = Pod::Simple::IrssiSignalParser->new; $parser->accept_targets('irssi_signal_defs', 'irssi_signal_types'); my $tree = $parser->parse_file($input_file);