texinfo/tp/Texinfo Common.pm

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        11/06/06 22:35:21

Modified files:
        tp/Texinfo     : Common.pm 

Log message:
        New file to parse renamed file configuration file.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Common.pm?cvsroot=texinfo&r1=1.47&r2=1.48

Patches:
Index: Common.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Common.pm,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- Common.pm   5 Jun 2011 23:21:48 -0000       1.47
+++ Common.pm   6 Jun 2011 22:35:21 -0000       1.48
@@ -986,4 +986,47 @@
   return $htmlxref;
 }
 
+sub parse_renamed_nodes_file($$;$)
+{
+  my $self = shift;
+  my $renamed_nodes_file = shift;
+  my $renamed_nodes = shift;
+
+  if (open(RENAMEDFILE, "<$renamed_nodes_file")) {
+    if ($self->{'info'} and $self->{'info'}->{'perl_encoding'}) {
+      binmode(RENAMEDFILE, ":encoding($self->{'info'}->{'perl_encoding'})");
+    }
+    my $renamed_nodes_line_nr = 0;
+    my @old_names = ();
+    while (<RENAMEDFILE>) {
+      $renamed_nodes_line_nr++;
+      next unless (/\S/);
+      next if (/address@hidden/);
+      if (s/address@hidden@\{\}\s+(\S)/$1/) {
+        chomp;
+        if (scalar(@old_names)) {
+          foreach my $old_node_name (@old_names) {
+            $renamed_nodes->{$old_node_name} = $_;
+          }
+          @old_names = ();
+        } else {
+          warn (sprintf($self->__("%s:%d: no node to be renamed\n"), 
+                        $renamed_nodes_file, $renamed_nodes_line_nr));
+        }
+      } else {
+        chomp;
+        s/^\s*//;
+        push @old_names, $_;
+      }
+    }
+    if (scalar(@old_names)) {
+      warn (sprintf($self->__("%s:%d: nodes without a new name at the end of 
file\n"),
+             $renamed_nodes_file, $renamed_nodes_line_nr));
+    }
+    close(RENAMEDFILE);
+  } else {
+    warn (sprintf($self->__("Cannot read %s: %s"), $renamed_nodes_file, $!));
+  }
+}
+
 1;