plugins/15merge

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2000-2003 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
  24 $Text::Wrap::columns=defined $cfg{'maxlinelen'} ? $cfg{'maxlinelen'} : 72;
  25 $cfg{'first'}  ||= "";
  26 $cfg{'leader'} ||= "";
  27
  28 my $anal_merge_debug=0;
  29
  30 sub remove_space($) {
  31         my $text=shift;
  32
  33 # Remove whitespace at the end of lines but not newlines themselves.
  34 # And don't remove the space if it comes directly after a -- which is
  35 # anchored at the beginning of a line.
  36
  37         $text =~ s/(?<!^--)[    ]*$//mg;
  38
  39 # Remove any newlines from the very end of the string.
  40         $text =~ s/\n*$//;
  41         return $text;
  42 }
  43
  44 sub merge($$) {
  45         my ($tag,$sig) = @_;
  46         my $chunk;
  47         my $notag=1;
  48
  49         chomp($tag);
  50         $tag =~ s/\t/ /g;
  51
  52         my ($plugin,$len,$align,$wascr);
  53         $wascr=0;
  54
  55         while ($sig =~ /@([A-Za-z]?)(\*|(?:[1-9][0-9]*))([RC]?)@/) {
  56                 # Ick.
  57                 if (defined $3) {
  58                         $plugin = $1;
  59                         $len    = $2;
  60                         $align  = $3;
  61                 } elsif (not defined $2) {
  62                         $len    = $1;
  63                         $plugin = "";
  64                         $align  = "L";
  65                 } elsif ($2 =~ /^[RC]$/) {
  66                         $plugin = "";
  67                         $len    = $1;
  68                         $align  = $2;
  69                 } else {
  70                         $plugin = $1;
  71                         $len    = $2;
  72                         $align  = "L";
  73                 }
  74
  75 print STDERR "plugin,len,type = #$plugin#,#$len#,#$align#\n" if $anal_merge_debug;
  76                 if ($plugin ne "") {
  77                         $chunk = getplugin($plugin);
  78                         print STDERR "Got plugin $plugin and $chunk\n"
  79                                 if $anal_merge_debug;
  80                         $len = quotemeta $len; # escape * if it is *
  81                         $sig =~ s/\@$plugin$len[RC]?@/$chunk/;
  82                         print STDERR "Sig is now:\n$sig" if $anal_merge_debug;
  83                         $chunk = "";
  84                 } else {
  85                         my $extra;
  86                         $notag=0;
  87                         if ($len ne "*") {
  88                                 $chunk =  substr $tag, 0, $len;
  89 print STDERR "chunk,tag = #$chunk#,#$tag#".length($tag)." ".length($chunk)."\n"
  90         if $anal_merge_debug;
  91                                 if ($chunk =~ s/^([^\n]+)\n+(.*)$/$1/s) {
  92                                         $extra = $2;
  93                                         print STDERR "\$extra = [$extra]\n"
  94                                                 if $anal_merge_debug;
  95                                 }
  96                                 if (length($chunk) < $len) {
  97                                         print STDERR "length(chunk) < $len\n"
  98                                                 if $anal_merge_debug;
  99                                         $chunk=&chunksizealign($chunk,$len,$align);
 100                                         print STDERR "chunk = #$chunk#\n"
 101                                                 if $anal_merge_debug;
 102                                 }
 103                                 if (length($tag) < $len + 1) {
 104                                         $tag= $extra ? $extra : "";
 105 print STDERR "length(tag) < $len + 1, tag now = #$tag#(extra = #$extra#)\n"
 106         if $anal_merge_debug;
 107                                 } elsif (substr $tag, 0,  $len + 1 eq ' ') {
 108                                         $tag=substr $tag, $len + 1;
 109                                         $tag=$extra . $tag if defined $extra;
 110 print STDERR "substr tag, 0, $len + 1 was a space.  tag now = #$tag#\n"
 111         if $anal_merge_debug;
 112                                 } else {
 113                                         $tag=substr $tag, $len;
 114                                         ### Back up a word in $chunk
 115                                         $tag=$extra . $tag if defined $extra;
 116 print STDERR "didn't break at space.  Backing up word.  tag now = #$tag#\n"
 117         if $anal_merge_debug;
 118                                         if ($chunk =~ s/(.*) (.*)$/$1/) {
 119                                                 $tag=$2 . $tag;
 120                                                 $chunk=&chunksizealign($chunk,$len,$align);
 121                                         }
 122 print STDERR "If space in chunk then change chunk and add word to tag.".
 123 "Reformat chunk now = #$chunk# (tag = #$tag#)\n" if $anal_merge_debug;
 124                                 }
 125                         } else {
 126                                 $chunk = $tag;
 127                                 $tag = "";
 128                         }
 129                         $len = quotemeta $len; # escape * if it's *
 130                         $sig =~ s/\@$plugin$len[RC]?@/$chunk/;
 131                 }
 132         }
 133         $sig =~ s/@([0-9]+)[RC]?@/" " x $1/eg;
 134         $sig =~ s/@\*[RC]?@//g;
 135         $cfg{'notag'} = $notag;
 136         if ($tag and not $notag) {
 137                 return undef;
 138         }
 139         return &remove_space($sig);
 140 }
 141
 142 {
 143 my %plugins;
 144 sub getplugin($) {
 145         my $plugin = shift;
 146
 147         my $count = 0;
 148         $count = $plugins{$plugin} if defined $plugins{$plugin};
 149         open(IN, "$cfg{'tmpdir'}/$plugin") or htagdie "$0: Could not open $cfg{'tmpdir'}/$plugin: $!\n";
 150         my $chunk;
 151         while ($count > 0) {
 152                 $chunk = <IN>;
 153                 $count--;
 154         }
 155         $plugins{$plugin} = $count+1;
 156         $chunk = <IN>;
 157         chomp $chunk;
 158         return $chunk;
 159 }
 160 }
 161
 162 {
 163 my ($tag,$sig,$newsig);
 164 open(SIG, "<$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
 165 while(<SIG>) {
 166         $sig .= $_;
 167 }
 168 close(SIG);
 169 my $ret = 0;
 170 if (grep { /\@NOTAG\@/ } $sig) {
 171         $tag="";
 172         $ret=26;
 173         $sig =~ s/\@NOTAG\@\n//;
 174 } else {
 175         open(TAG, "<$cfg{'tmptagfile'}") or htagdie "$1: Could not open $cfg{'tmptagfile'}: $!\n";
 176         while(<TAG>) {
 177                 $tag .= $_;
 178         }
 179         close(TAG);
 180 }
 181 if (defined $sig and $sig =~ /@[A-Za-z]?\*|(?:[1-9][0-9]*)[RC]?@/) {
 182         $sig =  merge($tag,$sig);
 183 } else {
 184         my $formatted_tag = Text::Wrap::wrap($cfg{'first'},$cfg{'leader'},$tag);
 185         $sig .= $formatted_tag;
 186         $sig =  &remove_space($sig);
 187         $cfg{'notag'} = 0;
 188 }
 189 if (defined $sig) {
 190         open(SIG, ">$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
 191         print SIG "\n" while $cfg{'newline'}--;
 192         print SIG $sig;
 193         close(SIG);
 194         return $ret;
 195 } else {
 196         return(10);
 197 }
 198 }