plugins/15merge

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2000-2008 Simon Huggins
   4 # merge merges the sig and the tag but also merges the sig and the new style
   5 # plugin things (i.e. all those silly files in $cfg{'tmpdir'}
   6
   7 # This program is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by the Free
   9 # Software Foundation; either version 2 of the License, or (at your option)
  10 # any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  14 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 # for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with this program; if not, write to the Free Software Foundation, Inc., 59
  19 # Temple Place, Suite 330, Boston, MA 02111-1307  USA
  20
  21 use strict;
  22 use Text::Wrap;
  23 use Encode;
  24
  25 $Text::Wrap::columns=defined $cfg{'maxlinelen'} ? $cfg{'maxlinelen'} : 72;
  26 $cfg{'first'}  ||= "";
  27 $cfg{'leader'} ||= "";
  28
  29 # Work out the correct locale to use if there is one otherwise we assume
  30 # UTF-8 which shouldn't kill ascii people and anyone else should have
  31 # correctly set locale.
  32 my $fromcharset = 'UTF-8';
  33 my $tocharset = 'UTF-8';
  34
  35 my @all_encodings = Encode->encodings(":all");
  36 my $locale;
  37 if (defined $ENV{'LC_ALL'}) {
  38         $locale = $ENV{'LC_ALL'};
  39 } elsif (defined $ENV{'LC_CTYPE'}) {
  40         $locale = $ENV{'LC_CTYPE'};
  41 } elsif (defined $ENV{'LANG'}) {
  42         $locale = $ENV{'LANG'};
  43 }
  44 if ($locale) {
  45         $locale =~ s/.*\.//;
  46         $locale = lc $locale;
  47         foreach (@all_encodings) {
  48                 if ($locale eq lc $_) {
  49                         $tocharset = $fromcharset = $_;
  50                         last;
  51                 }
  52         }
  53 }
  54
  55 my $anal_merge_debug=0;
  56
  57 sub remove_space($) {
  58         my $text=shift;
  59
  60 # Remove whitespace at the end of lines but not newlines themselves.
  61 # And don't remove the space if it comes directly after a -- which is
  62 # anchored at the beginning of a line.
  63
  64         $text =~ s/(?<!^--)[    ]*$//mg;
  65
  66 # Remove any newlines from the very end of the string.
  67         $text =~ s/\n*$//;
  68         return $text;
  69 }
  70
  71 sub merge($$) {
  72         my ($tag,$sig) = @_;
  73         my $chunk;
  74         my $notag=1;
  75
  76         chomp($tag);
  77         $tag =~ s/\t/ /g;
  78
  79         my ($plugin,$len,$align,$wascr);
  80         $wascr=0;
  81
  82         while ($sig =~ /@([A-Za-z]?)(\*|(?:[1-9][0-9]*))([RC]?)@/) {
  83                 # Ick.
  84                 if (defined $3) {
  85                         $plugin = $1;
  86                         $len    = $2;
  87                         $align  = $3;
  88                 } elsif (not defined $2) {
  89                         $len    = $1;
  90                         $plugin = "";
  91                         $align  = "L";
  92                 } elsif ($2 =~ /^[RC]$/) {
  93                         $plugin = "";
  94                         $len    = $1;
  95                         $align  = $2;
  96                 } else {
  97                         $plugin = $1;
  98                         $len    = $2;
  99                         $align  = "L";
 100                 }
 101
 102 print STDERR "plugin,len,type = #$plugin#,#$len#,#$align#\n" if $anal_merge_debug;
 103                 if ($plugin ne "") {
 104                         $chunk = getplugin($plugin);
 105                         print STDERR "Got plugin $plugin and $chunk\n"
 106                                 if $anal_merge_debug;
 107                         $len = quotemeta $len; # escape * if it is *
 108                         $sig =~ s/\@$plugin$len[RC]?@/$chunk/;
 109                         print STDERR "Sig is now:\n$sig" if $anal_merge_debug;
 110                         $chunk = "";
 111                 } else {
 112                         my $extra;
 113                         $notag=0;
 114                         if ($len ne "*") {
 115                                 $chunk =  substr $tag, 0, $len;
 116 print STDERR "chunk,tag = #$chunk#,#$tag#".length($tag)." ".length($chunk)."\n"
 117         if $anal_merge_debug;
 118                                 if ($chunk =~ s/^([^\n]+)\n+(.*)$/$1/s) {
 119                                         $extra = $2;
 120                                         print STDERR "\$extra = [$extra]\n"
 121                                                 if $anal_merge_debug;
 122                                 }
 123                                 if (length($chunk) < $len) {
 124                                         print STDERR "length(chunk) < $len\n"
 125                                                 if $anal_merge_debug;
 126                                         $chunk=&chunksizealign($chunk,$len,$align);
 127                                         print STDERR "chunk = #$chunk#\n"
 128                                                 if $anal_merge_debug;
 129                                 }
 130                                 if (length($tag) < $len + 1) {
 131                                         $tag= $extra ? $extra : "";
 132 print STDERR "length(tag) < $len + 1, tag now = #$tag#(extra = #$extra#)\n"
 133         if $anal_merge_debug;
 134                                 } elsif (substr $tag, 0,  $len + 1 eq ' ') {
 135                                         $tag=substr $tag, $len + 1;
 136                                         $tag=$extra . $tag if defined $extra;
 137 print STDERR "substr tag, 0, $len + 1 was a space.  tag now = #$tag#\n"
 138         if $anal_merge_debug;
 139                                 } else {
 140                                         $tag=substr $tag, $len;
 141                                         ### Back up a word in $chunk
 142                                         $tag=$extra . $tag if defined $extra;
 143 print STDERR "didn't break at space.  Backing up word.  tag now = #$tag#\n"
 144         if $anal_merge_debug;
 145                                         if ($chunk =~ s/(.*) (.*)$/$1/) {
 146                                                 $tag=$2 . $tag;
 147                                                 $chunk=&chunksizealign($chunk,$len,$align);
 148                                         }
 149 print STDERR "If space in chunk then change chunk and add word to tag.".
 150 "Reformat chunk now = #$chunk# (tag = #$tag#)\n" if $anal_merge_debug;
 151                                 }
 152                         } else {
 153                                 $chunk = $tag;
 154                                 $tag = "";
 155                         }
 156                         $len = quotemeta $len; # escape * if it's *
 157                         $sig =~ s/\@$plugin$len[RC]?@/$chunk/;
 158                 }
 159         }
 160         $sig =~ s/@([0-9]+)[RC]?@/" " x $1/eg;
 161         $sig =~ s/@\*[RC]?@//g;
 162         $cfg{'notag'} = $notag;
 163         if ($tag and not $notag) {
 164                 return undef;
 165         }
 166         return &remove_space($sig);
 167 }
 168
 169 {
 170 my %plugins;
 171 sub getplugin($) {
 172         my $plugin = shift;
 173
 174         my $count = 0;
 175         $count = $plugins{$plugin} if defined $plugins{$plugin};
 176         open(IN, "$cfg{'tmpdir'}/$plugin") or htagdie "$0: Could not open $cfg{'tmpdir'}/$plugin: $!\n";
 177         my $chunk;
 178         while ($count > 0) {
 179                 $chunk = <IN>;
 180                 $count--;
 181         }
 182         $plugins{$plugin} = $count+1;
 183         $chunk = <IN>;
 184         chomp $chunk;
 185         return $chunk;
 186 }
 187 }
 188
 189 {
 190 my ($tag,$sig,$newsig);
 191 open(SIG, "<$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
 192 while(<SIG>) {
 193         $sig .= decode($fromcharset, $_);
 194 }
 195 close(SIG);
 196 my $ret = 0;
 197 if (grep { /\@NOTAG\@/ } $sig) {
 198         $tag="";
 199         $ret=26;
 200         $sig =~ s/\@NOTAG\@\n//;
 201 } else {
 202         open(TAG, "<$cfg{'tmptagfile'}") or htagdie "$1: Could not open $cfg{'tmptagfile'}: $!\n";
 203         while(<TAG>) {
 204                 $tag .= decode($fromcharset, $_);
 205         }
 206         close(TAG);
 207 }
 208 if (defined $sig and $sig =~ /@[A-Za-z]?\*|(?:[1-9][0-9]*)[RC]?@/) {
 209         $sig =  merge($tag,$sig);
 210 } else {
 211         my $formatted_tag = Text::Wrap::wrap($cfg{'first'},$cfg{'leader'},$tag);
 212         $sig .= $formatted_tag;
 213         $sig =  &remove_space($sig);
 214         $cfg{'notag'} = 0;
 215 }
 216 if (defined $sig) {
 217         $sig = encode($tocharset, $sig);
 218         open(SIG, ">$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
 219         print SIG "\n" while $cfg{'newline'}--;
 220         print SIG $sig;
 221         close(SIG);
 222         return $ret;
 223 } else {
 224         return(10);
 225 }
 226 }