#!/home/fipwiki/bin/perl -I/var/www/twiki/bin -I/var/www/twiki/lib


# TODO: This program doesn't handle character encodings very well. It justs ignores them

BEGIN {
  # Set default current working directory (needed for mod_perl)
  if ( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
    chdir $1;
  }
  # Set library paths in @INC, at compile time
  unshift @INC, '.';
  require 'setlib.cfg';
}

use strict;
use CGI::Carp qw( fatalsToBrowser );
use CGI;
use Spreadsheet::ParseExcel;
use TWiki;
use TWiki::Render;
use TWiki::Meta;


my $log=""; # contains the log messages that will be printed at the end
my $query = new CGI;

my $thePathInfo = $query->path_info();
my $theRemoteUser = $query->remote_user();
my $theTopic = $query->param( 'topic' );
my $theUrl = $query->url;

my( $topic, $webName, $scriptUrlPath, $userName ) =
  TWiki::initialize( $thePathInfo, $theRemoteUser,
		     $theTopic, $theUrl, $query );


# Defaults
my %config= (
	     "TEXTTOPIC" => "TEXT",
	     "DEBUG" => 0,
	     "TOPICCOLUMN" => "TOPIC",
	     "FORCCEOVERWRITE" => 0,
	     "UPLOADFILE" => "$topic.xls",
               "TOPICPARENTCOLUMN" => "TOPICPARENT",
	     "READONLY" => 1,
	     "FORMCOLUMN" => FORM,
	    );

my $help=<<EOT;
| *FIELD*               | *DESCRIPTION* | *DEFAULT* |
|READONLY               | Do not write anything. Just show what would be done | $config{TEXTTOPIC} |
|FORM                   | The default form for all topics that do not have one | $config{FORM} |
|FORMCOLUMN             | The column name in the sheet that contains the FORM for that row |  $config{FORMCOLUMN} |
|TOPICCOLUMN            | The column name in the sheet that contains the topic for that row | $config{TOPICCOLUMN} |
|TOPICPARENT            | The default parent topic for all topics that do not have one | $config{TOPICPARENT} |
|TOPICPARENTCOLUMN      | The column name in the sheet that contains the TOPICPARENT for that row | $config{TOPICPARENTCOLUMN} |
|UPLOADFILE             | Name of the file that contains the Excel sheet | $config{UPLOADFILE} |
|NEWTOPICTEMPLATE       | Name of the topic that contains the template for new topics | $config{NEWTOPICTEMPLATE} |
|FORCCEOVERWRITE        | Shall the locked topics been overwritten | $config{FORCCEOVERWRITE} |
|TOPICCOLUMNWITHSPACES  | The column name that contains the topic for that row but with spaces | $config{TOPICCOLUMNWITHSPACES} |
|NONEWTOPICS            | Do not create any new topics | $config{NONEWTOPICS} |
|DEBUG                  | Switch on debuggig output | $config{DEBUG} |
EOT
$log.=help;
# Get the preferences from the topic and the URL.
foreach my $key (qw(READONLY FORM FORMCOLUMN TOPICPARENT TOPICPARENTCOLUMN UPLOADFILE NEWTOPICTEMPLATE FORCCEOVERWRITE TOPICCOLUMN TOPICCOLUMNWITHSPACES NONEWTOPICS DEBUG )) {
  my $value=&TWiki::Func::getPreferencesValue( $key  );
  if (defined $value and $value !~ /^\s*$/) {
    $config{$key} =$value;
    $config{$key} =~ s/^\s*//go;
    $config{$key} =~ s/\s*$//go;
  }
  if (defined($query->param($key)) and $query->param($key) ne '') {
    $config{$key}=$query->param($key);
  }
  $log.="  $key=$config{$key}\n";
}

if ($config{READONLY}) {
  $log.=<<EOT;
############################################################
#                                                          #
#               WARNING: READ-ONLY MODE                    #
#                                                          #
#  To make this writeable append the URL with ?READONLY=0  #
#                                                          #
############################################################
EOT
}



