#! /usr/bin/perl -w
# emg.pm = modul: společná část programů pro emg:
# version 0.48 oprava *EXPFILE
# doplněna dokumentace za konec souboru
package emg; # balík pro emgdb.pl
#use Exporter;
use Exporter ();
@ISA = qw(Exporter);
#@EXPORT_OK = qw($allcddir @database time2isodatetime isodate usec2timestr db_connect invfile expfilehdr);
#@EXPORT = qw($allcddir @database $EXPFILE time2isodatetime isodate usec2timestr timestr2usec
@EXPORT = qw($allcddir $outdir $gdfdir @database time2isodatetime isodate usec2timestr timestr2usec
db_connect invfile expfilehdr);
# $invstruct $expstruct $isodatetimefmt
use strict;
#use DBI;
#use Symbol;
#qualify ($dbh);
use Date::Format; # time2str()
my $dbname = 'emgdb';
my $hostname = 'localhost';
my $user = 'emg';
my $password = 'blablabla';
#$emg::allcddir = "../../CD/"; # directory of all CD-subdirs
$emg::allcddir = "../CD/"; # directory of all CD-subdirs
#$emg::allcddir = "/Data60G/huge/EMG/CD/";
$emg::outdir = "out/";
$emg::gdfdir = "/Data60G/huge/EMG/DebiandataGDF";
@emg::database = ("DBI:mysql:database=$dbname; host=$hostname", $user, $password);
#$emg::EXPFILE; # open handle of the file.exp
my $invstruct = # Ca = délka řetězce + max. délka:
'Ca15'. # rodné číslo+poj
'Ca8'. # datum narození
'Ca15'. # Jméno
'Ca15'. # Příjmení
'Ca8'. # datum vyšetření
'C'. # sex 0=male, 1=female
'C8'. # různá čísla, jako věk, výška atd.
'Ca15'. # číslo vyšetření a kdovíco (např: MFS konc2)
'Ca15'. # odd.: amb.
'Ca15'. # dg.: MFS trapez
#'C6'; # kdovíco na konci
'C2'. # 2 byte
'L'; # 4 byte = unsigned integer
# CELKEM: 1+15 + 1+8 + 1+15 + 1+15 + 1+8 + 1 + 8 + 1+15 + 1+15 + 1+15 + 6 =
# 16 + 9 + 16 + 16 + 9 + 1 + 8 + 16 + 16 + 16 + 6 = 6*16+3*9+6 = 96+27+6=129
my $expstruct =
'S'. # unsigned short $nchan počet kanálů
'S'; # unsigned short $sample_int_us vzorkovací interval v mikrosekundách
# dále následuje $nchan krát unsigned short $sensitivity[$ch] v [uV/Div]
# 1 Div = 409.6 AD-levels, neboť celý rozsah = 10 Div = 2 ** 12 = 4096 levels pro 12-bit A/D
# vzorkování: 20 kHz ... 50 us = 0x0032; 5 kHz ... 200 us = 0x00C8;
sub time2isodatetime {
my ($time) = @_;
# time2str($isodatetimefmt, $time);
time2str("%Y-%m-%dT%H:%M:%S", $time);
}
sub getstr { # get string from array: length, value
my ($ar) = @_; # array reference
my $len = shift @$ar; # délka stringu
substr (shift(@$ar), 0, $len);
}
sub isodate { # doplní pomlčky
my ($s) = @_;
substr($s,0,4).'-'.substr($s,4,2).'-'.substr($s,6,2);
}
sub usec2timestr { # převede mikrosekundy na string mm:ss.sssss
my($us) = @_;
my $sign = '';
if($us eq '--') {return $us}; # nedefinovaná hodnota
if($us < 0) {$sign = '-'; $us = -$us;}
my $sec = int($us/1000000); $us -= 1000000*$sec;
my $min = int($sec/60); $sec -= 60*$min;
sprintf ("%s%02d:%02d.%05d", $sign, $min, $sec, $us/10);
}
sub timestr2usec { # převete string mm:ss.sssss na us
my($_) = @_;
if(/(\d+):(\d+(\.d+)?)/){
1000000 * (60*$1 + $2);
} else { return undef;}
}
sub db_connect {
#my $dbh = DBI->connect($dsn, $user, $password, { PrintWarn=>1,RaiseError=>1,AutoCommit=>0 })
my $dbh = DBI->connect(@emg::database, { PrintWarn=>1,RaiseError=>1,AutoCommit=>0 })
or die "Chyba připojení k databázi č. $DBI::err: $DBI::errstr\n";
# uplatní se jen při RaiseError=>0
$dbh->do("SET NAMES `utf8`");
$dbh;
}
sub invfile { # přečte invfile a vrátí strukturu
my($invfile) = @_; # jméno souboru *.INV
$invfile = $emg::allcddir.$invfile;
my $buf;
my @inv;
unless(open INVFILE, $invfile){
print STDERR "Nemohu otevřít INV soubor $invfile: $!\n";
return ();
}
my $lengthoffile= read INVFILE, $buf, 200;
print("\n$invfile:\n\tnačteno:\t$lengthoffile B, délka bufferu ". length($buf) . "\n")
if $lengthoffile != 129;
@inv = unpack $invstruct, $buf;
my @fstat = stat(INVFILE);
my $mtime = time2isodatetime($fstat[9]);
my %inv = (
rc => getstr(\@inv), # rodné číslo+poj
birth => getstr(\@inv), # datum narození
name => getstr(\@inv), # Jméno
surname=> getstr(\@inv), # Příjmení
invdate=> getstr(\@inv), # datum vyšetření
sex => shift @inv, # sex 0=male, 1=female
n1 => shift @inv, # různá čísla, jako věk, výška atd.
n2 => shift @inv,
n3 => shift @inv,
n4 => shift @inv,
n5 => shift @inv,
n6 => shift @inv,
n7 => shift @inv,
n8 => shift @inv,
invcomm=> getstr(\@inv), # číslo vyšetření a kdovíco (např: MFS konc2)
depart => getstr(\@inv), # odd.: amb.
dg => getstr(\@inv), # dg.: MFS trapez
h1 => shift @inv, # kdovíco na konci
h2 => shift @inv,
#h3 => shift @inv,
#h4 => shift @inv,
#h5 => shift @inv,
#h6 => shift @inv,
t => shift @inv,
mtime => $mtime
);
close INVFILE;
return %inv;
}
sub expfilehdr { # přečte hlavičku EXP souboru
local (*EXPFILE) = @_; # handle otevřeného souboru .EXP
my $rv;
$rv = sysread(EXPFILE, my $buf, 4) or die "Nemohu číst z EXPFILE ($rv):$!:\n";
my ($nchan, $sample_int_us) = my @exphdr = unpack $expstruct, $buf;
$rv = sysread(EXPFILE, $buf, 2*$nchan) or die "Nemohu dočíst EXPFILE ($rv):$!:\n"; #Citlivosti kan.
push @exphdr, unpack 'S' x $nchan, $buf;
@exphdr;
}
1;
__END__
Export file format
------------------
The *.EXP file is binary.
Each item is stored in two bytes (Integer), i.e. 16-bit, lower endian (i.e. lower byte goes first)
The abbreviation nchan = Number of used input (acquired) channels.
NOTE that processing channels are not exported.
Items Usage (i.e. 16-bit numbers from beginning of the file):
Offset: Explanation:
0: Number of channels
1: Sample interval in [μsec/AD], i.e. time between samples. Common for all channels.
2..(1+nchan): Input sensitivity in [μV/Div] for each channel. 1 Div = 409.6 AD-levels (12bit = 4096 / 10 Div).
(2+nchan+1)..End of file:
Samples multiplexed (2 channel example):
Channel1-Sample1 (16-bit signed int)
Channel2-Sample1
Channel1-Sample2
Channel2-Sample2
etc.
NOTE Values are in the range ±2047, which corresponds to ±5 Div.
Common example: Input sensitivity (i.e. gain) = 10 uV/Div
Then:
* full range -5 Div .. +5 Div corresponds -50 uV .. +50 uV
* 1 AD-level corresponds 100 uV/4096 = 0.0244140625 uV
---
Vzorkování 20 kHz, 4 kanály => 20*2*4 = 160 kB/s = 0.16 MB/s
160 kB/s * 60 s/min = 9.6 MB/min
