#!/usr/bin/perl
use warnings;
use strict;
use utf8;

unless(config->init()) {
  messages->on_message( sub{ warn $_[0]; } );
  die("Initialisation fehlgeschlagen\n");
}

if(config->get('withgui')) {
  GUI->init();
  messages->on_message(sub{ GUI->add_text($_[0]) if($_[0]); });
  GUI->on_file_open(sub{ convert($_[0]); });
  GUI->run();
  exit(0);
}

messages->on_message(sub{ warn $_[0]; });
convert(config->get('file')) or exit(255);
exit(0);

sub convert {
  my ($file)=@_;
  unless(INIfile->open($file)) {
    messages->do("ERROR OPEN file\n");
    return 0;
  }
  unless(INIfile->renumerate()) {
    messages->do("ERROR PROCESS file\n");
    return 0;
  }
  unless(INIfile->close()) {
    messages->do("ERROR CLOSE file\n");
    return 0;
  }
  return 1;
}

########################################################################
########################################################################
# handhaben von nachrichten an den Nutzer
# das ist wenn man so will eine Zweigstelle
# hier werden die Nachrichten gesammlet und dahin geschriben wo sie hinsollen,
# wenn definiert wurde wohin geschribeen werden soll
{package messages;
  use strict;
  use warnings;

  # das ist eine Referenz auf einen codeblock (sub{ ... })
  # diese wird aufgerufen, wenn eine Nachricht ausgegeben werden soll
  my $handler;

  # hier werden nachricht gesammelt,
  # wenn noch kein codeblock definiert wurde
  # und damit nicht klar ist, wohin geschrieben werden soll
  my $messages;

  # setzen der Referenz
  # wenn sie gesetzt wurde
  # werden auch gleich gesammelten Nachrichten ausgegeben
  sub on_message {
    my ($class,$code)=@_;
    return 0 unless ref $code eq 'CODE';
    $handler=$code;
    $class->do('');
    return 1;
  }

  # aufforderung, eine nachricht auszugeben
  # wenn noch keine Referenz gesetzt wudre, werden die Nachrichten gesammelt
  sub do {
    my ($class,$message)=@_;
    $messages='' unless defined $messages;
    if($handler) {
      $handler->($messages.$message);
      $messages='';
      return 1;
    }
    $messages.=$message;
    return 0;
  }

1;}

########################################################################
########################################################################
# lesen von ARGV
# hier wird auch geprüft ob die Kombinationen der Parameter funktionieren
# und sinnvoll sind
{package argv;
  use strict;
  use warnings;
  use Getopt::Std; # für Auswertung der Startparameter

  # sammle sie paremeter hier
  my %opts;

  # das Parsen darf nur einmal erfolgen
  my $done;

  sub parse {
    my ($class)=@_;

    # wenn schonmal geparset wurde,
    # dann sofort zurück
    return 1 if($done);
    $done=1;

    # parsen von ARGV
    getopts("ogu",\%opts);

    # wenn ARGV nicht mehr enthält
    # es aber keine GUI-Anewenung sein soll
    # dann fehlt der Dateiname
    # und es gibt einen fehler.
    if (!@ARGV and !$opts{g})
    {
      messages->do("Keine Datei gesetzt\nUSAGE: $0 <-o -g -u> datei\n");
      return 0;
    }

    # Dateiname lesen, wenn er gesetzt wurde
    $opts{file}=shift(@ARGV);

    return 1;
  }

  # einen Parameter lesen
  sub get {
    my ($class,$key)=@_;
    return $opts{$key};
  }

1;}

