fix rules and remove w3c callback

diff --git a/debian/move_info_images_from_html_doc b/debian/move_info_images_from_html_doc
new file mode 100644 (file)
index 0000000..5477d79
--- /dev/null
+++ b/debian/move_info_images_from_html_doc
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use File::Find;
+use File::Spec;
+use File::Copy;
+use File::Path qw(make_path);
+
+my ($info_dir,$html_images) = @ARGV;
+
+find(\&move_directories,$info_dir);
+
+sub move_directories {
+    return unless -f $_;
+    return unless $_ =~ /\.info(?:-\d+)?(?:\.gz)?$/;
+    open(my $info_fh,'-|','zcat','-f',$_);
+    my $l;
+    while (defined ($l = <$info_fh>)) {
+        chomp $l;
+        my @images = $l =~ /\[image\s+src="([^"]+)"/g;
+        for my $image (@images) {
+            my $image_dest = File::Spec->catfile($info_dir,
+                                                 $image);
+            print STDERR "checking $image ";
+            my $image_no_lilypond = $image;
+            $image_no_lilypond =~ s{^lilypond/?}{};
+            my $image_dir = $image_no_lilypond;
+            $image_dir =~ s{/[^/]+$}{};
+            my $image_source = File::Spec->catfile($html_images,
+                                                   $image_no_lilypond);
+            $image_dir = File::Spec->catfile($info_dir,'lilypond',$image_dir);
+            if (-f $image_source and
+                not -e $image_dest
+               ) {
+                print STDERR "moving to $image_dest\n";
+                if (not -d $image_dir) {
+                    make_path($image_dir);
+                    print STDERR "making $image_dir\n";
+                }
+                copy($image_source,$image_dest) or
+                    die "Unable to move $image_source to $image_dest $!";
+                # we don't bother to stick a symlink here, because
+                # symlink_html_images_to_info_images will do that for
+                # us.
+            } else {
+                print STDERR "either $image_source doesn't exist or $image_dest exists\n";
+            }
+        }
+    }
+    close($info_fh);
+}

diff --git a/debian/remove_w3c_callback b/debian/remove_w3c_callback
index 9b70881f7ee52a04c86936c56185339d64073b4f..e8a892ab3418d8c5742b4d85a786543adc7ddb0c 100644 (file)
--- a/debian/remove_w3c_callback
+++ b/debian/remove_w3c_callback
@@ -11,7 +11,7 @@ use File::Find;
 #      alt="Valid HTML 4.01 Transitional"
 #      height="31" width="88"></a>
 
-file_find(\&fix_if_file,@ARGV)
+find(\&fix_if_file,@ARGV);
 
 sub fix_if_file {
     return unless -f $_;
@@ -20,14 +20,16 @@ sub fix_if_file {
     local $/;
     my $fc = <$fh>;
     close($fh);
-    if (# strip out the w3c img callback; replace with alt text
-        $fc =~ s{<img\s+src="http://www.w3c.org/Icons/[^"]+"[^>]*?alt="([^"]+)"[^>]*>}{$1}img
-        or
-        # if it doesn't have alt text, just replace it with Valid HTML
-        $fc =~ s{<img\s+src="http://www.w3c.org/Icons/[^"]+"[^>]*>}{Valid HTML}img ) {
+    # strip out the w3c img callback; replace with alt text
+    my $changed = $fc =~ s{<img\s+src="http://www.w3c?.org/Icons/[^"]+"[^>]*?alt="([^"]+)"[^>]*>}{$1}imsg;
+    # if it doesn't have alt text, just replace it with Valid HTML
+    $changed += $fc =~ s{<img\s+src="http://www.w3c?.org/Icons/[^"]+"[^>]*>}{Valid HTML}imsg;
+
+    if ($changed) {
         $fh = IO::File->new($_,'w') or
             die "Unable to open $_ for writing: $!";
         print {$fh} $fc;
         close($fh);
+        print STDERR "$File::Find::name was changed\n";
     }
 }

diff --git a/debian/rules b/debian/rules
index 7c652908cf1c9106369d08d9f6cf84d52b0d336b..56ed22c8ba69cfbcf83f1e8cc90cf0056927b743 100755 (executable)
--- a/debian/rules
+++ b/debian/rules
@@ -52,6 +52,8 @@ override_dh_auto_install-indep:
        $(MAKE) install-info $(DOC_OPTIONS) prefix=$(CURDIR)/debian/tmp/usr
        rm -rf $(CURDIR)/debian/tmp/usr/share/omf
        rm -rf $(CURDIR)/debian/tmp/usr/share/doc/lilypond/html/input
+       perl debian/move_info_images_from_html_doc $(CURDIR)/debian/tmp/usr/share/info/ $(CURDIR)/debian/tmp/usr/share/doc/lilypond/html/Documentation/
+       perl debian/symlink_html_images_to_info_images $(CURDIR)/debian/tmp/usr/share/info/lilypond
        perl debian/remove_w3c_callback $(CURDIR)/debian/tmp/usr/share/doc/lilypond/ $(CURDIR)/debian/tmp/usr/share/info/
 
 ## Unfortunately, lilypond is kind of broken, and installs the wrong

diff --git a/debian/symlink_html_images_to_info_images b/debian/symlink_html_images_to_info_images
new file mode 100644 (file)
index 0000000..66dc9f4
--- /dev/null
+++ b/debian/symlink_html_images_to_info_images
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use File::Find;
+use File::Spec;
+
+my $debian_dir = $ARGV[0];
+
+find(\&symlink_if_file,$debian_dir);
+
+sub symlink_if_file {
+    return if -l $_;
+    return unless -f $_;
+    my ($leading,$dir,$file_name) = $File::Find::name
+        =~ m{(.+/usr/share/info/lilypond/)(.*?)([^/]+)$};
+    my $n_slashes = $dir =~ m{/}g;
+    my $html_file =
+        File::Spec->catfile(('..') x ($n_slashes+2),
+                            qw(doc lilypond html Documentation),
+                            $dir,
+                            $file_name
+                           );
+    my $info_file =
+        File::Spec->catfile(('..') x ($n_slashes+4),
+                            qw(info lilypond),
+                            $dir,
+                            $file_name);
+    if (-f $html_file) {
+        system('ln','-sf',$info_file,$html_file);
+        print STDERR "linking $html_file -> $info_file\n";
+    } else {
+        print STDERR "html file $html_file doesn't exist\n";
+    }
+}