#!/usr/bin/perl -w
use strict;
use warnings;

use Graph::Easy;

my $graph = Graph::Easy->new();

my $bonn   = $graph->add_node('Bonn');
my $berlin = $graph->add_node('Berlin');
$graph->add_edge ($bonn, $berlin, 'car');
$berlin->set_attributes({ link => "http://www.visit-berlin.org/", label => "berlin"});

my $asc = $graph->as_ascii();
print "Original:\n";
print $asc."\n";

my $labelmap = pre_process_graph($graph);
my $asc2 = $graph->as_ascii();
print "After pre-process:\n";
print $asc2."\n";

my $asc3 = post_process_ascii($labelmap, $asc2);
print "After post-process:\n";
print $asc3."\n";

###########################################################################
# Scan graph object and replace labels on nodes.
###########################################################################
sub pre_process_graph
{
    my ($graph) = @_;

    my $labelmap = {};

    # Just look at Node text for starters.
    foreach my $node ($graph->nodes())
    {
        my $name = $node->name();
        my $label = $node->attribute('label');
        my $labeltext = defined $label ? $label : $name;
        $label = "undef" if !defined $label;
        #print "node: name=$name label=$label labeltext=$labeltext\n";

        my $key = "$name,$label";
        $labelmap->{$key} = {
            node => $node,
            name => $name,
            labeltext => $labeltext, };
    }

    # How many labels have we found?
    my $count = scalar(keys %$labelmap);

    # Return early if nothing to do.
    return $labelmap if $count == 0;

    # How many digits identifier do we need?
    my $digits = length("$count");

    # Create printf format: "_%01d", "_%02d"
    my $fmt = "_%0"."$digits"."d";

    # label format is _01, _02 etc
    # so the min length is 3 if $digits == 2; (2 if $digits == 1)
    my $minlen = $digits + 1;

    my $labelnum = 1;
    foreach my $key (keys %$labelmap)
    {
        my $lmap = $labelmap->{$key};
        my $textlen = length $lmap->{labeltext};

        # Copy above default format string
        my $fmt = $fmt;

        # Pad string with underscores to maintain correct length.
        $fmt .= '_' x ($textlen - $minlen) if $textlen > $minlen;

        # Create new label.
        my $newlabel = sprintf $fmt, $labelnum;

        $lmap->{labelnum} = $labelnum;
        $lmap->{newlabel} = $newlabel;
        $lmap->{node}->set_attribute('label', $newlabel);
        $labelnum++;
    }

    return $labelmap;
}

###########################################################################
# Scan ascii string and replace labels on nodes.
###########################################################################
sub post_process_ascii
{
    my ($labelmap, $asc) = @_;

    foreach my $key (keys %$labelmap)
    {
        my $lmap = $labelmap->{$key};

        my $newlabel  = $lmap->{newlabel};
        my $labeltext = $lmap->{labeltext};
        my $link      = $lmap->{node}->link();

        # Pad out the old label if it was too short,
        # since we forced a minimum of 2 characters.
        my $minlen = length($newlabel);
        my $lablen = length($labeltext);
        $labeltext .= ' ' x ($minlen - $lablen) if $minlen > $lablen;

        if (defined $link && $link ne '')
        {
            my $href = "<a href=\"$link\">$labeltext</a>";
            # If a link, replace text with link.
            $asc =~ s/\b$newlabel\b/$href/s;
        }
        else
        {
            # If not a link, restore original label.
            $asc =~ s/\b$newlabel\b/$labeltext/s;
        }
    }

    return $asc;
}

__END__
Original:
+------+  car   +--------+
| Bonn | -----> | berlin |
+------+        +--------+

After pre-process:
+------+  car   +--------+
| _1__ | -----> | _2____ |
+------+        +--------+

After post-process:
+------+  car   +--------+
| Bonn | -----> | <a href="http://www.visit-berlin.org/">berlin</a> |
+------+        +--------+