########################################################################
########################################################################
# zentrale Konfiguartion
# hier ist alles mögliche was die konfiguartion betrifft abeglegt
{package config;
  use strict;
  use warnings;
  my %config;

  # configuartion erzeugen
  sub init {
    my ($class)=@_;

    # ARGV parsen
    argv->parse() or return 0;

    # Configuartion erzeugen
    %config=(
      # GUI Sachen
      gui_output => "Ausgabefeld\n",
      gui_title  => $0, # $0 enthält den Dateinamen des Scripts
      gui_w      => 500,
      gui_h      => 240,


      # ARGV paremeter Übernehmen
      unicode    => argv->get('u')?1:0,
      overwrite  => argv->get('o')?1:0,
      withgui    => argv->get('g')?1:0,
      file       => argv->get('file'),

    );

    return 1;
  }

  # einen parameter lesen
  sub get {
    my ($class,$key)=@_;
    return $config{$key};
  }

  # einen paremeter schreiben
  sub set {
    my ($class,$key,$val)=@_;
    $config{$key}=$val;
    return 1;
  }

  sub get_start_dir {
    my ($class)=@_;
    my $file=$class->get('file');

    if($file) {
      return $file if -d $file;
      $file=~s![^/\\]+$!!s;
      return $file if -d $file;
    }

    return '.';
  }

  # man könnte es noch um "save" und "load" ergänzen,
  # damit man Konfiguartionen speichern kann

1;}

########################################################################
########################################################################
# erzeugen und Handhabend er GUI
{package GUI;
  use strict;
  use warnings;
  use Tk; # Notwendig für GUI
  use Tk::DropSite; # Drag&Drop in das Pfadauswahlfenster
  use Tk::ROText; # Drag&Drop in das Pfadauswahlfenster

  use Tk::FileSelect;

  # GUI-Objekt
  my $mw;

  # GUI-TEXT-Objekt
  my $out_text;

  # nachrichten in einem Puffer sammeln, solange die GUI noch nicht Aktiv ist
  my $messages;

  # 1 wenn die GUI Sichtbar ist
  my $running;

  # Verschiedene Coderefenzen die aufgerufen werden,
  # wenn eine GUI-Aktion ausgelöst wird
  my %handler;

  # GUI erzeugen
  sub init {
    my ($class)=@_;
    $mw = MainWindow->new;
    $mw->title(config->get('gui_title'));

    my $w=config->get('gui_w');
    my $h=config->get('gui_h');
    $mw->geometry($w.'x'.$h);
    $mw->minsize($w,$h); # Minimalgröße des Fensters: 500 x 200

    ########### Hauptfenster ##############
    my $frame1 = $mw->Frame;
    $frame1->pack(-side => "top", -fill => "both",
                  -expand => "1", -padx => "2m", -pady => "2m");


    ########### Ausgabefenster ###########

    # Rahmen
    my $out_frm = $frame1->Frame(-borderwidth => 2,
                                 -relief => "ridge");
    $out_frm->pack(-side => "top", -anchor => "n",
                   -expand => "1", -fill => "both");

    # Scrollbar
    my $scrollbar = $out_frm->Scrollbar( );

    # Textfeld
    $out_text = $out_frm->ROText(-width => 80, -height => 5,
                                 -fg => 'black', -bg => 'white',
                                 -yscrollcommand => ['set' => $scrollbar],);
                                 #-state => "disabled");
    $class->add_text(config->get('gui_output'));

    $out_text->pack(-padx => 5, -pady => 5, -expand => "1", -fill => "both");
    $scrollbar->configure(-command => ['yview' => $out_text]);
    #$scrollbar->pack(-side => 'right', -fill => 'y');

    ########### Button ##################

    my $open_button=$mw->Button(
      -text => 'OPEN',
      -command => sub{
        my $open_dialog = $mw->FileSelect( -directory => config->get_start_dir() );
        my $file=$open_dialog->Show();
        if($file) {
          config->set(file => $file);
          $class->do_handler(file_open => ( $file ));
        }
      });
    $open_button->pack();

    return 1;
  }

  # gui anzeigen
  sub run {
    my ($class)=@_;

    # GUI ist sichtbar
    # alle gesammelten Nachrichten ausgeben
    $running=1;
    $class->add_text('');

    # hier bleibt das script "hängen"
    # weil die TK Oberfläche in einer
    # Schleife ist solange sie sichtbar ist.
    # Nur so können alle GUI-Aktionen Gehandhabt werden
    MainLoop();

    $running=0;
    return 1;
  }

  # Nachrichten
  sub add_text {
    my ($class,$message)=@_;
    $messages='' unless defined $messages;
    if($out_text and $running) {
      $out_text->insert('end', $messages.$message);
      $messages='';
      return 1;
    }

    $messages.=$message;
    return 0;
  }

  #---------------------------------------------------------------------
  # verschiedenen handler verwalten und einrichten

  # einen handler aufrufen
  # Beispiel:
  # $class->do_handler('name',@parameter);
  sub do_handler {
    my ($class,$name,@param)=@_;
    return 0 unless $handler{$name} ;
    return 0 unless ref $handler{$name} eq 'CODE';
    $handler{$name}->(@param);
    return 1;
  }

  sub add_handler {
    my ($class,$name,$code)=@_;
    return 0 unless $name;
    return 0 unless ref $code eq 'CODE';
    $handler{$name}=$code;
    return 1;
  }

  sub on_file_open{
    my($class,$code)=@_;
    return $class->add_handler('file_open',$code);
  }

1;}

