#!/usr/bin/env perl5.8
#
# ddf_y2d - convert doc. dataflow info from YAML to DOT (etc.)
#           (ie, create diagrams for DDF web page)
#
#  This script generates dataflow diagrams and include files, using
#  information gathered by ddf_get from the "#DDF" entries in assorted
#  hand-edited files.
#
# Written by Rich Morin <rdm@slac.stanford.edu>

#DDF    - path:     'bin/ddf_y2d'
#DDF      desc:     'create DOT (etc) for documentation data flow'
#DDF      type:     'Perl script'
#DDF      label:    'ddf_y2d'
#DDF      inp_c:    |
#DDF        a_ddf/file_sets.yml
#DDF        e_etc/ddf.yml
#DDF      out_g:    'a_ddf/*.{dot,inc}'
#DDF      out_m:    'a_etc/exit_ddf_y2d'
#DDF
#DDF    - patt:     'a_ddf/*'
#DDF      desc:     'documentation data flow'
#DDF      exts:     '{cmap,dot,inc,png}:doc'

use Data::Dumper;

use strict;
use warnings;

require 'fsw_docs.pl';

{
    my (@node, @t1,
        %cnt, %dash, %def, %file, %link,
        %node, %patt, %save, %uses,
        $DOC, $FIL,
        $by_dia, $desc, $dia, $label,
        $node, $out_dot, $out_inc,
        $r_dia, $r_doc, $r_ext, $r_fil, $r_scr, $r1, $r2,
        $size, $shape, $style,
        $t1, $t2, $t3, $t4, $url
       );

    $FIL =  'a_ddf/file_sets.yml';

    # Get YAML information.

    $DOC =  'e_etc/ddf.yml';   $r_doc =  load_yaml($DOC);

    $r_dia =  $r_doc->{Diagrams};
    $r_ext =  $r_doc->{Extensions};

    # Expand brace expressions (etc) in "links" entries.

    foreach $dia (sort(keys(%$r_dia))) {

        $r1 =  $r_dia->{$dia}{dash};

        next unless (defined($r1));

        foreach $t1 (@$r1) {

            $t1 =~ s|\s||g;
            $t1 =  brace_expand($t1);

            foreach $t2 (split(' ', $t1)) {

                $t2 =~ m|(.*)->(.*)|;

                $dash{all }{$1}{$2}++;
                $dash{$dia}{$1}{$2}++;
    }   }   }

    # Expand brace expressions in "nodes" entries.

    foreach $dia (sort(keys(%$r_dia))) {

            $t1                   = $r_dia->{$dia}{nodes};
            $r_dia->{$dia}{nodes} = brace_expand($t1) if (defined($t1));
    }

    # Tally file set patterns.

    foreach $dia (sort(keys(%$r_dia))) {        # e.g., "doc"

        $t1 =  $r_dia->{$dia}{nodes};

        next unless (defined($t1));

        @t1 =  split(' ', $t1);

        foreach $t2 (sort(@t1)) {               # e.g., "a_etc/ddf_*.yml"

            $patt{$t2}++;
    }   }

    # Grovel through file_sets, expanding entries if need be.

    $r1 =  load_yaml($FIL);

    foreach $r2 (@$r1) {

        # Expand brace expressions.

        foreach $t1 qw(exts   include
                       inp_c  inp_g  inp_m
                       out_c  out_g  out_m) {

            $t2        = $r2->{$t1};
            $r2->{$t1} = brace_expand($t2) if (defined($t2));
        }
        push(@$r_fil, $r2) if (defined($r2->{path}));
    }

#   print Dumper($r_fil);						# DEBUG

    # Grovel through (expanded) File_sets.

    foreach $r1 (@$r_fil) {

        $t1        =  $r1->{path};
        $file{$t1} =  $r1;
        $def{$t1}  =  1; 

        if ($t1 =~ m|^bin/|) {		# Script

            push(@$r_scr, $r1);

            $r1->{shape} = 'ellipse';

            foreach $t2 qw(out_c out_g) {

                $t3 = $r1->{$t2};

                if (defined($t3)) {

                    foreach $t4 (split(' ', $t3)) { $link{$t1}{$t4} = (); }
            }   }

            $t2 =  '';
            $t2 .= " $r1->{inp_c}" if (defined($r1->{inp_c}));
            $t2 .= " $r1->{inp_g}" if (defined($r1->{inp_g}));

        } else {

            $t2 =  (defined($r1->{include})) ?  $r1->{include} : '';
        }

        if ($t2 ne '') {

            foreach $t3 (split(' ', $t2)) {

                $t4 =  $t3;
                $t4 =~ s|^.*:|| if ($t1 !~ m|^bin/|);

                $link{$t4}{$t1} = ();
    }   }   }

    # Create DOT and inc (HTML include) files, per "Diagrams".

    foreach $dia (sort(keys(%$r_dia))) {

        undef %save;

        $t1   =  $r_dia->{$dia}{size};

        $size =  (defined($t1))
              ?  "size=\"$t1\"\n"
              :  '';

        if ($dia eq 'all') {

            $t1 =  'ratio="fill";';
            $t2 =  '';

        } else {

            $t1 =  '';
            $t2 =  "\n        <td width=150><b>Label</b>";
        }

        $out_dot =  <<EOT;
digraph G { $t1
  margin="0.1"
  concentrate="true";
  node[ fontname="Arial", fontsize="10", height="0.3" ];
  rankdir="LR";
  ranksep="0.2";$size\n
EOT

        $out_inc = <<EOT;
    <p>
    <table>
      <tr>$t2
        <td width=200><b>Pathname</b>
        <td          ><b>Description</b>
      </tr>
EOT

        # Create a hash, indexed by names of nodes in the diagram.

        if ($dia eq 'all') {

            @node = grep(! m[^(bin/all_d2ic |				# KLUDGE
                               .*/.*\.cmap  |
                               .*/.*\.png   )
                             $]x, keys(%file));

        } else {

            @node = split(' ', $r_dia->{$dia}{nodes});
        }

        undef %node;

        foreach $node (sort(@node)) {

            $node{$node} = 1;
            $uses{$node}{$dia}++
        }

        # Walk nodes, generating DOT and inc entries.

        # by_dia - sort helper; sort by node name or label, based on $dia
        #
        $by_dia = sub {

            my ($a0, $a1,
                $b0, $b1);

            ($a0, $b0) =  ($dia eq 'all')
                       ?  ($a, $b)
                       :  ($file{$a}{label}, $file{$b}{label});

            $a1 = (defined($a0)) ? $a0 : '?label?';
            $b1 = (defined($b0)) ? $b0 : '?label?';

            lc($a1) cmp lc($b1);
        };

        foreach $node (sort $by_dia (@node)) {

            # Save information for inc file.

            $desc =  $file{$node}{desc};

            unless (defined($desc)) {

                print "? No desc. for '$node' in diagram '$dia'\n";

                $desc = '?desc?';
            }

            $t1 =  $file{$node}{type};

            if      (defined($t1)) {

                $desc .= "; $t1";

            } elsif ($node =~ m|.*\.(\w+)$|) {

                $t1   =  $r_ext->{$1}{desc};

                $desc .= (defined($t1))
                      ?  "; $t1"
                      :  "; ?$1?";
            }

            $label = $file{$node}{label};

            unless (defined($label)) {

                print "? No label for '$node' in diagram '$dia'\n";

                $label = '?label?';
            }

            $t2 =  ($dia eq 'all') ? '' : "\n        <td>$label</td>";

            $out_inc .= <<EOT;
      <tr>$t2
        <td><tt>$node</tt></td>
        <td>$desc</td>
      </tr>
EOT

            # Create node entry for dot file.

            $shape =  $file{$node}{shape};

            unless (defined($shape)) {

                if ($node =~ m|.*\.(\w+)$|) {

                    $t1    =  $r_ext->{$1}{shape};

                    $shape .= (defined($t1))
                           ?  $t1
                           :  "?$1?";
            }   }

            $style =  'solid';
            $style .= ',filled' if ($node =~ m|^\./|  or
                                    $node =~ m|^bin/| or
                                    $node =~ m|^e_|);

            $style .= ',bold' if ($shape eq 'octagon');

            unless (defined($patt{$node})) {

                print "dia='$dia', node='$node'\n";			# DEBUG
            }

            $style .= ($dia ne 'all' and $patt{$node} > 1)
                   ?  ',dashed'
                   :  '';

            $url   =  (defined($file{$node}{url}))
                   ?  $file{$node}{url}
                   :  $node;

            $t1    =  ($dia eq 'all')
                   ?  'label="",'
                   :  "label=\"$label \",";

            $save{$node} =  <<EOT;
  "$node" [ $t1
    shape="$shape",
    style="$style",
    tooltip="$node",
    URL="$url" ];
EOT

            # Create edge entries (if any) for this node.

            # "inp_[cg]" entries for scripts.

            $t1 =  '';
            $t1 .= " $file{$node}{inp_c}" if (defined($file{$node}{inp_c}));
            $t1 .= " $file{$node}{inp_g}" if (defined($file{$node}{inp_g}));

            if ($t1 ne '') {

                $out_dot .= "#   script input:\n\n";

                foreach $t2 (sort(split(' ', $t1))) {

                    print "? Input   node ($t2) missing for script '$node'.\n"
                        unless (exists($def{$t2}));

                    if (exists($node{$t2})) {

                        $out_dot .= sprintf("  %-25s -> %s\n",
                                            "\"$t2\"", "\"$node\";");

                        $link{$t2}{$node}{$dia}++;
                }   }

                $out_dot .= "\n";
            }

            # "out_[cg]" entries for scripts.

            $t1 =  '';
            $t1 .= " $file{$node}{out_c}" if (defined($file{$node}{out_c}));
            $t1 .= " $file{$node}{out_g}" if (defined($file{$node}{out_g}));

            if ($t1 ne '') {

                $out_dot .= "#   script output:\n\n";

                foreach $t2 (sort(split(' ', ($t1)))) {

                    print "? Output  node ($t2) missing for script '$node'.\n"
                        unless (exists($def{$t2}));

                    if (exists($node{$t2})) {
                        $out_dot .= sprintf("  %-25s -> %s\n",
                                            "\"$node\"", "\"$t2\";");
                        $link{$node}{$t2}{$dia}++;
                }   }

                $out_dot .= "\n";
            }

            # "include" entries for SHTML (etc) files.

            $t1 =  $file{$node}{include};

            if (defined($t1)) {

                $out_dot .= "#   include files:\n\n";

                foreach $t2 (sort(split(' ', $t1))) {

                    unless (exists($def{$t2})) {

                        print "? Include node ($t2) missing for file '$node'\n"
                            if ($node !~ m[\.shtml$]     or
                                $t2   !~ m[\.(cmap|png)$]);
                    }

                    if (exists($node{$t2})) {

                        $out_dot .= sprintf("  %-25s -> %s\n",
                                            "\"$t2\"",
                                            "\"$node\" [style=\"dotted\"];");

                        $link{$t2}{$node}{$dia}++;
                }   }

                $out_dot .= "\n";
            }

            # Diagram "dash" entries for SHTML (etc) files.

            $r1 =  $dash{$dia}{$node};

            if (defined($r1)) {

                $out_dot .= "#   dashed edges:\n\n";

                foreach $t1 (sort(keys(%$r1))) {

                    print "? Dash node ($t1) missing for file '$node'\n"
                        unless (exists($def{$t1}));

                    if (exists($node{$t1})) {

                        $out_dot .= sprintf("  %-25s -> %s\n",
                                            "\"$node\"",
                                            "\"$t1\" [style=\"dashed\"];");

                        $link{$t1}{$node}{$dia}++;
                }   }

                $out_dot .= "\n";
        }   }

        # Output rank-specified nodes.

        $r1 =  $r_dia->{$dia}{rank};

        if (defined($r1)) {

            foreach $t1 (sort(keys(%$r1))) {	# e.g., "same"

                $r2 =  $r1->{$t1};

                foreach $t2 (@$r2) {

                    $out_dot .= "{ rank=\"$t1\";\n";
                    @t1      =  split(' ', $t2);

                    foreach $t3 (sort(@t1)) {	# e.g., "bin/use_tree_get"

			if (defined($save{$t3})) {

                            $out_dot .= $save{$t3};

			} else {

                            print "? '$t3' missing in '$dia:rank:same'\n";

                            $out_dot .= '???';
			}

                        delete($save{$t2});
                    }

                    $out_dot .= "}\n\n";
        }   }   }

        # Output remaining nodes.

        foreach $t1 (sort(keys(%save))) {
            $out_dot .= "$save{$t1}\n";
        }

        $out_dot .= "}\n";
        $t1      =  "a_ddf/$dia.dot";

        file_update($t1, $out_dot);

        $out_inc .= "    </table>\n";
        $t1      =  "a_ddf/$dia.inc";

        file_update($t1, $out_inc);
    }

    #
    # Sanity Checks!
    #

    # Report on missing or multiple links.

    foreach $t1 (sort(keys(%link))) {

        $r1 = $link{$t1};

        foreach $t2 (sort(keys(%$r1))) {

            @t1 =  sort(keys(%{ $r1->{$t2} }));
            @t1 =  grep(!/^all$/, @t1);					# KLUDGE
            $t3 =  scalar(@t1);

            if ($t3 == 0) {

                print "? Link from '$t1' to '$t2' never shown.\n"
                    unless ((($t1 =~ m[\.dot$])         and		# KLUDGE
                             ($t2 =~ m[^bin/all_d2ic$])    ) or
                            (($t1 =~ m[^bin/all_d2ic$]) and
                             ($t2 =~ m[\.(cmap|png)$])     ) or
                            (($t1 =~ m[\.(cmap|png)$]) and
                             ($t2 =~ m[\.shtml$])          ));
            }

            print "? Link from '$t1' to '$t2' shown $t3 times:\n  "
                . join(', ', @t1) . "\n"                      if ($t3 >  1);
    }   }

    # Report on multiple uses of nodes.

    $t1 =  '';

    foreach $t2 (sort(keys(%uses))) {

        $r1 =  $uses{$t2};
        @t1 =  sort(keys(%$r1));
        @t1 =  grep(!/^all$/, @t1);					# KLUDGE
        $t3 =  join(', ', @t1);

        $t1 .= sprintf("  %-25s %s\n", $t2, $t3) if ($t3 =~ m|, |);

        $cnt{$t2}++;

        foreach $t3 (@t1) { $cnt{$t3}++; }
    }

    print "? Some nodes shown multiple times:\n$t1" if ($t1 ne '');

    # Report on unused nodes.

    foreach $t2 (sort(keys(%node))) {

        print "? Node '$t2' never shown.\n" unless (exists($cnt{$t2}));
    }

    know_exit();
}