Feb 122011
 

rfcmap.pl parses the RFC index and produces Graphviz output.

For example, here’s the output for “perl -T rfcmap.pl RFC0821 RFC0822 RFC1035″ which covers some of the initial documents on SMTP, mail message format, and domainĀ  names.

Could be better; could be worse.

# Copyright (c) 2011 Jason Filley jason@snakelegs.org
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# Name: rfcmap.pl
# Purpose: Output Graphviz .dot format for dated graph of specified RFC's, plus
#   documents obsoleting or obsoleted by it/them.
# Input file:  ftp://ftp.rfc-editor.org/in-notes/rfc-ref.txt
# Usage example:  perl -T rfcmap.pl RFC1035 RFC0821 RFC0822 > output.dot
#   arguments are names of documents from first column, as written

use strict;
use warnings;
use 5.010;

if ( $#ARGV < 0 ) {
    die "Specify the RFC's to use as command-line parameters\n";
}

sub stripwhitespace {
    my $string = shift;
    $string =~ s/[\n\r\s]+//g;
    return $string;
}

sub trim {
    my $a = shift;
    $a =~ s/^[\n\r\s]+//g;
    $a =~ s/[\n\r\s]+$//g;
    return $a;
}

sub grabyear {
    my $year = shift;
    $year =~ /(\d{4})\.$/;
    return $1;
}

sub uniq {
    my %h;
    return grep { !$h{$_}++ } @_;
}

sub GetTitleOnly {
    my $title = shift;
    $title =~ /([A-Za-z]*)(0*)(\d*)/;
    my $toreturn = $1 . " " . $3;
    return $toreturn;
}

sub GetFullTitle {
    my $title = shift;
    $title =~ /(\"(.*)\\\")/;
    my $toreturn = $2;
    return $toreturn;
}

my @lines   = ();
my @todo    = ();
my @done    = ();
my @final   = ();
my %srcHoA  = ();
my %srcbib  = ();
my %srcdate = ();

push( @todo, @ARGV );
@todo = uniq(@todo);

my $file = "rfc-ref.txt";

open( RFCREF, "<$file" ) || die "Can't open file.\n";
while (<RFCREF>) {
    if (/^RFC/) {
        push( @lines, $_ );
    }
}
close(RFCREF);

# link all references
while ( scalar(@todo) > 0 ) {
    my $item = shift(@todo);
    foreach my $entry (@lines) {
        my @line = split( '\|', $entry );
        my $RFC = stripwhitespace( $line[0] );

        #hash of arrays (RFC -> @ObsoletedByList)
        my $ObsoletedBy = stripwhitespace( $line[1] );
        my @ObsoletedByList = split( ',', $ObsoletedBy );
        $srcHoA{$RFC} = [@ObsoletedByList];

        #hash (RFC -> Bib)
        my $Bib = $line[2];
        chomp $Bib;
        $Bib = trim($Bib);
        $Bib =~ s/(\")/\\$1/g;
        $srcbib{$RFC} = $Bib;

        #hash (RFC -> date)
        my @working = ();
        push( @working, $RFC );
        push( @working, @ObsoletedByList );

        if ( $item ~~ @working ) {
            unless ( $entry ~~ @final ) {
                push( @final, $entry );    #only if not already in @final
                $srcdate{$RFC} = grabyear($Bib);
            }

            foreach my $workitem (@working) {
                unless ( ( $workitem ~~ @done ) || ( $workitem ~~ @todo ) ) {
                    push( @todo, $workitem );
                }
            }
        }
    }
    @todo = grep { $_ ne $item } @todo;
    push( @done, $item );
}

# find lowest to highest quoted years (e.g., 1981..2010)
# todo: what if only one year?
my $highest_val = ( sort { $b <=> $a } values %srcdate )[0];
my $lowest_val  = ( sort { $a <=> $b } values %srcdate )[0];
my @dates = ( $lowest_val .. $highest_val );

# draw the graph
# A: Because I didn't have the time to figure out why the Graphviz perl module
# kept munging my ranks....
print
"digraph test { graph [ratio=fill, fontsize=24];\nnode [label=\"\\N\", fontsize=24];\n";

my $yearnodes;
my $yearedges;    #what if only one?

#draw the years
for ( my $count = 0 ; $count <= $#dates ; $count++ ) {
    $yearnodes .=
      $dates[$count] . " [label=" . $dates[$count] . ", shape=plaintext];\n";
    unless ( $count == 0 ) {
        $yearedges .=
            $dates[ $count - 1 ] . " -> "
          . $dates[$count]
          . " [style=dotted, shape=none];\n";
    }
}

print $yearnodes;
print $yearedges;

# draw the bib nodes
foreach my $rfcnode (@done) {
    if ( $rfcnode =~ /^RFC/ ) {

        print $rfcnode
          . " [label = \""
          . GetTitleOnly($rfcnode) . "\\n"
          . GetFullTitle( $srcbib{$rfcnode} )
          . "\" shape=plaintext, style=filled, color=lightskyblue];\n";
    }
    else {
        print $rfcnode
          . " [label = \""
          . GetTitleOnly($rfcnode)
          . "\" shape=box, style=filled, color=mediumorchid];\n";
    }
}

# set ranks
foreach my $srcnode (@done) {
    if ( $srcnode =~ /^RFC/ ) {
        print "{rank=same; " . $srcnode . " " . $srcdate{$srcnode} . ";}\n";
    }
}

# draw the edges
foreach my $srcnode (@done) {
    if ( $srcnode =~ /^RFC/ ) {
        if ( @{ $srcHoA{$srcnode} } ) {
            foreach my $ref ( @{ $srcHoA{$srcnode} } ) {
                print $srcnode . " -> " . $ref . ";\n";
            }
        }
    }
}

#close the graph
print "}\n"

Sorry, the comment form is closed at this time.