my $xlsfile = $TWiki::pubDir."/$webName/$topic/$config{UPLOADFILE}";
$log.="  attachment file=$webName/$topic/$config{UPLOADFILE}\n";
if (not -f $xlsfile) {
  print $query->header(-type=>'text/plain', -expire=>'now');
  print"$xlsfile doesn't exist\n";
  exit 0;
}

my $Book = Spreadsheet::ParseExcel::Workbook->Parse($xlsfile);
if (not defined $Book) {
  print $query->header(-type=>'text/plain', -expire=>'now');
  print"Can't parsel Excel file $xlsfile\n";
  exit 0;
}

my($row, $col, $WorkSheet, $cell);
my %colname;
SHEET: foreach my $WorkSheet (@{$Book->{Worksheet}}) { # cycle through the worksheets. In fact only the first is used.
  #print "--------- SHEET:", $WorkSheet->{Name}, "\n";

  # The first row contains the column headers.
  # They are stored in the %colname hash.
  # The key is the column name, the value is the number of the column startinf with 0.
  for (my $col = $WorkSheet->{MinCol} ;	defined $WorkSheet->{MaxCol} && $col <= $WorkSheet->{MaxCol} ; $col++) {
    $cell = $WorkSheet->{Cells}[0][$col];
    if (defined $cell and $cell->Value ne '') {
      $colname{$col}=$cell->Value if($cell);
      $colname{$col}=~s/\s*//g;
      $log.="  Column $col = $colname{$col}\n";
    }
  }

  # Beginning with the second row each row contains the data for one topic.
  ROW: for (my $row = $WorkSheet->{MinRow} +1 ; defined $WorkSheet->{MaxRow} && $row <= $WorkSheet->{MaxRow} ; $row++) {
    # read the contents of each data row 
    my %data;	# contains the row data indexed by column name.
    my $content;
    for (my $col = $WorkSheet->{MinCol} ; defined $WorkSheet->{MaxCol} && $col <= $WorkSheet->{MaxCol} ; $col++) {
      $cell = $WorkSheet->{Cells}[$row][$col];
      # print "( $row , $col ) =>", $cell->Value, "\n" if($cell);
      if ($cell) {
	# print $colname{$col}."=>".$cell->Value, "\n";
	$data{$colname{$col}}=$cell->Value;
      }
    }

    # $newtopic contains the name of the new topic.
    my $newtopic=$data{$config{"TOPICCOLUMN"}};
    # Try to be smart and built a new topic name by creating a TWiki word from a column.
    if ($newtopic eq '' and defined($config{"TOPICCOLUMNWITHSPACES"}) and $data{$config{"TOPICCOLUMNWITHSPACES"}} ne '') {
      $newtopic=toTwikiWord($data{$config{"TOPICCOLUMNWITHSPACES"}});
      $data{"TOPIC"}=$newtopic;
      my $msg="$webName/$newtopic: topic name $newtopic created from $data{$config{TOPICCOLUMNWITHSPACES}}";
      $config{DEBUG} && TWiki::Func::writeWarning($msg);
      $log.="$msg\n";
    }
    if ($newtopic eq '') {
      next ROW;
    }



    # Writing the topic
    my $sourceTopic; # name of the topic to update or the template topic
    my $changed=0;

    # existing or new topic?
    if ( TWiki::Func::topicExists( $webName, $newtopic )) {
      $sourceTopic=$newtopic;
    } elsif (not $config{NONEWTOPICS}) {
      # if the topic does not exist we need to create a new topic based on the topic template
      $sourceTopic=$config{"NEWTOPICTEMPLATE"};
      my $msg="$webName/$newtopic: new topic created based on $config{NEWTOPICTEMPLATE}";
      $config{DEBUG} && TWiki::Func::writeWarning($msg);
      $log.="$msg\n";
      $changed=1;
    } else {
      my $msg="$webName/$newtopic: new topic would have been created, but NONEWTOPICS is set";
      $config{DEBUG} && TWiki::Func::writeWarning($msg);
      $log.="$msg\n";
      next ROW;
    }

    my ( $meta, $text ) = TWiki::Func::readTopic( $webName, $sourceTopic );
    if (not defined $meta or not defined $text) {
      my $msg="$webName/$newtopic: Can't read $sourceTopic, skipping...";
      $config{DEBUG} && TWiki::Func::writeWarning($msg);
      $log.="$msg\n";
      next ROW;
    }

    # handle special meta variables. Use the value from the row, otherwise use the default value
    for my $key (qw(FORM TOPICPARENT)) {
      my $value;
      if (defined($data{$config{$key."COLUMN"}}) and $data{$config{$key."COLUMN"}} ne '') {
	$value=$data{$config{$key."COLUMN"}};
      } else {
	$value=$config{$key} # default value
      }
      if (not defined( ($meta->find("$key"))[0]  ) or
	  not defined(($meta->find("$key"))[0]->{"name"}) or
	  ($meta->find("$key"))[0]->{"name"} ne $value) {
	my $msg="      $webName/$newtopic: $key     new value=$value";
	$config{DEBUG} && TWiki::Func::writeWarning($msg);
	$log.="$msg\n";
	$changed=1;
	my %meta=(
		  "name" =>  $value,
		 );
	$meta->put($key,%meta);
      }
    }

    # Go through each value of the row
    COLUMN: foreach my $colname (values %colname) {

      # Overwrite the text. As a safety measure only overwrite the text if it is not empty.
      if ($colname eq $config{"TEXTTOPIC"}
	  and  not $data{$config{"TEXTTOPIC"}} =~ m/^\s*$/
	  and  $data{$config{"TEXTTOPIC"}} ne $text){
	my $msg="      $webName/$newtopic: topic text has changed";
	$config{DEBUG} && TWiki::Func::writeWarning($msg);
	$log.="$msg\n";
	$log.="vvvvvvvvvvvvvvvvvvv old vvvvvvvvvvvvvvvvvvv \n";
	$log.="$text\n";
	$log.="^^^^^^^^^^^^^^^^^^^ old ^^^^^^^^^^^^^^^^^^^ \n";
	$log.="vvvvvvvvvvvvvvvvvvv new vvvvvvvvvvvvvvvvvvv \n";
	$log.=$data{$config{"TEXTTOPIC"}}."\n";
	$log.="^^^^^^^^^^^^^^^^^^^ new ^^^^^^^^^^^^^^^^^^^ \n";

	$text=$data{$config{TEXTTOPIC}};
	$changed=1;
	next COLUMN;
      }


      my %field;
      # search through all fields of the existing topic or the template topic
      # and find the field with the name $colname. This is to ensure
      # That only values that already exist are amended/created.
      foreach my $field ($meta->find("FIELD")) {
	if ($$field{"name"} eq $colname) {
	  if ($$field{"value"} ne $data{$colname} ) {
	    my $msg="      $webName/$newtopic: $colname: old value=".$$field{"value"}." new value=$data{$colname}";
	    $config{DEBUG} && TWiki::Func::writeWarning($msg);
	    $log.="$msg\n";
	    $changed=1;
	    # replace CR/LF and "
	    $data{$colname} =~ s/(\r*\n|\r)/%_N_%/g;
	    $data{$colname} =~ s/\"/%_Q_%/g;
	    my %meta= (
		       "name" =>$colname,
		       "title"=>$colname,
		       "value"=>$data{$colname},
		      );
	    $meta->put( "FIELD", %meta);
	  }
	  last; # found the field
	}
      }
    }

    # Persist the topic if it wasa changed or created
    if ($changed) {
      my ( $oopsUrl, $loginName, $unlockTime ) = TWiki::Func::checkTopicEditLock( $webName, $newtopic );
      if ($oopsUrl eq '' or $config{"FORCCEOVERWRITE"}) { # FORECEOVERWRITE locked topics
	if (not $config{READONLY}) {
	  TWiki::Store::saveTopic( $webName, $newtopic, $text, $meta, "", 'unlock', 'Notify', "LogSave", "");
	  TWiki::Func::setTopicEditLock( $webName, $newtopic,0 );
	  my $msg="### $webName/$newtopic written ###";
	  $config{DEBUG} && TWiki::Func::writeWarning($msg);
	  $log.="$msg\n";
	} else {
	  my $msg="### $webName/$newtopic has changed, but read only mode ###";
	  $config{DEBUG} && TWiki::Func::writeWarning($msg);
	  $log.="$msg\n";
	}
      } else {
	my $msg="$webName/$newtopic locked and FORCCEOVERWRITE not on -> not overwritten";
	$config{DEBUG} && TWiki::Func::writeWarning($msg);
	$log.="$msg\n";
      }
    } else {
      my $msg="$webName/$newtopic not changed -> not written";
      $config{DEBUG} && TWiki::Func::writeWarning($msg);
      $log.="$msg\n";
    }
  }
  last; # only the first sheet
}

