#$Id: Writer.pm 479 2006-08-11 09:25:07Z schroeer $

package Lab::Data::Writer;

use strict;
use encoding::warnings;
use Data::Dumper;
use File::Basename;
use File::Copy;
use Lab::Data::Meta;

our $VERSION = sprintf("0.%04d", q$Revision$ =~ / (\d+) /);

my $default_config = {
    output_data_ext     => "DATA",
    output_meta_ext     => "META",

    output_col_sep      => "\t",
    output_line_sep     => "\n",
    output_block_sep    => "\n",
    output_comment_char => "# ",
};

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);
    
    my $file=shift;
    $self->configure(shift);

    my ($filename,$path,$suffix)=fileparse($file, qr/\.[^.]*/);
    open my $log,">$path$filename.".$self->configure('output_data_ext') or die "Cannot open log file";
    my $old_fh = select($log);
    $| = 1;
    select($old_fh);
    $self->{filehandle}=$log;
    $self->{filename}=$filename;
    $self->{filepath}=$path;
    $self->{block_num}=0;
    
    return $self;
}

sub DESTROY {
    my $self=shift;
    close($self->{filehandle});
}


sub configure {
    my $self=shift;
    my $config=shift;

    if (defined($config) && !(ref $config)) {
        return $self->{Config}->{$config};
    }   
    for my $conf_name (keys %{$default_config}) {
        unless ((defined($self->{Config}->{$conf_name})) || (defined($config->{$conf_name}))) {
            $self->{Config}->{$conf_name}=$default_config->{$conf_name};
        } elsif (defined($self->{config}->{$conf_name})) {
            $self->{Config}->{$conf_name}=$config->{$conf_name};
        }
    }
}

sub get_filename {
    my $self=shift;
    return ($self->{filename},$self->{filepath});
}

sub log_comment {
    my ($self,$comment)=@_;
    my $fh=$self->{filehandle};
    for (split /\n|(\n\r)/, $comment) {
        print $fh $self->configure('output_comment_char'),$_,"\n";
    }
}

sub log_line {
    my ($self,@data)=@_;
    my $fh=$self->{filehandle};
    print $fh (join $self->configure('output_col_sep'),@data),$self->configure('output_line_sep');
}

sub log_start_block {
    my $self=shift;
    my $fh=$self->{filehandle};
    if ($self->{block_num}) {
        print $fh $self->configure('output_block_sep');
    }
    return $self->{block_num}++;
}

sub import_gpplus {
    my $self=shift;
    my %opts=@_;    #filename, newname, archive

    #print "Options: ",Dumper(\%opts);
    
    return "What should I import?" unless ((defined $opts{filename}) && ($opts{filename} ne ''));

    my ($filenamebase,$path,$suffix)=fileparse($opts{filename},qr/_\d+\.TSK/);
    my ($newname) = $opts{newname} =~ /[\/\\]?([^\/\\]+)$/;
    my $newpath=$opts{newname} || $filenamebase;
    $newpath.="/" unless ($newpath =~ /[\/\\]$/);
    for ($path,$filenamebase,$newpath) {
        s/\\/\//g;
        s/ /\\ /g;
    }
    $newname=$newname || $filenamebase;
    my $basename=$path.$filenamebase;
    #print "basename: $basename\nnewpath: $newpath\nnewname: $newname\n";
    my @files=sort {
        ($a =~ /$basename\_(\d+)\.TSK/)[0] <=> ($b =~ /$basename\_(\d+)\.TSK/)[0]
    } glob($basename."_*.TSK");

    #print "Files:\n ",(join "\n ",@files),"\n";
    return "Destination directory $newpath already exists" if (-d $newpath);
    return "Cannot create directory $newpath: $!\n" unless (mkdir $newpath);
        
    my $meta=new Lab::Data::Meta({
        data_complete           => 0,
        dataset_title           => $newname,
        dataset_description     => 'Imported by Importer.pm on '.(join "-",localtime(time)),
        data_file               => "$newname.".$self->configure('output_data_ext'),
    });
    $meta->save("$newpath$newname.".$self->configure('output_meta_ext'));
    
    open my $dataout,">$newpath$newname.".$self->configure('output_data_ext')
        || return "Cannot open output file $newpath$newname.".$self->configure('output_data_ext').": $!";
    
    my (@min,@max);
    my $blocknum=0;
    my $linenum=0;
    my $total_lines=0;
    my $numcol;
    my $ok=0;
    
    for my $old_file (@files) {
        open IN,"<$old_file" || return "Cannot open file $old_file: $!";
        while (<IN>) {
            $_=~s/[\n\r]+$//;
            if (/^([\d\-+\.Ee]+;)+/) {
                if (/E+37/) { print "Attention: Contains bad data due to overload!\n" }
                my @value=split ";";
                $self->log_line($dataout,@value);
                for (0..$#value) {
                    $min[$_]=$value[$_] if (!(defined $min[$_]) || ($value[$_] < $min[$_]));
                    $max[$_]=$value[$_] if (!(defined $max[$_]) || ($value[$_] > $max[$_]));
                }
                if (($linenum==0) && ($blocknum==0)) {
                    $numcol=$#value;
                    for (0..$numcol) {
                        $meta->column_label($_,'column '.($_+1));
                    }
                } elsif ($numcol!=$#value) {
                    die "spaltenzahl scheisse in zeile $linenum von block $blocknum.\n".
                        "sollte ".1+$numcol." sein. so habe ich keinen bock und sterbe jetzt";
                }
                $linenum++;$total_lines++;
            } elsif (/^Saved at ([\d:]{8}) on ([\d.]{8})/) {
                #Zeit und Datum werden von GPplus pro File/Block gespeichert
                my ($time,$date)=($1,$2);
                $meta->block_description($blocknum,"Saved at $time on $date");
                $meta->block_timestamp($blocknum,"$date-$time");
                $meta->block_original_filename($blocknum,$old_file);
            } elsif ($blocknum == 0) {
                #Kommentar
                $meta->dataset_description($meta->dataset_description().$_."\n")
                    if ($_ !~ /DATA MEASURED/);
            } else {
                #ignorierter Kommentar: GPplus schreibt gleichen Kommentar in jedes File
            }
        }
        close IN;
        $blocknum++;
        $self->log_finish_block($dataout);
        if ($linenum > 0) { $ok=1 }
        $linenum=0;
    }
    close $dataout;
    return "No data!\n" unless ($ok);

    chmod 0440,"$newpath$newname.".($self->configure('output_data_ext'))
        or warn "Cannot change permissions for newly created data file: $!\n";
    for (0..$#min) {
        $meta->column_min($_,$min[$_]);
        $meta->column_max($_,$max[$_]);
    }
    $meta->data_complete(1);
    $meta->save("$newpath$newname.".$self->configure('output_meta_ext'));
    my $archive_dir=$newpath."imported_gpplus";
    if ($opts{archive}) {
        return "Destination directory {$newpath}imported_gpplus already exists" if (-d $archive_dir);
        return "Cannot create directory {$newpath}imported_gpplus: $!\n" unless (mkdir $archive_dir);

        for my $old (@files) {
            my ($oldname,$oldpath,$oldsuffix)=fileparse($old,qr/\..*/);
            if ($opts{archive} eq 'move') {
                move $old,"$archive_dir/$oldname$oldsuffix" or warn "Cannot move file $old to archive: $!\n";
            } else {
                copy $old,"$archive_dir/$oldname$oldsuffix" or warn "Cannot copy file $old to archive: $!\n";
            }
            chmod 0440,"$archive_dir/$oldname$oldsuffix" or warn "Cannot change permissions: $!\n";
        }
    }
    return ($newpath,$newname,$#files,$total_lines,$numcol+1,$blocknum-1,$archive_dir);
}

1;

__END__

=head1 NAME

Lab::Data::Writer - Write data to disk

=head1 SYNOPSIS

    use Lab::Data::Writer;
    
    my $writer=new Lab::Data::Writer($filename,$config);

    $writer->log_comment("This is my test log");

    my $num=$writer->log_start_block();
    $writer->log_line(1,2,3);

=head1 DESCRIPTION

This module can be used to log data to a file, comfortably.

=head1 CONSTRUCTOR

=head2 new

    $writer=new Lab::Data::Writer($filename,$config);

See L<configure> below for available configuration options.

=head1 METHODS

=head2 configure

    $writer->configure(\%config);

Available options and default values are

    output_data_ext     => "DATA",
    output_meta_ext     => "META",

    output_col_sep      => "\t",
    output_line_sep     => "\n",
    output_block_sep    => "\n",
    output_comment_char => "# ",

=head2 get_filename

    ($filename,$filepath)=$writer->get_filename()

=head2 log_comment

    $writer->log_comment($comment);

Writes a comment to the file.

=head2 log_line

    $writer->log_line(@data);

Writes a line of data to the file.

=head2 log_start_block

    $num=$writer->log_start_block();

Starts a new data block.

=head2 import_gpplus(%opts)

Imports GPplus TSK-files. Valid parameters are

  filename => 'path/to/one/of/the/tsk-files',
  newname  => 'path/to/new/directory/newname',
  archive  => '[copy|move]'

The path C<path/to/new/directory/> must exist, while C<newname> shall not
exist there.

=head1 AUTHOR/COPYRIGHT

This is $Id: Writer.pm 479 2006-08-11 09:25:07Z schroeer $

Copyright 2004-2006 Daniel Schröer (L<http://www.danielschroeer.de>)

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.