########################################################################
########################################################################
# nur ein Beispiel
# damit der Teil etwas macht :-)
# hier kommt der richtige Code rein
{package INIfile;
  use strict;
  use warnings;

  my $fh;
  my $tfh;
  my $temp_file;
  my $source_file;

  sub open {
    my ($class,$file)=@_;

    return 0 unless($file);

    $class->close();

    $source_file=$file;

    my $encoding='ISO-8859-1';
    $encoding='UTF-8' if(config->get('unicode'));

    messages->do("Öffne datei $file \n");
    if( CORE::open($fh,'<:encoding('.$encoding.')',$file) ) {
      $temp_file=$file.'.new';
      messages->do("Erzeuge Temoräre datei $temp_file \n");
      if( CORE::open($tfh,'>:encoding('.$encoding.')',$temp_file) ) {
        return 1;
      }
      messages->do("Kann $temp_file nicht öffnen ($!)\n");
      $class->close();
      return 0;
    }

    messages->do("Kann $file nicht öffnen ($!)\n");
    return 0;
  }

  sub renumerate {
    my ($class)=@_;

    return 0 unless $fh;
    return 0 unless $tfh;

    # alles zurück auf Anfang
    seek($fh, 0,0);
    seek($tfh,0,0);

    # temporäre datei leeren
    truncate($tfh,0);

    # zeilen zählen
    my $line_count=0;
    $line_count++ while(<$fh>);
    messages->do("$source_file hat $line_count Zeilen\n");
    seek($fh, 0,0);
    $line_count='%0'.length($line_count).'u %s';

    # allte nummerierung löschen und neue einsetzen
    messages->do("Nummeriere Neu\n");
    my $cnt=0;
    while(my $line = <$fh>) {
      $line=~s/^\s*\d+\s*//s;
      $line=sprintf($line_count, $cnt++, $line);
      print $tfh $line;
    }
    messages->do("Fertig\n");

    return 1;
  }

  sub close {
    my ($class)=@_;
    CORE::close($fh) if($fh);
    CORE::close($tfh) if($tfh);
    $fh=undef;
    $tfh=undef;

    if($temp_file and $source_file and config->get('overwrite') and -e $temp_file and -s $temp_file) {
      messages->do(qq'Überschreibe "$source_file" mit "$temp_file"\n');
      if(!unlink($source_file)) {
        messages->do(qq'Löschen von "$source_file" fehlgeschlagen ($!)\n');
      }
      if(!rename($temp_file, $source_file)) {
        messages->do(qq'Umbenennen von "$temp_file" nach "$source_file" fehlgeschlagen ($!)\n');
      }
    }

    $temp_file=undef;
    $source_file=undef;

    return 1;
  }

1;}