print $query->header(-type=>'text/plain', -expire=>'now');
print $log;
TWiki::Func::writeWarning($log);
# TODO: This is really dirty!!!
if (open (LOG,">/tmp/excel2topic".time())) {
  print LOG $log;
  close(LOG)
}
exit 0;

sub toTwikiWord {
  my $word=shift;
  $word=~s/\&quot;//g;

  $word =~ s/ a/ A/g;
  $word =~ s/ b/ B/g;
  $word =~ s/ c/ C/g;
  $word =~ s/ d/ D/g;
  $word =~ s/ e/ E/g;
  $word =~ s/ f/ F/g;
  $word =~ s/ g/ G/g;
  $word =~ s/ h/ H/g;
  $word =~ s/ i/ I/g;
  $word =~ s/ j/ J/g;
  $word =~ s/ k/ K/g;
  $word =~ s/ l/ L/g;
  $word =~ s/ m/ M/g;
  $word =~ s/ n/ N/g;
  $word =~ s/ o/ O/g;
  $word =~ s/ p/ P/g;
  $word =~ s/ q/ Q/g;
  $word =~ s/ r/ R/g;
  $word =~ s/ s/ S/g;
  $word =~ s/ t/ T/g;
  $word =~ s/ u/ U/g;
  $word =~ s/ v/ V/g;
  $word =~ s/ w/ W/g;
  $word =~ s/ x/ X/g;
  $word =~ s/ y/ Y/g;
  $word =~ s/ z/ Z/g;


  $word =~s/&amp;/And/g;
  $word =~s/ /_/g;
  $word =~s/\!/_/g;
  $word =~s/\%/_/g;
  $word =~s/\-/_/g;
  $word =~s/\'/_/g;
  $word =~s/\//And/g;
  $word =~s/\?//g;
  $word =~s/\226//g;
  $word =~s/:/_/g;
  $word =~s/\&/And/g;
  $word =~s/;/_/g;
  $word =~s/\\/_/g;
  $word =~s/\</_/g;
  $word =~s/\"/_/g;
  $word =~s/\|/_/g;
  $word =~s/\]/_/g;
  $word =~s/\[/_/g;
  $word =~s/\(/_/g;
  $word =~s/\)/_/g;
  $word =~s/,/_/g;
  $word =~s/\#/_/g;
  $word =~s/\>/_/g;
  $word =~s/\</_/g;
  $word =~s/\+/_/g;
  $word =~s/\t/_/g;
  $word =~s/\./Dot/g;


  # Make first Char always uppercase

  $word =~ s/^a/A/g;
  $word =~ s/^b/B/g;
  $word =~ s/^c/C/g;
  $word =~ s/^d/D/g;
  $word =~ s/^e/E/g;
  $word =~ s/^f/F/g;
  $word =~ s/^g/G/g;
  $word =~ s/^h/H/g;
  $word =~ s/^i/I/g;
  $word =~ s/^j/J/g;
  $word =~ s/^k/K/g;
  $word =~ s/^l/L/g;
  $word =~ s/^m/M/g;
  $word =~ s/^n/N/g;
  $word =~ s/^o/O/g;
  $word =~ s/^p/P/g;
  $word =~ s/^q/Q/g;
  $word =~ s/^r/R/g;
  $word =~ s/^s/S/g;
  $word =~ s/^t/T/g;
  $word =~ s/^u/U/g;
  $word =~ s/^v/V/g;
  $word =~ s/^w/W/g;
  $word =~ s/^x/X/g;
  $word =~ s/^y/Y/g;
  $word =~ s/^z/Z/g;

  # Create WikiWords


  $word =~s/_+//g;

  return $word;
}