shapes/make-midpoint.pl

   1 #!/usr/bin/perl -w -i
   2
   3 use strict;
   4 use XML::LibXML;
   5
   6 my $NS = "http://www.daa.com.au/~james/dia-shape-ns";
   7
   8 sub getAttribute {
   9     my ($node, $name) = @_;
  10
  11     for my $attr ($node->attributes()) {
  12         if ($attr->nodeName eq $name) {
  13             return $attr;
  14         }
  15     }
  16 }
  17
  18 while (my $filename = shift) {
  19     my $parser = XML::LibXML->new();
  20     my $tree = $parser->parse_file($filename);
  21     my $root = $tree->getDocumentElement; # shape element
  22
  23     my @svg = $root->getElementsByTagName('svg:svg');
  24     if (@svg > 1) {
  25         die "Too many svg's";
  26     }
  27     if (@svg == 0) {
  28         # No SVG
  29         next;
  30     }
  31     my $svg = $svg[0]; # should only be one
  32
  33     my $widthval = $svg->getAttribute("width");
  34     if ($widthval) {
  35         $widthval =~ s/cm//;
  36     }
  37     my $heightval = $svg->getAttribute("height");
  38     if ($heightval) {
  39         $heightval =~ s/cm//;
  40     }
  41     if ($widthval && $heightval) {
  42         my $newline = $tree->createTextNode( "\n" );
  43         my $midx = $widthval/2;
  44         my $midy = $heightval/2;
  45         # For unknown reasons, this doesn't find the connections child
  46
  47 #       my @connections = $root->getElementsByTagName('connections');
  48 #       if (@connections > 1) {
  49 #           die "Too many connections";
  50 #       }
  51 #       my $conn2 = $connections[0];
  52 #       print "Old conn: " . $conn2 . "\n";
  53
  54         my @points = $tree->getElementsByTagNameNS($NS, 'point');
  55
  56         my @conn = $tree->getElementsByTagNameNS($NS, 'connections');
  57         if (@conn > 1) {
  58             die "Too many connection groups";
  59         }
  60         my $conn = $conn[0];
  61
  62         if ($conn) {
  63             my @points = $tree->getElementsByTagNameNS($NS, 'point');
  64             my $mainPoint = $tree->createElement("point");
  65             $mainPoint->setAttribute("x", $midx);
  66             $mainPoint->setAttribute("y", $midy);
  67             $mainPoint->setAttribute("main", "yes");
  68             my $replaced = 0;
  69             foreach my $point (@points) {
  70                 my $x = getAttribute($point, "x");
  71                 my $y = getAttribute($point, "y");
  72                 my $main = getAttribute($point, "main");
  73                 if ($main) {
  74 #                   $conn->removeChild($point);
  75                     $point->replaceNode($mainPoint);
  76                     $replaced = 1;
  77                 } else {
  78                     if ($x == $midx && $y == $midy) {
  79                         print "Replacing nonmain\n";
  80                         $conn->removeChild($point);
  81                     }
  82                 }
  83             }
  84             if (!$replaced) {
  85                 $conn->addChild($mainPoint);
  86                 $root->insertAfter( $newline, $mainPoint);
  87             }
  88         } else {
  89             $conn = $tree->createElement("connections");
  90             my $mainPoint = $tree->createElement("point");
  91             $mainPoint->setAttribute("x", $midx);
  92             $mainPoint->setAttribute("y", $midy);
  93             $mainPoint->setAttribute("main", "yes");
  94             $conn->addChild($mainPoint);
  95             my $spacing = $tree->createTextNode( "  " );
  96             $root->insertBefore($spacing, $svg);
  97             $root->insertBefore($conn, $svg);
  98             $root->insertBefore($newline, $svg);
  99         }
 100         open(OUT, ">$filename");
 101         print OUT $tree->toString;
 102         close OUT;
 103     }
 104 }
 105
 106 #my @svg = $shape[0]->getElementsByTagName('svg:svg');
 107 #print @svg;
 108