#! /usr/bin/perl -w

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use utf8;
use encoding 'utf8';
use open ':utf8'; # input and output default layer will be UTF-8
use POSIX;
my (@toc_p, @toc_c, @toc_t);
my $toc_n=0;
# TODO: double check for funy filenames
# FIXME: encode/decode special chars and round title to some length

sub get_i($) {
  my $p=shift;
  my $i;
  $p=~s/_([^\/]*)//g;
  for $i (0..$toc_n-1) {
    if ($toc_p[$i] eq $p) {return int($i);}
  }
  return -1;
}

sub get_stub_title($) {
  my $fn=shift;
  my $p;
  my $t='';
  $p=$fn;
  $p=~s/_([^\/]*)//g;
  if ($fn =~ /\/?([^\/]*_)([^\/]+)$/) {$t=$2}
  if ($t) {return $t}
  if (-f $fn) {
    open T, $fn;
    $t=<T>; # get first line
    chomp $t;
    close T;
  }
  if ($t) {return $t}
  my $i=get_i($fn);
  if ($i>=0) {return $toc_t[$i]}
  return $fn;
}

sub add_toc_stubs($) {
  my $f0=shift;
  my ($dn,$fn,$f1,$f2,$f3,$t,$i,$n);
  my $c='2';
  # f0 orig, fn strip _, f1/dn orig {dir/base}name, f2 stribed basename,f3 new basename
  $fn=$f0;
  $fn=~s/_([^\/]*)//g; # strip _
  printf("\t@%s\n",$fn);
  $t=get_stub_title($fn);
  if ($f0=~/^(.*\/)([^\/]*)$/) {
    $dn=$1;
    $f1=$2;
  } else {$f1=$f0; $dn=""}
#   $dn=$f0;
#   $dn=~s/^(.*)\/?([^\/]*)$/$1/; # dirname  
#   $f1=$f0;
#   $f1=~s/\/?([^\/]*)$/$1/; # basename

  $f2=$f1;
  $f2=~s/_([^\/]*)//g; # striped basename 
  $f3=sprintf("%s_%s",$f2,$t);
  printf("[%s]%s->%s[%s]\n",$f0,$f1,$f3, $dn.$f3);
  if ($f0 ne $dn.$f3) {rename $f0, $dn.$f3 or die "could not rename"}
  return $dn.$f3;
}
sub recursive_plus {
  my $dir=shift;
  my $func= shift;
  my $i="";
  my $j;
  my @a;
  $i=&$func ("$dir") unless ($dir eq "." or $dir eq "./");
  if ($i) {$dir=$i}
  printf("\t#%s\n",$dir);
  opendir D, "$dir";
  @a=readdir D;
  @a=grep {
    ($_ ne ".") && ($_ ne "..") && ($_ ne "+")
  } @a;
  @a=sort @a;
  print "in [$dir] are:";
  foreach $i (@a) {print"$i",", "}
  print "END\n";
  foreach $i (@a) {
	$j=$dir."/".$i;
	$j=~s/\/\//\//; # remove repeated //
	$j=~s/^\.\///; # remove leading ./
	$j=~s/\/$//; # remove tailing /
	print "checking [$j]:";
	if (-d "$j") {print "dir\n"; recursive_plus("$j",$func);}
	else {print "file\n"; &$func ("$j");}
  }
  closedir D;

}
sub cd_th {
  my $pwd=getcwd();
  do {
    if (-d "+") {return $pwd;}
    chdir("..");
    $pwd=getcwd();
  }until ($pwd eq "/");
  return 0;
}

my $prefix;
$prefix=cd_th() or die "Could not found Thwab control + directory";
printf "@<%s>\n",$prefix;
if (open TOC ,$prefix."/+/1") {
while (<TOC>) {
  chomp;
  if (/^\s*(\S+)\s*(\S)\s*(.*)$/) {
    ($toc_p[$toc_n],$toc_c[$toc_n],$toc_t[$toc_n])=
    	($1,$2,$3);
    $toc_n=$toc_n+1;
  }
 }
close TOC;
} else {$toc_n=0}

&recursive_plus (".", \&add_toc_stubs);
