#!/usr/bin/perl -w
# vdbe_graph.pl
use strict;
use YAML;
use Graph::Easy;
use Getopt::Std;
binmode STDOUT, ':utf8';

my %opt;
getopts('o:f:', \%opt);

my $g = Graph::Easy->new();
$g->set_attribute('flow', 'south');

my $prev;
my @ops;
while (<>) {
    chomp;
    my @fields = split /\t/, $_;
    next unless $fields[0] =~ /^\d+$/;

    my %curr;
    @curr{qw(n op p1 p2 p3)}  = @fields;
    my $params = join(", ", @fields[2..$#fields]);

    my $n = $g->add_node($curr{n});
    $n->set_attribute(label => "$curr{n} $curr{op} ($params)");
    $n->set_attribute(align => 'left');
    if ($prev) {
        $g->add_edge($prev->{n} => $curr{n});
    }
    $prev = \%curr;
    push @ops, \%curr;
}

#  If P2 is not zero and one or more of the entries are NULL, then jum
+p to the address given by P2
# MakeRecord MoveGe MoveGt MoveLt MoveLe Rewind
my %jumps = map { $_ => 1 } qw(
    Next Prev Gosub ForceInt MustBeInt Eq Ne Lt Le Gt Ge 
    If IfNot IsNull NotNull MakeRecord MoveGe MoveGt MoveLt MoveLe 
    Distinct Found NotFound IsUnique NotExists Last Rewind 
    IdxGT IdxGE IdxLT FifoRead IfMemPos IfMemNeg IfMemZero VFilter VNe
+xt);

for my $n (grep { exists $jumps{$_->{op}} } @ops) {
    $g->add_edge($n->{n} => $n->{p2});
}

for my $n (grep { $_->{op} eq 'Goto' } @ops) {
    $g->add_edge($n->{n} => $n->{p2});
    if ($n->{n} != $n->{n}+1) {
        $g->del_edge($g->edge($n->{n} => $n->{n}+1));
    }
}

for my $n (grep { $_->{op} eq 'Halt' } @ops) {
    next unless $g->node($n->{n}+1);
    $g->del_edge($g->edge($n->{n} => $n->{n}+1));
}

my $ext = ($opt{o} && $opt{o} =~ /\.(...)$/) ? $1 : '';
my %ext_formats = (
    asc => 'ascii',
    html=> 'html',
    txt => 'txt',
    box => 'boxart',
    viz => 'graphviz',
    png => 'graphviz',
);
my $format = $ext_formats{ $opt{f} || ''} 
            || $opt{f} || $ext_formats{ext} || 'ascii';

# Where does the output go
if (defined $opt{o}) {
    if ($ext eq 'png') {
        open OUT, "| dot -Tpng -o $opt{o}";
    } else {
        open OUT, "> $opt{o}";
    }
    select OUT;
}

if ($format eq 'ascii') {
    print $g->as_ascii;
} elsif ($format eq 'boxart') {
    print $g->as_boxart;
} elsif ($format eq 'graphviz') {
    print $g->as_graphviz;
} elsif ($format eq 'txt') {
    print $g->as_txt;
} elsif ($format eq 'html') {
    print $g->as_html;
} else {
    die;
}
[download]