debian/move_info_images_from_html_doc

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use File::Find;
   7 use File::Spec;
   8 use File::Copy;
   9 use File::Path qw(make_path);
  10
  11 my ($info_dir,$html_images) = @ARGV;
  12
  13 find(\&move_directories,$info_dir);
  14
  15 sub move_directories {
  16     return unless -f $_;
  17     return unless $_ =~ /\.info(?:-\d+)?(?:\.gz)?$/;
  18     open(my $info_fh,'-|','zcat','-f',$_);
  19     my $l;
  20     while (defined ($l = <$info_fh>)) {
  21         chomp $l;
  22         my @images = $l =~ /\[image\s+src="([^"]+)"/g;
  23         for my $image (@images) {
  24             my $image_dest = File::Spec->catfile($info_dir,
  25                                                  $image);
  26             print STDERR "checking $image ";
  27             my $image_no_lilypond = $image;
  28             $image_no_lilypond =~ s{^lilypond/?}{};
  29             my $image_dir = $image_no_lilypond;
  30             $image_dir =~ s{/[^/]+$}{};
  31             my $image_source = File::Spec->catfile($html_images,
  32                                                    $image_no_lilypond);
  33             $image_dir = File::Spec->catfile($info_dir,'lilypond',$image_dir);
  34             if (-f $image_source and
  35                 not -e $image_dest
  36                ) {
  37                 print STDERR "moving to $image_dest\n";
  38                 if (not -d $image_dir) {
  39                     make_path($image_dir);
  40                     print STDERR "making $image_dir\n";
  41                 }
  42                 copy($image_source,$image_dest) or
  43                     die "Unable to move $image_source to $image_dest $!";
  44                 # we don't bother to stick a symlink here, because
  45                 # symlink_html_images_to_info_images will do that for
  46                 # us.
  47             } else {
  48                 print STDERR "either $image_source doesn't exist or $image_dest exists\n";
  49             }
  50         }
  51     }
  52     close($info_fh);
  53 }