#!/usr/bin/perl
##########################################################
# malmal -- Mike Schilli, 2002 (m@perlmeister.com)
##########################################################
use warnings;
use strict;

use GraphViz;
use CGI qw(:all);
use CGI::Carp qw(fatalsToBrowser);
use URI::URL ();
use Text::Wrap;
$Text::Wrap::columns = 10;
$Text::Wrap::huge    = 'overflow'; 

if(param('d')) {
    print header(-type    => 'image/png', 
                 -expires => '-1d');
    my $img = draw(param('d'));
    if($img) {
        print $img;
    } else {
        print draw("1 Error: $@");
    }
    exit 0;
}

print header(), start_html(
        -title => "Malmal",
        -style => { 'code' => default_css(), }),
      h1("Malmal");

if(param('data')) {
   my $u = URI::URL->new( url() );
   $u->query_form("d" => param('data'));
   print img({ src    => $u->as_string(), 
               border => 1
             });
}

print start_form(),
      submit(-value => 'Zeichnen'), br(),
      font({face => 'Helvetica', size => '2'},
        textarea(-name  => 'data', 
                 -value => (param('data') || 
                            default_data()),
                 -rows  => 20, -columns => 100,
              ),
          ),
      br(), submit(-value => 'Zeichnen'),
      end_form(), end_html();

##########################################################
sub draw {
##########################################################
    my ($data) = @_;

    $ENV{PATH} .= ":/pfad/zur/installation";

    my $g = GraphViz->new(
                 node => {
                   fontname  => 'arial',
                   fontsize  => 10,
                   shape     => 'box',
                   style     => 'filled',
                   fillcolor => 'orange',
                 },
                 edge => {
                   fontname  => 'arial',
                   fontsize  => 10,
                   fontcolor => 'blue',
                   color     => 'blue',
                   style     => 'bold',
                 },
                 rankdir => 1,
               );

    my @edges = ();
    my %nodes = ();

    for (split /\n/, $data) {
        s/#.*//;         # Kommentare
        next if /^\s*$/; # Leerzeilen
        s/^\s*//;        # Einrückungen
        s/\r//g;         # \r-Zeichen

        if(/^(\d+)>(\d+)\s*(.*)/) {
            my $text = join "\n", wrap('', '', $3);
            push @edges, [$1, $2, $text];
        } elsif(/^(\d+)\s*(.*)/) {
            my $text = join "\n", wrap('', '', $2);
            $nodes{$1} = $text;
        } else {
            $@ = "Syntax error: $_";
            return undef;
        }
    }

    for my $node (keys %nodes) {
        $g->add_node("$nodes{$node} (#$node)");
    }

    for my $edge (@edges) {
        my($from, $to, $text) = @$edge;

        $g->add_edge("$nodes{$from} (#$from)", 
                     "$nodes{$to} (#$to)", 
                     label => $text);
    }

    return $g->as_png();
}

##########################################################
sub default_data {
##########################################################
    return <<EOT;
# -- Bitte hier die Beschreibung eingeben
1   Erster Knoten
2   Zweiter Knoten
1>2 Kante von Eins nach Zwei
EOT
}

##########################################################
sub default_css {
##########################################################
    return <<EOT;
      body {
          background:  #FFFFFF;
          font-family: Arial;
      } 
      input {
          font-size: 12px;
      }
      h1 { 
          font-family: Arial;
          font-size:   16px;
          font-weight: bold;
          color: #B82831;
      }
EOT
}