#!/usr/bin/perl
# Time-stamp: <2018-01-12 12:57:46 phm>

=head1 NAME

nav_tmpl_repl

=head1 DESCRITPION

find old style navigation file with contents lik

    # [% emacs_top_local_variables %]
    # Time-stamp: <2008-05-09 09:34:14 phm>

    @[% TArb %]

    [% TBrantc %]

    # [% TPoct %]	href:HM/index.html
    # [% TNDat %]	href:HM/date.html

     zeilen		href:zeilen.html
     svn_update	href:svn_update.html
     svn_resolve	href:svn_update.html
     u2tex		href:u2tex.html
     checkout_..	href:checkout_svndirs.html
     prog		href:test_prog.html
     homdisk	href:test_homdisk.html
     dbmvals	href:dbmvals.html
     txt2dbm	href:txt2dbm.html

    [%# Local Variables: -%]
    [%# mode: fundamental -%]
    [%# srcfile: /adv/prg/bin/@nav.a2e_bin.txt -%]
    [%# dokl: A2eBinNav -%]
    [%# coding: utf-8 -%]
    [%# End: -%]

and replace it with new style phrases, in this case

    <!-- [% emacs_top_local_variables %] -->
    <!-- Time-stamp: <2008-05-09 09:34:14 phm> -->
    [% PROCESS 'nav_defs_tmpl.txt' -%]
    [% PROCESS dokarb -%]
    [% PROCESS hypermail -%]
    [% PROCESS rekspanel tit=TBrantc reks = [  { lab => 'zeilen', url => 'zeilen.html' } ,  { lab => 'svn_update', url => 'svn_update.html' } ,  { lab => 'svn_resolve', url => 'svn_update.html' } ,  { lab => 'u2tex', url => 'u2tex.html' } ,  { lab => 'checkout_..', url => 'checkout_svndirs.html' } ,  { lab => 'prog', url => 'test_prog.html' } ,  { lab => 'homdisk', url => 'test_homdisk.html' } ,  { lab => 'dbmvals', url => 'dbmvals.html' } ,  { lab => 'txt2dbm', url => 'txt2dbm.html' }  ] -%]
    [%# Local Variables: -%]
    [%# mode: fundamental -%]
    [%# srcfile: /adv/prg/bin/@nav.a2e_bin.txt -%]
    [%# dokl: A2eBinNav -%]
    [%# coding: utf-8 -%]
    [%# End: -%]

=head1 IMPLEMENTATION

=head2 Package NAV_TMPL_PERL
=cut

package NAV_TMPL_REPL;

use base A2E::Dokfs;

sub defvars {
    my $m = shift;
    $m->dpuc('NTR::defvars', @_);
    $m->SUPER::defvars;
    $m->{konfig}->define('allow_blank_lines|abl!');
    $m->dpop('NTR::defvars', 1);
    return 1;
};

sub nav_tmpl_repl {
    my $m = shift;
    my $dok = $m->get_dok;
    die 'can not find a document here' unless $dok;
    my $fi = sprintf '@nav.%s.txt', $dok;
    my $fi_nov = join '.', $fi, 'nov';
    my $fi_bak = join '.', $fi, 'bak';
    $m->open_fayl($fi, 'i', 'r');
    $m->open_fayl($fi_nov, 'o', 'w');
    my @matches = ();
    my %fini = ();
    my @reks = ();
    my $titvar = '';
    my $titval = '';
    my $nestlevel = 0;
  LINI: while ($m->getlini('i')) {
      s(\A(.*\S)\s+\Z)($1);
    REKS: {
	@matches = m(\A\s(\S[^\t]*)\t+href\:(\S+)\Z);
	last unless @matches;
	push @reks, { lab => $matches[0], url => $matches[1] };
	next LINI;
      };
    REKS: {
	@matches = m(\A\s(\S[^\t]*)\t+dok\:(\S+)\Z);
	last unless @matches;
	push @reks, { lab => $matches[0], dok => $matches[1] };
	next LINI;
      };
    REKS: {
	@matches = m(\A\shref:(\S+)\t+(\S[^\t]+)\Z);
	last unless @matches;
	push @reks, { lab => $matches[1], url => $matches[0] };
	next LINI;
      };
    REKS: {
	@matches = m(\A\sdok\:(\S+)\t+(\S[^\t]*)\Z);
	last unless @matches;
	push @reks, { lab => $matches[1], dok => $matches[0] };
	next LINI;
      };
    REKS: {
	@matches = m(\A\s(\w+\:\S+)\t+(\S[^\t]*)\Z);
	last unless @matches;
	push @reks, { lab => $matches[1], url => $matches[0] };
	next LINI;
      };
    REKS: {
	@matches = m(\A\s(\S[^\t]*)\t+(\S+)\Z);
	last unless @matches;
	push @reks, { lab => $matches[0], url => $matches[1] };
	next LINI;
      };
    REKS: {
	@matches = m(\A\s(\S+)\t+(\S.*)\Z);
	last unless @matches;
	push @reks, { lab => $matches[1], url => $matches[0] };
	next LINI;
      };
    REKS_FINI: {
	last unless @reks;
	if ($titvar) {
	    $tit = $titvar;
	} else {
	    $tit = qq{'$titval'} if $titval;
	};
	$tit ||= 'TBrantc';
	$reks_tmpl = join ', ', map { my $key = $_->{url} ? 'url' : 'dok';my $lab = $_->{lab};@matches = $lab =~ m(\A\[\%\s+(\w+)\s+\%\]\Z);$lab = @matches ? $matches[0] : qq{'$lab'};my $val = qq{'$_->{$key}'};qq{{ lab => $lab, $key => $val }} } @reks;
	$reks_tmpl = '[ ' . $reks_tmpl . ' ]';
	$m->print_tu_fayl('o', qq{[% PROCESS rekspanel tit=$tit reks = $reks_tmpl -%]\n});
	$titvar = '';
	$titval = '';
	@reks = ();
      };
    HYPERMAIL: {
	last unless m(\bHM\/\w+\.html\b);
	next LINI if $fini{hypermail};
	$m->print_tu_fayl('o', qq{[% PROCESS 'nav_defs_tmpl.txt' -%]\n}) unless $fini{nav_defs};
	$fini{nav_defs} = 1;
	$m->print_tu_fayl('o', qq{[% PROCESS hypermail -%]\n}); 
	$fini{hypermail} = 1;
	next LINI;
      };
    KOMENT: {
	@matches = m(\A\#\s*(.*)\Z);
	last unless @matches;
	$m->print_tu_fayl('o', '<!-- ' . $matches[0] . ' -->' . "\n");
	next LINI;
      };
    LOKVARS: {
	last unless m(Local\sVariables\:);
	my $lokvars = { mode => 'conf',	coding => 'utf-8', dokl => $m->CamelCase($dok) . 'Nav', srcfile => $fi };
	my $stag = '[' . '%' . '#';
	my $etag = '-' . '%' . ']';
	$m->print_tu_fayl('o', $m->emacs_bottom_local_variables($stag, $etag, $lokvars, qw(coding mode dokl srcfile)));
	last LINI;
      };
    TMPL_KOMENT: {
	last unless m(\A\[\%\#.*\%\]\s*\Z);
	$m->print_tu_fayl('o', $_ . "\n");
	next LINI;
      };
    BLANK: {
	last unless m(\A\s*\Z);
	$m->print_tu_fayl('o', "\n") if $m->{konfig}->allow_blank_lines;
	next LINI;
      };
    DOKARB: {
	last unless m(\A\@);
	next if $fini{dokarb};
	$m->print_tu_fayl('o', qq{[% PROCESS 'nav_defs_tmpl.txt' -%]\n}) unless $fini{nav_defs};
	$fini{nav_defs} = 1;
	$m->print_tu_fayl('o', qq{[% PROCESS dokarb -%]\n});
	$fini{dokarb} = 1;
	next LINI;
      };
    TITVAR: {
	@matches = m(\A\[\%\s+(\w+)\s+\%\]\Z);
	last unless @matches;
	last if grep { $_ eq $matches[0] } qw(END);
	$titvar = $matches[0];
	next LINI;
      };
    TITVAL: {
	@matches = m(\A(\w\S.*)\Z);
	last unless @matches;
	$titval = $matches[0];
	next LINI;
      };
      $m->print_tu_fayl('o', $_."\n");
  }
    die sprintf 'the file found here does not seem to be in the old style, not renaming %s to %s', $fi_nov, $fi unless $fini{nav_defs};
    rename $fi, $fi_bak or die sprintf 'failed to rename %s to %s', $fi, $fi_bak;
    rename $fi_nov, $fi or die sprintf 'failed to rename %s to %s', $fi_nov, $fi;
    $m->kloz_fayl($_) for qw(i o);
    return 1;
};

package Main;
my $p = new_ready NAV_TMPL_REPL debug => $ENV{DEBUG};
$p->nav_tmpl_repl(@ARGV);
$p->vecho('OK');

# Local Variables:
# coding: utf-8
# mode: perl
# srcfile: /adv/prg/bin/nav_tmpl_repl.pl
# End: