Uživatel:Kychot/emgdb.pl

Z Wikiverzity
Skočit na navigaci Skočit na vyhledávání
#! /usr/bin/perl -w
# emgdb.pl	databáze vyšetření
my $version = '0.48';         # gain -> table `bin`
#
#...:....|....:....|....:....|....:....|....:....|....:....|....:....|....:....|....:....|....:....|
# ../emgdb.pl  --verbose=4 --delpro=all --addpro=test.pro
# dokončen přesun podprogramů do modulu
# --delcomm

use strict;
use Getopt::Long;
use Pod::Usage;
use DBI;
use File::Copy;
use Fcntl;
use lib '/Data60G/huge/EMG/perl';
use emg;

# command line options:
my $verbose     = 0;
my $ev		= 0;		# list events
my $full	= 0;		# full list
my $fulltime	= 0;		# full list with full precision time
my $anal	= 0;		# analysis
my $recstop	= 0;		# print record stop
my $chp		= 0;		# analyze&print checkpoints

#globals
my $nchan		= undef;	# number of channels
my $sample_int_us 	= undef;      	# sampling interval [us]
my $sfreq		= undef;	# sampling frequency
my $last_duration 	= 0;		# trvání posledního záznamu v us
my $curr_binfilesize 	= 0;		# current binary_file size [Bytes]
my $calib               = 0;            # duration of the current calibration [s]
my $calib_us		= 1000000;	# calibration time [us]
my $last_chp_us		= undef;	# last checkpoint time [us]
my $last_chp_MB		= undef;	# last checkpoint MB
my $gdffilename         = undef;
my $gdfeventsbuf        = '';           # eventy ve formátu GDF event table
my $togdf		= undef;	# filename of GDF file converted to. default = '';

sub filesfromdir {		# returns sorted list of all files from this dir
    my ($dir) = @_;		# dirname relative to  $emg::allcddir
    $dir = $emg::allcddir . $dir;
    unless(opendir(DIR, $dir)){
        print STDERR "Nemohu otevřít adresář $dir: $!\n";
        return ();
    }
    my @files = readdir DIR;	# list of all files
    closedir DIR;
    sort grep(!/^[.:]/ && !/\.IN\$/, @files);	# vyhoď, co začíná tečkou či dvojtečkou,
    						# *.IN$ ignoruj a setřiď
}

sub printlist {		# vytiskne seznam do řádky; první v seznamu je separátor
    my $sep = shift @_;
    for my $item(@_) {print $sep.$item;}
}


sub togdf {		# converts EXP to GDF using exp2gdf
    my($inv, $ltr, $expfile) = @_;
    printf "inv=%s, ltr=%s,  expfile=%s\n", $inv, $ltr, $expfile;
    $expfile = $emg::allcddir . $expfile;

    my $gdffilename =  $togdf eq '' ?  $emg::gdfdir.'/'.$inv.$ltr.'-5k.gdf' : $togdf; # nebezpečná volba – při více souborech se to přepisuje
#    printf "\t%s => %s\n", $expfile, $togdf;
    my $cmd = sprintf "/usr/local/bin/exp2gdf -d 4 %s %s\n", $expfile, $gdffilename;
    print "\t$cmd";
    print `$cmd`;
}

sub dbload {    	# nacpe tabulky `invor` a `bin` do databáze podle adresáře souborů
#=========
  my $dbh = db_connect;  
  my $invor_insert= $dbh->prepare
	("INSERT INTO `invor` VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");# 18 polí
  my $bin_insert  = $dbh->prepare
	("INSERT INTO `bin` VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)");            # 13 polí

  my $fmt_r3 =	"   %-10s  %-10s  %-15s%-10s %3s  %1s  %3d %3d  %3d  %-15s  %-15s\n";
  my $fmt_r4 =       "%+15s  %-19s";
  printf "%14s", '';
  printf $fmt_r3, 'inv_date', 'birthdate','surname','name','age','x',1,6,7, 'inv_comment', 'dg';
  printf $fmt_r4, 'file', 'local_mtime';
  print "\n-------------------------------------------------------------------------------------------------------------------\n";

  for my $cd(&filesfromdir('')){		# projdu adresáře se všemi CD
    $cd =~ /\d+/;
    my $cdn = $&;				# číslo CD
    for my $exam(&filesfromdir($cd)){		# projdu adresáře s vyšetřeními na jednom CD
	my $inv_id = length($exam)<2 ? '1'.$exam : $exam;	# id vyšetření přidá 1
        printf "%-5s( %-5s):", $inv_id, $cd;
        my @files=&filesfromdir($cd.'/'.$exam);
        unless (@files) {
            printf " (%s  soubor %s není adresářem)\n", $cd, $exam;
            next;
        }
        my $invfilepathname = my $invfilename = '';
        for my $file(@files) {			# projdu vš. soubory kromě souborů '.IN$'
            if($file =~ /\.INV$/) {
                $invfilename=$file;
                $invfilepathname="$cd/$exam/$invfilename";
                last;
            }
        }
        if (!$invfilepathname) { print "\n   ????????.INV chybí!\n";}
        else {
            my %inv = invfile($invfilepathname); # načtu soubor.INV do hashe
            $invfilename =~ /\d*/;
            my $num = $&;
	    $inv{mtime} =~ /\d*/; my $inv_year = $&;
	    isodate($inv{birth}) =~ /\d*/; my $birth_year = $&;
            my $age = $inv_year - $birth_year;
            my $person = substr($inv{surname},0,3).substr($inv{name},0,1);
	    my $sex = $inv{sex} ? 'f' : 'm';
            my $height = $inv{n7};
            my $text; #undef $text;		# později pro vložení textu, nyní NULL
            my @values = (			# 17 polí
                $inv_id, $num, $cdn, $invfilename, $inv{mtime}, isodate($inv{invdate}),
                $age, $person, isodate($inv{birth}), $inv{surname}, $inv{name},
                $sex, $inv{n1} ,$inv{n6}, $height, $inv{invcomm},
                $inv{dg}, $text
            );
            printf $fmt_r3,  isodate($inv{invdate}), isodate($inv{birth}),
                    $inv{surname}, $inv{name}, $age, $inv{sex}, $inv{n1}, $inv{n6}, $inv{n7},
		    $inv{invcomm}, $inv{dg};
            printf $fmt_r4, $invfilename, $inv{mtime};
            print " n2 = $inv{n2};" if $inv{n2};
            print " n3 = $inv{n3};" if $inv{n3};
            print " n4 = $inv{n4};" if $inv{n4};
            print " n5 = $inv{n5};" if $inv{n5};
            print "\n";
            my $rv = $invor_insert->execute(@values);   #print "rv = '$rv'\n";
        }
        for my $somefile(@files) {			# projdu vš. soubory
            next if($somefile eq $invfilename);		# *.INV už jsme probrali
            printf "%+15s", $somefile;
            unless (open SOMEFILE, "$emg::allcddir$cd/$exam/$somefile") {
               print "  nelze otevřít $emg::allcddir$cd/$exam/$somefile\n";}
            else {
               $somefile =~ /(.*?)\.(.*)/; my $onlyname=$1; my $ext= $2;
	       $onlyname =~ s/ori$//;           # originální EXP soubory
	       my $invlabel = substr $onlyname, 0, -4;
	       my $num      = substr $onlyname, -4;
	       my $ltr	    = '-';		# letter = rozlišovací písmeno záznamu
               my @fstat = stat(SOMEFILE);
               my $mtime = time2isodatetime($fstat[9]);
               my $size = $fstat[7];
               undef $nchan;
               undef $sfreq;
	       my @gain;
	       my $gainstr = '';
               my $duration; undef $duration;
               my $comment;  undef $comment;
               if ($ext eq 'EXP'){		# EMG Export file
		   #$ltr = substr($invlabel,2); 	# rozliš. písmeno: normálně 3. znak labelu
		   #$ltr = substr($invlabel,-1) if $inv_id=~/^[1Z]/; #posl.znak labelu(bylo dřív)
		   $invlabel =~ /.*([A-Z])/; $ltr = $1 if $1;
		   $ltr = 'A' if $invlabel eq '2BCh'; 	# výjimka
		   $ltr = 'B' if $invlabel eq '2BSi'; 	# výjimka
		   $ltr = 'A' if $invlabel eq '2CSi'; 	# výjimka
		   my $expfilepathname = "$emg::allcddir$cd/$exam/$somefile";
#?                   open (EXPFILE, $expfilepathname)
#?                       or die "Nemohu otevřít EXP: $expfilepathname: $!\n";
                   ($nchan, $sample_int_us, @gain) = my @exphdr = expfilehdr(*SOMEFILE);
#?                   close EXPFILE;
                   # foreach my $item(@exphdr){print " $item,"}; print "\n";
                   $duration = int(($size-4-2*$nchan) * $sample_int_us / (2 * $nchan));
									# délka záz. [mikrosec.]
                   $sfreq = 1000000/$sample_int_us;
		   for my $item (@gain) {$gainstr .= "$item,";} chop $gainstr;
               }
               my @values = ($inv_id, $ltr, $somefile, $invlabel, $num, $ext, $mtime, $size,
                   $nchan, $sfreq, $gainstr, $duration, $comment);
               printf "  %19s %11d %2s %3s kHz %-20s %11s  %-7s\n", $mtime, $size,
                   $nchan?$nchan:'--', $sfreq?$sfreq/1000:'--', $gainstr,
		   $duration?usec2timestr($duration):'--',
		   $comment?$comment:'--';
	       #if($duration) {print "dur=$duration\n";}
               #foreach my $val(@values){print "\"$val\", ";} print "\n"; # debug
               my $rv = $bin_insert->execute(@values);  #print "rv = '$rv'\n";
               close SOMEFILE;
            }
        }
        print "\n";
    }
  }
  $invor_insert->finish;
  $bin_insert->finish;
  $dbh->disconnect;
} # dbload

sub add_comment {		# přidá komentáře do tabulky
#==============
  my ($COMMENTFILE) = @_;	# handle otevřeného souboru s komentáři
  my $dbh = db_connect;
  my $comm = $dbh->prepare("INSERT INTO `comm` (`inv`, `comment`) VALUES (?,?)");     # 2 pole
  while(<$COMMENTFILE>) {
    next if /^#/;
    chomp; my $inv = $_; my $text = '';
    if (length($inv)<2){$inv = ' '. $inv;}	# id vyšetření zarovná vpravo
    print "$inv:\n";
    while(<$COMMENTFILE>) {
      next if /^#/;
      last if /^$/;
      $text .= $_;
    }
    print $text;
    $comm->execute($inv, $text);
  }
  $dbh->disconnect;
}

my %ev = (
#   'press'       => 0,
    'record'      => 1,   # red full
#   'calib'       => 2,   # brown
#   'gain'        => 3,   # green-gray
    'signal'      => 4,   # orange
#   'breath'      => 6,   # cyan
    'motion'      => 7,   # violet
    'speech'      => 7,   # violet
    'disturbance' => 7,   # violet
    'other'       => 7,   # violet
    'picture'     => 8,   # yellow full
    'needle'      => 9,   # green
    'electrode'   => 9,   # green
    'mark'        => 9,   # green
#    '' => ,
);

my %attr = (
    'other'       => 0,
    'arm'         => 0,
    'sole'        => 1,
    'calf'        => 2,
    'HMS'         => 3,
    'paracocc'    => 4,
    'ang_costae5' => 5,
    'ang_costae6' => 5,
    'ang_costae'  => 5,
    'm_trapesius' => 6,
    'infraspinatus' => 7,
);

my %side = (
    'sin'        => 10,   # blue
    'dx'         => 20,   # red
);

sub add_protocol {			# přidá protokol do tabulky `event`
#===============
    my ($PROTOCOLFILE) = @_;		# handle otevřeného souboru s komentáři
    my $dbh = db_connect;
    my $form = "%3s/%1s %3s %3s %4s %7s %5s %7s %6s %5s %5s %5s %5s %3s  %-10s %-16s %-5s %-5s %-4s %s";
    #           inv/ltr  n  ev  typ t1s dts t2s  t1  dt  t2 MB1 MB2  ch  event  attr side value unit comment
    my $insert_event = $dbh->prepare("INSERT INTO `event`
	(`inv`,`ltr`,`n`,`ev`,`typ`,`t1s`,`dts`,`t2s`,`t1`,`dt`,`t2`,`MB1`,`MB2`,`ch`,`event`,`attr`,`side`,`value`,`unit`,`comment`)
 	VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");  # 20 columns
    my $evn;                                    # GDF event counter
#   my ($inv,$ltr,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment);  # předtím
    my ($inv,$ltr,$n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment);
    my ($date, $person, $expfile) = ('','','');
    while(<$PROTOCOLFILE>) {
	next if /^$/;				# prázdná řádka
        if (/^;/) {print; next;}		# ; = comment
	if(/^(\w+):\s+(.+)/) {			# identifikátor: (na začátku řádky, jinak by to byl event)
	    my ($id, $value) = ($1, $2);
	    for ($id) {
		if   ($_ eq 'investigation') {$inv     = $value;}
		elsif($_ eq 'date')          {$date    = $value;}
		elsif($_ eq 'person')        {$person  = $value;}
		elsif($_ eq 'letter')        {$ltr     = $value; $n = 0; $evn=0; $calib=0;}    # new EMG record
		elsif($_ eq 'expfile') {      $expfile = $value;
		    if ($verbose >= 2) {print "\n$inv/$ltr  $date  $person  $expfile:\n";}
		    if ($verbose >= 3) {printf $form."\n", 'inv','l','n','ev','typ','t1s','dts','t2s','t1','dt','t2',
			    'MB1','MB2','ch','event', 'attr','side','value','unit','comment';}
		}
		else {die "Neznámý identifikátor $_\n";}
	    }
	    next;
	}
	$n++;                                          # should be event line
	$t1s= $dts= $t2s= $t1= $dt= $t2= $MB1= $MB2= $ch= $event= $attr= $side= $value= $unit= $comment= undef;

sub hhmmss {         # převede čas na formát hh:mm:ss
    my ($t) = @_;
    if ($t =~ /(\d\d):(\d\d)/){
	return sprintf "00:%02d:%02d", $1, $2;
    } else {
	my $min = int($t / 60);
#	return printf "00:%02d:%06.3f\n", $min, $t - 60*$min;
#	return sprintf "00:%02d:%06.3f", $min, $t - 60*$min;
	return sprintf "00:%02d:%02d", $min, $t - 60*$min;
    }
}

sub flt {           # převede čas na float
    my ($time, $cal) = @_;     # $cal: jestli se přičte čas kalibrace
    my $t;
    if ($cal) {$cal = $calib;} else {$cal = 0;}
    if ($time =~ /(\d+):(\d+\.\d+)/) {
        return 60*$1 + $2 + $cal;
    } elsif ($time =~ /(\d+):(\d+)/) {
        return 60*$1 + $2 + $cal;
    } else {
        return $time;
    }
}
	if(/^(\S+)\s+(.*)/) {			       # event line with timepoint or timeinterval
	    my ($timefield, $eventfield) = ($1, $2);
	    #print "[$timefield|$eventfield]";
	    if ($timefield =~ /(\S+)-(\S+)/) {	       # - interval
		print "[$1|$2]";
		($t1,  $t2 ) = (hhmmss($1),     hhmmss($2));  $dt = undef;
		($t1s, $t2s) = (flt($1, 1), flt($2, 1));      $dts = $t2s - $t1s;
	    }
	    elsif ($timefield =~ /(\S+)\+(\S+)/) {     # + increment
		#print "[$1|$2]";
		($t1,  $dt ) = (hhmmss($1),     hhmmss($2)); $t2  = undef;
		($t1s, $dts) = (flt($1, 1), flt($2, 0));     $t2s = $t1s + $dts;
	    }
	    else {					# single timepoint
		#$t1 = ($timefield ne '~') ? hhmmss($timefield) : undef;	# ~
		#$t2 = $dt = undef;
		#$t1s = ($timefield ne '~') ? flt($timefield) : undef;	# ~
		#$t2s = $t1s; $dts = 0;
		#$t2s = $t1s; $dts = 0;
		if ($timefield ne '~') {
		    $t1 = hhmmss($timefield); $t1s = flt($timefield, 1);
		    $dts = 0;
		    $t2s = $t1s;
		}
	    }
	    if ($eventfield =~ s/\s*;(.*)//) { $comment = $1;}

	    my $orig_eventfield = $eventfield;

	    if ($eventfield =~ s/\s*~(\S+) \[MB\]//) {	# MB
		my $MB = $1;
		if($MB =~ /-/) {($MB1, $MB2) = ($`, $');}
		else {($MB1, $MB2) = ($MB, undef);}
	    }
	    if ($eventfield =~ s/\s*=(\S+) \[(\S+)\]//) {($value, $unit) = ($1, $2);}

	    if ($eventfield =~ s/\s*(sin|dx|med|bilat|left|right|central|middle)//) { # side:
		$side = $1;		                # left, right, atc: deprecated!
	    }
	    if ($eventfield =~ s/\s*\#(\S+)\s+//) {	# #channel_mumber
		$ch = $1;
	    }
	    if ($eventfield =~ s/\s*(\S+):\s*//) {	# event
		$event = $1;
	    }
	    $attr = $eventfield;			# the rest = attributes
#GDF
	    $typ = undef; 			#event type
	    if($event){
		if($event eq 'calib'){
		    $typ = 2;
		    unless($value){$value = 1;}               # default 1s
		    $t1s = $calib;
		    $dts = $value;
		    $t2s = $t1s+$dts;
		    $calib += $dts;
		    #print "{cal=$calib}";
		} else {
		    unless($t1) {goto NOEVENT;}
		    if($event eq 'electrode' && ($attr eq 'surface' || $attr eq 'coaxial')) {goto NOEVENT;}
		    unless($typ = $ev{$event}) {	# už se dál neanalyzuje
			if($event eq 'press') {
			    unless (defined($attr{$attr})) {print "$inv/$ltr, po $evn: press-chybí attr: '$attr' !!\n"; goto NOEVENT;}
			    unless (defined($side{$side})) {print "$inv/$ltr, po $evn: press-chybí sin/dx: '$side' !!\n"; goto NOEVENT;}
			    $typ = $attr{$attr} + $side{$side};
			}
			elsif($event eq 'breath' && $attr eq 'inspir') {$typ = 6;}
			elsif($event eq 'amplifier' && $attr eq 'gain') {$typ = 3;}
			else {goto NOEVENT;}
		    }
		}
	    }
	  NOEVENT:
	    if($typ) {$ev = ++$evn;}
	    else {$ev = undef;}
	    my ($howmuchch, @chanarray);
	    if($ch and ($howmuchch = scalar(@chanarray = split /,/, $ch)) > 1) {$evn += $howmuchch-1;}
#GDF-END
	    my @eventrecord =
	        ($inv,$ltr,$n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment);
											#20 vars
	    my $rv = $insert_event->execute(@eventrecord);

	    if ($verbose>=3) {
		if ($t1s) {$t1s = sprintf "%7.1f", $t1s;}
		if (defined($dts))  {$dts = sprintf "%5.1f", $dts;}
		if ($t2s) {$t2s = sprintf "%7.1f", $t2s;}
		@eventrecord =
	           ($inv,$ltr,$n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment);
		foreach my $item(@eventrecord) {$item='--' unless defined $item; $item=~s/^00://;}
		printf $form, @eventrecord;
		print ">$orig_eventfield" if $verbose>=6;
		print "\n";
		my $warns_ref = $dbh->selectall_arrayref("SHOW WARNINGS",{Slice=>{}});#arr.of hsh
		foreach my $warn ( @$warns_ref ) {
		    print "\t< $warn->{Level} $warn->{Code}: $warn->{Message} >\n";   #col. names
		}
		# Alternativní zápis (nemusíme znát názvy sloupců):
		# my $warns2_ref = $dbh->selectall_arrayref("SHOW WARNINGS");	# array of arrays
		# foreach my $wr ( @$warns2_ref ) {
		#    print "\t<! $wr->[0] $wr->[1]: $wr->[2] >\n";		# indexes
		# }
	    } else {				     	# warningy každopádně
		my $warns_ref = $dbh->selectall_arrayref("SHOW WARNINGS", {Slice=>{}});#arr of hsh
		foreach my $warn ( @$warns_ref ) {
		    print STDERR
		    "n=$n: $warn->{Level} $warn->{Code}: $warn->{Message} ($orig_eventfield)\n";
		}
	    }
	}
	else {die "Divný řádek '$_'\n";}
    }
    print $dbh->do("SHOW DATABASES");
    $dbh->disconnect;
}


my $fmt_inv =  "%-2s  (%4s)%5s  %-19s  %-4s %4s  %1s %3s  %3d %3d  %3d  %-15s  %-15s\n";
my @fmt_inv_title = ('in','CD  ','numb','mtime','Pers','birt','x','age',1,6,7,'comment','dg');
my $fmt_bin =  "%-2s/%1s  %-5s%4s  %-19s  %3s %13s %11s  %2s %6s  %-20s %11s  %-15s \n";
my @fmt_bin_title = ('in','x','lbl','numb','mtime','ext','filename','size','ch','sfreq', 'gain',
		     'min:sec   ','comment');
my $fmt_line = "-------------------------------------------------------------------------------------------------------------------\n";

sub list_invor {		# vypíše celou tabulku vyšetření `invor`
  my $dbh = db_connect;
  my $inv = $dbh->prepare("SELECT * FROM `invor` ORDER BY `num`");     # 17 polí
  $inv->execute();
  printf $fmt_inv, @fmt_inv_title; print $fmt_line;
  while(my @row = $inv->fetchrow_array) {
      my ($id, $num, $cdn, $invfile, $mtime, $date, $age, $pers, $birth, $name, $surname,
       $sex, $n1 ,$n6, $height, $comment, $dg, $text) = @row;
      $birth =~ /\d*/; $birth = $&;
      printf $fmt_inv, $id, $cdn, $num, $mtime, $pers, $birth, $sex, $age,
             $n1, $n6, $height, $comment, $dg;
  }
  $inv->finish;
  $dbh->disconnect;
}

sub list_bin {			# vypíše celou tabulku binárních záznamů `bin`
  my $dbh = db_connect;
  my $bin = $dbh->prepare("SELECT * FROM `bin` ORDER BY `mtime`");     # 8 polí
  $bin->execute();
  printf $fmt_bin, @fmt_bin_title; print $fmt_line;
  while(my @row = $bin->fetchrow_array) {
      foreach my $item(@row){if(! defined $item){$item = '--';}}

       my ($inv, $ltr, $filename, $invlabel, $numb, $ext, $mtime, $size, $nchan, $sfreq,
	   $duration, $comment) = @row;
       printf $fmt_bin, $inv, $ltr, $invlabel, $numb, $mtime, $ext, $filename, $size,
	      $nchan, $sfreq eq '--'?$sfreq:sprintf("%2s kHz", $sfreq/1000),
	      usec2timestr($duration), $comment;
       $last_duration = $duration;
  }
  $bin->finish;
  $dbh->disconnect;
}

sub events {			# operace nad tabulkou eventů, volá fce: event_print, event_compute
#=========
  my ($fce, @inv) = @_;		# odkaz na funkci a seznam vyšetření
  #printlist (' ', 'events=', @inv, ":\n");
  my $dbh = db_connect;
  my $event;
  if (@inv) {			# byl zadaný seznam?
    for my $inv(@inv) {
      if ($inv =~ m|(\S*)/(\S)|) {	# vyšetření/písmeno
        my ($invv, $ltr) = ($1, $2);
        #print "$inv = $invv / $ltr\n";
        $event = $dbh->prepare("SELECT * FROM `event` WHERE `inv`=? AND `ltr`=? ORDER BY `n`");
        $event->execute($invv, $ltr);
      } else {
        $event = $dbh->prepare("SELECT * FROM `event` WHERE `inv`=? ORDER BY `ltr`, `n`");
        $event->execute($inv);
      }
      &$fce($event);
    }
  } else {			# - jinak se zpracují všechny záznamy
    $event = $dbh->prepare("SELECT * FROM `event` ORDER BY `inv`, `ltr`, `n`"); # 8 polí
    $event->execute();
    &$fce($event);
  }
  $event->finish;
  $dbh->disconnect;
}

sub time_s {			# converts mm:ss -> sec
    my($ts) = @_;		# timestring ve tvaru mm:ss – odstraní hodiny a převede v případě žádosti na sekundy
    #print "[[$ts]]";
    if($ts =~  /(\d\d):(\d\d)/) {
	return 60*$1 + $2;
    } else {
	print "!!time-s($ts)";
	return 0;
    }
}

sub secs {
    my($time) = @_;
    sprintf "%04d", time_s($time)+$calib;
}

sub event_print {		# vypíše tabulku `event` podle
  my ($event) = @_;		# otevřeného handle pro čtení z tabulky `events`

  my $curr_inv=''; my $curr_ltr=''; my $curr_n='';
  $last_chp_us = $calib_us;
  $last_chp_MB = 0;
  #printf $fmt_bin, @fmt_bin_title; print $fmt_line;
  print "Výpis tabulky `event`:\n" if $verbose>=2;
  while(my @row = $event->fetchrow_array) {
#      foreach my $item(@row){if(! defined $item){$item = '--';}}
     # my ($inv,$ltr,$n,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment) = @row;
      my ($inv,$ltr,$n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment) = @row;
#printf "[[t1s %s, dts %s, t2s %s, side %s]]\n", defined($t1s) ? "defined($t1s)" : 'undef', defined($dts) ? "defined($dts)" : 'undef', defined($t2s) ? "defined($t2s)" : 'undef', defined($side) ? "defined($side)" : 'undef';

      if ($verbose>=8){
	  my @line=@row;
	  foreach my $item(@line){if(! defined $item){$item = '..';} $item .= ', ';}
	  print @line, "\n";
      }
      if($inv ne $curr_inv) {	# current investigation
          $curr_inv=$inv; $curr_ltr='';
          #printf $full ? "\ninvestigation:\t%s" : "\n%s ", $curr_inv;
          printf $full ? "" : " * %s", $curr_inv;
      }
      if($ltr ne $curr_ltr) { 	# current letter
          $curr_ltr=$ltr;
          #printf $full ?  "\nletter:\t\t%s\n" : " /%s", $curr_ltr;
          if($full) {print  "\n*** $curr_inv/$curr_ltr ***\n";}
	  else {
	      print " /$curr_ltr";
	      if($recstop or $chp) {print "\n";}
	  }
      }
      my $timestr='';	# timestring
      my $sstr='';      # secondsstring
      if($t1) {$t1=~s/^00://; $timestr.= "$t1";  $sstr.=secs($t1);} else {$timestr.= '~'; $sstr.='~';}
      if($dt) {$dt=~s/^00://; $timestr.= "+$dt"; $sstr.='+'.secs($dt);}
      if($t2) {$t2=~s/^00://; $timestr.= "-$t2"; $sstr.='-'.secs($t2);}
      my $MB = ''; if ($MB1) { $MB = $MB2 ? "$MB1-$MB2" : $MB1;}
      my $diff_p = '';			# difference percent
      if ($chp) {			# compute&print checkpoints
	  if ($MB1){
	      my $chp_us = timestr2usec($timestr);
	      if ($chp_us) {
		  #print "** timestr = $timestr, chp_us = $chp_us,";
		  $chp_us += $calib_us;
		  my $chp_interval_us = $chp_us - $last_chp_us;
		  #print " ** chp_us = $chp_us, last_chp_us = $last_chp_us, chp_interval_us = $chp_interval_us **\n";
		  my $chp_interval_MB = $MB1 - $last_chp_MB;
		  my $chp_interval_MB2us = int( $chp_interval_MB * 1000000 * $sample_int_us / (2 * $nchan));
		  $diff_p = sprintf (" %+.1f %% ", 100 * ($chp_interval_MB2us - $chp_interval_us)/$chp_interval_us);
		  unless ($full){
		      printf("%-10s %-12s  %-10s %-15s %-4s  %-1s %-1s %-1s\n",
			     $sstr, $timestr, , $event?"$event:":'', $attr, $side, $MB?"~$MB [MB]":'', $diff_p,  $comment?";$comment":'');
		  }
	      }
	  }
      }

      if($value) {$value = "=$value";}
      if ($full) {
#          printf("%-10s %-12s %-4s %-10s %-15s %-4s %5s %-5s %-1s %-1s %-1s\n",
#	         $sstr, $timestr, $ch?'#'.$ch:'', $event?"$event:":'', $attr, $side, $value,
#	         $unit?"[$unit]":'', $MB?"~$MB [MB]":'', $diff_p,  $comment?";$comment":'');
	  my $form;
	  #           inv/ltr  n  ev  typ t1s dts t2s  t1   dt   t2  MB1 MB2  ch  event  attr side value unit comment
	  if ($fulltime) {
	      $form = "%3s %3s %4s %10s %8s %10s  %5s %5s %5s  %5s %5s %3s %-6s: %-16s %-5s %-5s %-4s %s\n";
                     # n   ev  typ t1s  dts t2s   t1  dt  t2   MB1 MB2 ch  event attr side value unit comment
	      if (defined($t1s)) {$t1s = sprintf "%10.4f", $t1s;}
	      if (defined($dts)) {$dts = sprintf "%8.4f", $dts;}
	      if (defined($t2s)) {$t2s = sprintf "%10.4f", $t2s;}
	  } else {
	      $form = "%3s %3s %4s %7s %5s %7s  %5s %5s %5s  %5s %5s %3s %-6s: %-16s %-5s %-5s %-4s %s\n";
                     # n   ev  typ t1s dts t2s  t1  dt  t2   MB1 MB2 ch  event attr side value unit comment
	      if (defined($t1s)) {$t1s = sprintf "%7.1f", $t1s;}
	      if (defined($dts)) {$dts = sprintf "%5.1f", $dts;}
	      if (defined($t2s)) {$t2s = sprintf "%7.1f", $t2s;}
	  }
	  my @line = ($n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment);
	  #printf ($form, $n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment);
	  foreach my $item(@line){if(! defined $item){$item = '--';}}
	  printf $form, @line ;

      }

      if ($recstop and defined($event) and $event eq 'record' and $attr=~/stop/) {
          print " recstop = $timestr";
          if (my $recstop_us = timestr2usec($timestr)) {
              #printf " = %s us", $recstop_us;
              #printf ", čas bin. souboru  = %d", $last_duration;
	      my $recordtime_us = timestr2usec($timestr);
	      my $difference_us = $last_duration - $recordtime_us;
              printf ", odchylka času = %s = %+.2f %%",
	          usec2timestr($difference_us), 100*$difference_us/$recordtime_us;
	      if($MB1) {
		  my $binfilesizeMB = (int(($curr_binfilesize/100000)+0.5)/10);
		  print (", velikosti = $MB1 - $binfilesizeMB = ", $MB1 - $binfilesizeMB,  ' MB');
	      }
	      print "\n";
	      if($full) {print "\n";}
          }
      }
  }
  print "\n" unless $full;
}

sub event_compute {	# bude počítat něco s těmi eventy - zatím jen zkopírovaná fce event_print
  my ($event) = @_;
  my $curr_inv=''; my $curr_ltr=''; my $curr_n='';
  #printf $fmt_bin, @fmt_bin_title; print $fmt_line;
  print "Výpis tabulky `event`:\n" if $verbose>=2;
  while(my @row = $event->fetchrow_array) {
      foreach my $item(@row){if(! defined $item){$item = '';}}
      my ($inv,$ltr,$n,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment) = @row;
      print "$inv,$ltr,$n,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment\n"
          if $verbose>=3;
      if($inv ne $curr_inv) {$curr_inv=$inv; $curr_ltr=''; print "\ninvestigation:\t$curr_inv\n";}
      if($ltr ne $curr_ltr) {$curr_ltr=$ltr; print "\nletter:\t\t$curr_ltr\n";}	# current letter
      my $timestr='';
      if($t1) {$t1=~s/^00://; $timestr.= "$t1";} else {$timestr.= '~';}
      if($dt) {$dt=~s/^00://; $timestr.= "+$dt";}
      if($t2) {$t2=~s/^00://; $timestr.= "-$t2";}
      my $MB = $MB1.$MB2 ? "$MB1-$MB2" : '';
      if($value) {$value = "=$value";}
      printf("%-12s %-4s %-10s %-15s %-4s %5s %-5s %-1s %-1s\n",
	     $timestr, $ch?'#'.$ch:'', $event?"$event:":'', $attr, $side, $value,
	     $unit?"[$unit]":'', $MB?"~$MB [MB]":'', $comment?";$comment":'');
  }
}

sub list {
#=======
  my @invs = @_;	# list of investigations
  my $dbh  = db_connect;
  my $invor= $dbh->prepare("SELECT * FROM `invor` ORDER BY `num`, `inv`");              # 18 polí
  my $comm = $dbh->prepare("SELECT `comment` FROM `comm` WHERE `inv` = ? ORDER BY `n`");#  3 pole
  my $bin  = $dbh->prepare("SELECT * FROM `bin` WHERE `inv` = ? ORDER BY `inv`, `ltr`, `filename`");     #  8 polí

  $invor->execute();				# `invor` = vyšetření
  printf $fmt_inv, @fmt_inv_title;
  printf $fmt_bin, @fmt_bin_title;
  print $fmt_line;
  while(my @row = $invor->fetchrow_array) {
      my ($id, $num, $cdn, $invfile, $mtime, $date, $age, $pers, $birth, $name, $surname, 
       $sex, $n1 ,$n6, $height, $comment, $dg, $text) = @row;
      next if(@invs and not (grep /$id/, @invs));	# přeskočí všechny kromě vyžadovaných
      $birth =~ /\d*/; $birth = $&;
      my $cddirname = sprintf "CD%02d", $cdn;
      printf $fmt_inv, $id, $cddirname, $num, $mtime, $pers, $birth, $sex, $age,
             $n1, $n6, $height, $comment, $dg;

      $comm->execute($id);			# `comm` = comments
      while(my @row = $comm->fetchrow_array) {
          my($comment) = @row;
          print $comment;
      }

      $bin->execute($id);			# `bin` = binary file
      my @binlist = grep m|$id/|, @invs;
      while(my @row = $bin->fetchrow_array) {
	  foreach my $item(@row){if(! defined $item){$item = '--';}}
	  my ($inv, $ltr, $filename, $invlabel, $numb, $ext, $mtime, $size, $ch,
	      $sf, $gainstr, $duration, $comment) = @row;
          next if(@binlist and not (grep m|$inv/$ltr|, @binlist));	# přeskoč nevyžadované

	  $nchan = $ch;
	  $sfreq = $sf;
	  if($sfreq eq '--') {undef $sfreq;}
	  if($sfreq) {$sample_int_us = 1000000/$sfreq;} else {undef $sample_int_us;}
          $last_duration = $duration;
	  $curr_binfilesize = $size;

	  #print ">>> sfreq = $sfreq <<<";
	  printf $fmt_bin, $inv, $ltr, $invlabel, $numb, $mtime, $ext, $filename,
	         $size, $nchan, $sfreq ? sprintf("%2s kHz", $sfreq/1000) : '--', $gainstr,
		 usec2timestr($duration), $comment;
          if($ev) {events(\&event_print, "$inv/$ltr");}
	  if(defined $togdf && $ext eq 'EXP') { togdf($inv, $ltr, $cddirname.'/'.$id.'/'.$filename);}
      }
      #$bin->finish;
      print "\n";
  }
  #$invor->finish;
  $dbh->disconnect;
}


sub prtempl {		# protocol templates = udělá šablony pro protokoly
#============
  my @invs = @_;	# list of investigations
  my $dbh  = db_connect;
  my $invor= $dbh->prepare("SELECT * FROM `invor` ORDER BY `num`, `inv`");              # 18 polí
  my $bin  = $dbh->prepare("SELECT * FROM `bin` WHERE `inv` = ? ORDER BY `mtime`");     #  8 polí

  $invor->execute();				# `invor` = vyšetření
  while(my @row = $invor->fetchrow_array) {
      my ($id, $num, $cdn, $invfile, $mtime, $date, $age, $pers, $birth, $name, $surname, 
       $sex, $n1 ,$n6, $height, $comment, $dg, $text) = @row;
      next if(@invs and not (grep /$id/, @invs));	# přeskočí všechny kromě vyžadovaných
      $birth =~ /\d*/; $birth = $&;
      my $cddirname = sprintf "CD%02d", $cdn;

      my $invdate = substr($mtime,0,10);
      my $outfilename = $outdir.$id.'-'.$invdate.'.prt';

      unless (open(OUTFILE, '>', $outfilename)) {print STDERR "Neotevřu $outfilename pro zápis!\n"; next;}

      #print "$id, $cddirname, $num, $mtime, $pers, $birth, $sex, $age, $n1, $n6, $height, $comment, $dg \n";
      print OUTFILE "!TEMPLATE!\n$id\n$invdate\n$pers\n\n";
      print OUTFILE ";v. $version\n";
      print OUTFILE "%ang_costae\t5\n";

      $bin->execute($id);			# `bin` = binary file
      my @binlist = grep m|$id/|, @invs;
      while(my @row = $bin->fetchrow_array) {
	  foreach my $item(@row){if(! defined $item){$item = '--';}}
	  my ($inv, $ltr, $filename, $invlabel, $numb, $ext, $mtime, $size, $nchan,
	      $sfreq, $duration, $comment) = @row;
	  next unless($ext eq 'EXP');					# jen EXP soubory
          next if(@binlist and not (grep m|$inv/$ltr|, @binlist));	# přeskoč nevyžadované
	  #printf $fmt_bin, $inv, $ltr, $invlabel, $numb, $mtime, $ext, $filename,
	  #       $size, $nchan, $sfreq eq '--'?$sfreq:sprintf("%2s kHz", $sfreq/1000),
	  #	 usec2timestr($duration), $comment;
	  #print "$inv, $ltr, $invlabel, $numb, $mtime, $ext, $filename, $size, $nchan, $sfreq ", usec2timestr($duration)," $comment\n";
	  print OUTFILE "\n$ltr\n$filename\n";
          #$last_duration = $duration;
          #if($ev) {events(\&event_print, "$inv/$ltr");}
	  print OUTFILE <<"END";
\t\tafflicted:
%4chLRsc
%simons
~\t\t%gain 10
~\t\tposition: head right
~\t\tneedle: sin depth  mm
~\t\tneedle: dx depth  mm
~\t\tneedle: bilat depth  mm
00:00\t\trecord: start,localtime  CEST
\t     #
\t\tneedle: sin push,fascia
\t\tneedle: sin tautband,in
\t\tsignal: sin AP,vanished
\t\tsignal: sin coax,activity
\t     # signal: NPN
\t\tsignal: surface,both,AP
\t\t%stim1
\t\t%breath1 12
\t\tbreath: normal
\t\t%breath2 8
\t\tbreath: normal
\t\tmotion: head
\t\telectrode: sin surface,touch
\t\tneedle: sin move,fix
\t\tneedle: sin tautband,off
\t\tneedle: dx tautband,off
\t\tneedle: sin pull,off,!roof,blood
\t\tneedle: dx pull,off,!roof,blood
:\trecord: stop,localtime  CEST  MB
END
      }
      #$bin->finish;
      #print "\n";
      close OUTFILE;
  }
  #$invor->finish;
  $dbh->disconnect;
}


sub events2gdf_test100{         # zapíše tabulku eventů do gdfbufferu

    my $nev = 100;       # number of events
    my $sfreq = 5000;
    my $nev1 = $nev & 0xff;          # the lower significance byte
    my $nev2 = ($nev >> 8) & 0xff;   # the middel byte
    my $nev3 = ($nev >> 16) & 0xff;  # the higher byte

    my $gdfeventtblstruct =
    'C'.     # 8bit:  typ = 3
    'C3'.    # 24bit: NEV = number of events
    'f';     # 32bit float: sample rate

#    my $gdfeventitemstruct =
#    'L'.     # ULong=uint32: position (samples)
#    'S'.     # UShort: type
#    'S'.     # Ushort: channel
#    'L';     # ULong:  duration (samples)

    $gdfeventsbuf = pack $gdfeventtblstruct, 3, $nev1, $nev2, $nev3, $sfreq;

    my $evtype = 0;

    for(my $ev=0; $ev<$nev; $ev++){     # position
	$gdfeventsbuf .= pack 'L', $ev*$sfreq;
    }

    for(my $ev=0; $ev<$nev; $ev++){     # type
	$gdfeventsbuf .= pack 'S', $evtype++;
    }

    for(my $ev=0; $ev<$nev; $ev++){     #channel
	$gdfeventsbuf .= pack 'S', $ev%5;
    }

    for(my $ev=0; $ev<$nev; $ev++){     #duration
	$gdfeventsbuf .= pack 'L', 1000;
    }

}

sub events2gdf_test1 {         # zapíše tabulku eventů do gdfbufferu

    my $nev = 1;       # number of events
    my $sfreq = 5000;
    my $nev1 = $nev & 0xff;          # the lower significance byte
    my $nev2 = ($nev >> 8) & 0xff;   # the middel byte
    my $nev3 = ($nev >> 16) & 0xff;  # the higher byte

    my $gdfeventtblstruct =
    'C'.     # 8bit:  typ = 3
    'C3'.    # 24bit: NEV = number of events
    'f';     # 32bit float: sample rate

#    my $gdfeventitemstruct =
#    'L'.     # ULong=uint32: position (samples)
#    'S'.     # UShort: type
#    'S'.     # Ushort: channel
#    'L';     # ULong:  duration (samples)

    $gdfeventsbuf = pack $gdfeventtblstruct, 3, $nev1, $nev2, $nev3, $sfreq;

    my $evtype = 0;

    for(my $ev=0; $ev<$nev; $ev++){     # position
	$gdfeventsbuf .= pack 'L', 105*$sfreq;
    }

    for(my $ev=0; $ev<$nev; $ev++){     # type
	$gdfeventsbuf .= pack 'S', 4;
    }

    for(my $ev=0; $ev<$nev; $ev++){     #channel
	$gdfeventsbuf .= pack 'S', 2;
    }

    for(my $ev=0; $ev<$nev; $ev++){     #duration
	$gdfeventsbuf .= pack 'L', 10*$sfreq;
    }

}

sub event_gdf {		# připojí event-table za GDF soubor
  my ($event) = @_;
  my $curr_inv=''; my $curr_ltr=''; my $curr_n='';
  #printf $fmt_bin, @fmt_bin_title; print $fmt_line;

  my $sfreq = 5000;  # sampling frequency – default 5 kHz
  my $gdfeventtblstruct =
  'C'.     # 8bit:  typ = 3
  'C3'.    # 24bit: NEV = number of events
  'f';     # 32bit float: sample rate

  #    my $gdfeventitemstruct =
  #    'L'.     # ULong=uint32: position (samples)
  #    'S'.     # UShort: type
  #    'S'.     # Ushort: channel
  #    'L';     # ULong:  duration (samples)

  my $form1 = "%2d: %7.1f %5.1f %7.1f %2d  %04d";

  my @evnumber;
  my @position;	     # seconds
  my @type;
  my @channel;
  my @duration;      # seconds
  my $nev = 0;       # number of events
  $calib  = 0;

  while(1) {
      my @row = $event->fetchrow_array;
      my ($inv,$ltr,$n,$ev,$typ,$t1s,$dts,$t2s,$t1,$dt,$t2,$MB1,$MB2,$ch,$event,$attr,$side,$value,$unit,$comment) = @row;
      if(!@row or $inv ne $curr_inv or $ltr ne $curr_ltr) { # IT WILL BE A NEW EMG RECORD
	  if ($nev) {                              # the non-zero event table will be appended to the GDF file

	      printf ("---------%3d events:    t1s     dts  position  duration\n", $nev) if $verbose >=5;
	      if($verbose>=6){
		  my $form = "         %3d %4d %9.4f %7.4f %9d %9d\n";
		  for(my $e=0; $e<$nev; $e++){     # print
		      printf $form, $evnumber[$e], $type[$e], $position[$e], $duration[$e], $position[$e]*$sfreq, $duration[$e]*$sfreq;
		  }
	      }

	      my $nev1 = $nev & 0xff;          # the lower significance byte
	      my $nev2 = ($nev >> 8) & 0xff;   # the middel byte
	      my $nev3 = ($nev >> 16) & 0xff;  # the higher byte

	      $gdfeventsbuf = pack $gdfeventtblstruct, 3, $nev1, $nev2, $nev3, $sfreq;
#	      if($verbose >= 9) {printf "%0x  %0x  %0x  %0x\n",$ ,$ ,$ ,$ ;}
	      if($verbose >= 9) {printf "---------------------------\n%02x   %02x %02x %02x  %f->4byte_float\n",
				 3, $nev1, $nev2, $nev3, $sfreq ;}
	      #my $evtype = 0;

	      for(my $e=0; $e<$nev; $e++){     # position
		  $gdfeventsbuf .= pack 'L', my $tmp = (shift @position) * $sfreq + 1;      # position of the first sample is 1
		  if($verbose >= 9) {printf " %08x", $tmp;}
	      }
	      if($verbose >= 9) {print "\n";}
	      for(my $e=0; $e<$nev; $e++){     # type
		  $gdfeventsbuf .= pack 'S', my $tmp = shift @type;
		  if($verbose >= 9) {printf "     %04x", $tmp;}
	      }
	      if($verbose >= 9) {print "\n";}
	      for(my $e=0; $e<$nev; $e++){     #channel
		  $gdfeventsbuf .= pack 'S', my $tmp = shift @channel;
		  if($verbose >= 9) {printf "     %04x", $tmp;}
	      }
	      if($verbose >= 9) {print "\n";}
	      for(my $e=0; $e<$nev; $e++){     #duration
		  $gdfeventsbuf .= pack 'L', my $tmp = (shift @duration) * $sfreq;
		  if($verbose >= 9) {printf " %08x", $tmp;}
	      }
	      if($verbose >= 9) {print "\n---------------------------\n";}

	      my $gdffilename0 = "$emg::gdfdir/$curr_inv$curr_ltr-5k0.gdf";
	      -e $gdffilename0 or die "Neexistuje původní soubor gdffilename0";
	      my $gdffilename = "$emg::gdfdir/$curr_inv$curr_ltr-5k.gdf";
	      if(!(-e $gdffilename) or ((-s $gdffilename) != (-s $gdffilename0))) {
		  copy($gdffilename0, $gdffilename) or die "Nepodařilo se zkopírovat soubor: $!";
	      }
	      printf "%d bytes table >> %s\n\n", length($gdfeventsbuf), $gdffilename;
	      sysopen (GDFFILE, $gdffilename, O_WRONLY | O_APPEND) or die "Nelze otevřít \"$gdffilename\" pro navěšení: $!\n";
	      #print GDFFILE '';
	      print GDFFILE $gdfeventsbuf;
	      close(GDFFILE) or die "Nelze uzavřít \"$gdffilename\" po zápisu eventtable: $!\n";
	      my $command = "ls -l $emg::gdfdir/$curr_inv$curr_ltr*\n";
	      print $command;
	      print `$command`;
	      $nev    = 0;       # number of events
	      $calib  = 0;
	      @evnumber = @position = @type = @channel = @duration = ();
	  }
	  if(@row){
	      $curr_inv = $inv; $curr_ltr = $ltr;
	      print "\n========= $curr_inv/$curr_ltr ==========\n";
	  } else { last;}
      }
      if ($verbose>=3 and @row){
	  my @line = @row;
	  foreach my $item(@line){if(! defined $item){$item = '--';}}
	  my $form = "%2s/%s %3s %3s %4s %9s %7s %9s  %8s %8s %8s %5s %5s %4s %-5s %-16s %-5s %-5s %-4s %s\n";
	  printf $form, @line;
      }

#      my $timestr='';	# timestring
#      if($t1) {$t1=~s/^00://; $timestr.=  "$t1";} else {$timestr.= '~'}
#      if($dt) {$dt=~s/^00://; $timestr.= "+$dt";}
#      if($t2) {$t2=~s/^00://; $timestr.= "-$t2";}
#      my $MB = $MB1.$MB2 ? "$MB1-$MB2" : '';

#      my $ev=0; 			#event type
#      my ($pos, $dur, $typ, $cha);
      if($ev){
	  $nev++;
	  push @evnumber, $ev;
	  push @type,     $typ;
	  push @position, $t1s; #print "[[t1s=$t1s]]";
	  push @duration, $dts;
	  if($ch and $ch ne 'all'){        # for some channel only
	      my @chnls = split /,/,$ch;
	      push @channel, shift @chnls;
	      for my $otherch(@chnls){
		  $nev++;
		  push @evnumber, ++$ev;
		  push @type,     $typ;
		  push @position, $t1s;
		  push @duration, $dts;
		  push @channel, $otherch;
	      }
	      #print "[[$ch = jen něco: @chnls a_to: $channel[$nev]]]";
	  } else {                         # 0 = for all channels
	      #print "[[$ch = všechny]]";
	      push @channel, 0;
	      #printf $form1, $nev+1, $pos, $dur, $pos+$dur, $cha, $typ;
	  }
#	  print "nev=$nev, evnumber=$ev\n";
      } else {
#	  print "                                  ";
      }
#      my $evstr = $ev ? sprintf "%02d", $ev : '';
#      printf("%-10s %-2s  %-12s %-4s %-10s %-15s %-4s %5s %-5s %-1s %-1s\n",
#	     $sstr, $evstr, $timestr, $ch?'#'.$ch:'', $event?"$event:":'', $attr, $side, $value,
#	     $unit?"[$unit]":'', $MB?"~$MB [MB]":'', $comment?";$comment":'');

#      if($value) {$value = "=$value";}
#      printf("  %-12s %-4s %-10s %-15s %-4s %5s %-5s %-1s %-1s\n",
#	     $timestr, $ch?'#'.$ch:'', $event?"$event:":'', $attr, $side, $value,
#	     $unit?"[$unit]":'', $MB?"~$MB [MB]":'', $comment?";$comment":'');
  }
}


sub get_help {
    print <<'END';
emgdb.pl - skript pro údržbu MySQL databáze EMG vyšetření
Základní volby (alepoň jedna musí být uvedena):
 --help           tato nápověda
 --truncate       smaže tabulky `invor` (vyšetření) a `bin` (binární záznamy EMG)
 --load           projde adresáře CD s EMG soubory a uloží data do tabulek `invor` a `bin`
 --addcomm file   přidá komentáře ze souboru "file" 
 --delcomm        vymaže tabulku komentářů `comm`
 --addpro  file   přidá protokoly vyšetření ze souboru "file" do tabulky událostí
 --delpro=2B      vymaže vyšetření (např. 2B) z tabulky událostí
 --delpro=all     vymaže celou tabulku událostí
 --invor          vypíše tabulku `invor` = seznam vyšetření dle souborů *.INV
 --bin            vypíše tabulku `bin`   = seznam souborů s binárními záznamy EMG
 --events [inv]   vypíše tabulku `event` = tabulka všech EMG událostí
 --list   [inv]   vypíše tabulky `invor` a `bin` = seznam vyšetření a  binární záznamy EMG
 --prtempl [inv]  generuje šablony *.pr pro zápis protokolů
    kde:
    [inv] je volitelné oznčení vyšetření (případně s lomítkem) 
Doplňkové volby:
 --verbose=číslo   upovídané operace; číslo od 0 výše
 --ev              vypisuje eventy u volby --list
 --full            úplný výpis eventů
 --fulltime        úplný výpis eventů s časem v plné přesnosti
 --recstop         čas konce záznamu
 --anal            analýza u volby --list
 --gdfevents       otevře GDF file – append event table
 --togdf=gdffilename při list konvertuje do GDF (jméno souboru je volitelné; default=zkratka, 5 kHz)
END
}

################## MAIN ####################

#my $get_help=''; my $get_man='';
#my $dbtruncate=''; my $dbload='';
#my $commentfile=''; my $delete_comments=''; my $protocolfile=''; my $del_events;
#my $list_invor=''; my $list_bin=''; my $list_events=''; my $compute_events = '';
#my $list='';

my ($get_help, $get_man, $dbtruncate, $dbload, $commentfile, $delete_comments,
$protocolfile, $del_events, $list_invor, $list_bin, $list_events, $compute_events,
$list, $prtempl);

GetOptions (
    'help|?'     => \$get_help,
    'man'        => \$get_man,
    'truncate'   => \$dbtruncate,
    'load'       => \$dbload,
    'addcomm'    => \$commentfile,
    'delcomm'    => \$delete_comments,
    'addpro'     => \$protocolfile,
    'delpro=s'   => \$del_events,
    'invor'      => \$list_invor,
    'bin'        => \$list_bin,
    'events'     => \$list_events,
    'compute'    => \$compute_events,
    'list'       => \$list,
    'verbose=s'  => \$verbose,
    'ev'	 => \$ev,
    'gdfevents'  => \$gdffilename,
    'full'       => \$full,
    'fulltime'   => \$fulltime,
    'recstop'	 => \$recstop,
    'anal'       => \$anal,
    'prtempl'    => \$prtempl,
    'chp'        => \$chp,		# checkpoints
    'togdf:s'    => \$togdf,
    ) or pod2usage(1); 			# or pod2usage(2);

if ($get_help)  {get_help;}
#if($get_help)   {pod2usage(1);}
if($get_man)    {pod2usage(-exitstatus => 0, -verbose => 2);}

if($fulltime) {$full = 1;}   # --fulltime implikuje --full

if($dbtruncate) {
    my $dbh = db_connect;
    $dbh->do("TRUNCATE `invor`");
    $dbh->do("TRUNCATE `bin`");
    $dbh->disconnect;
    print "Tabulky `invor` a `bin` vyprázdněny\n";
}

if($del_events) {			# vymaže protokol z tabulky `event`
    my $dbh = db_connect;
    if($del_events eq 'all') {$dbh->do("TRUNCATE `event`");
			      print "Tabulka `event` vyprázdněna.\n";}
    else                     {$dbh->do("DELETE FROM `event` WHERE `inv`='$del_events'");}
    $dbh->disconnect;
}

if($dbload)     {dbload;}

if($commentfile) {
    unless (scalar(@ARGV)) {print "! Chybí zadání souboru s komentářem!\n\n"; get_help;}
    else {
	while (my $commentfile = shift @ARGV) {
	    open(my $COMMENTFILE, $commentfile) or die "Nelze otevřít \"$commentfile\": $!\n";
	    print ">>>>>Soubor komentářů: $commentfile>>>>>\n" if $verbose;
	    add_comment($COMMENTFILE);
	    close $COMMENTFILE;
	}
    }
}

if($delete_comments) {
    my $dbh = db_connect;
    $dbh->do("TRUNCATE `comm`");
    $dbh->disconnect;
    print "Tabulka `comm` byla vyprázdněna\n";
}

if($protocolfile)   {
    unless (scalar(@ARGV)) {print "! Chybí zadání souboru s protokolem!\n\n"; get_help;}
    else {
	while (my $protocolfile = shift @ARGV) {
	    open(my $PROTOCOLFILE, $protocolfile) or die "Nelze otevřít \"$protocolfile\": $!\n";
	    print "\n>>>>>Soubor protokolu: $protocolfile>>>>>\n" if $verbose;
	    add_protocol($PROTOCOLFILE);
	    close $PROTOCOLFILE;
	}
    }
}


if($list_invor)     {list_invor;}
if($list_bin)       {list_bin;}
if($list_events)    {events(\&event_print, @ARGV);}
if($compute_events) {events(\&event_compute, @ARGV);}
if($list)           {list(@ARGV);}
if($prtempl)        {prtempl(@ARGV);}

if($gdffilename){
    open (my $GDFFILE, ">>$gdffilename") or die "Nelze otevřít \"$gdffilename\": $!\n";
#    events2gdf();
    events(\&event_gdf, @ARGV);
#    print $GDFFILE $gdfeventsbuf;
    close($GDFFILE) or die "Nelze zavřít \"$gdffilename\": $!\n";
}


#use utf8;
__END__

=head1 NAME

emgdb - skript pro údržbu MySQL databáze EMG vyšetření

=head1 SYNOPSIS

emgdb [options]

emgdb --help

=head1 OPTIONS

=over 8

=item B<--help>

Tato nápověda.

=item B<--man>

Vypíše manuálovou stránku.

=item B<--truncate>

Smaže tabulky `invor` a `bin`.

=item B<--load>

Projde adresář s EMG soubory a uloží data do tabulek `invor` a `bin`.

=item B<--addcomm> I<file>

Přidá komentáře ze souboru I<file> do tabulky `comm`.

=item B<--delcomm>

Vymaže tabulku komentářů `comm`.

=item B<--addpro> I<file>

Přidá protokoly vyšetření ze souboru I<file> do tabulky `event`

=item B<--delpro=>I<inv>

Vymaže protokoly vyšetření I<inv> z tabulky událostí `event`

=item B<--delpro=all>

Vymaže celou tabulku událostí `event`

=item B<--invor>

Vypíše tabulku `invor` = databáze vyšetření dle originálních souborů *.INV

=item B<--bin>

Vypíše tabulku `bin`   = seznam souborů s binárními záznamy EMG

=item B<--events>

Vypíše tabulku `event`   = seznam souborů s binárními záznamy EMG

=item B<--list>

Vypíše tabulky `invor`, `bin`, `comm`   = seznam vyšetření a  binární záznamy EMG včetně komentářů

=item B<--verbose=>I<n>

Upovídané operace; I<n> je stupeň upovídanosti.

=back

=head1 DESCRIPTION

B<emgdb> je skript pro údržbu MySQL databáze EMG vyšetření.

=cut