#!/usr/bin/perl -T
# file: ATM               G. Moody         19 February 2009
#			  Last revised:	     16 May 2017
# _____________________________________________________________________________
# PhysioBank's Automated Teller Machine
# Copyright (C) 2009-2012 George B. Moody
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# You may contact the author by e-mail (george@mit.edu) or postal mail
# (MIT Room E25-505A, Cambridge, MA 02139 USA).  For updates to this software,
# please visit PhysioNet (http://www.physionet.org/).
# _____________________________________________________________________________

use CGI qw/:standard/;
use CGI::Carp 'fatalsToBrowser';
use Cwd;
use File::Basename;
use File::Path;
use Readonly;
use Storable;
$ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
push @INC, '.'; # allow loading modules from the current directory

# All external programs invoked using exec by ATM or any of its modules must
# be defined here.
Readonly $BASH        => '/bin/bash';
Readonly $TAR         => '/bin/tar';
Readonly $ANN2RR      => '/usr/local/bin/ann2rr';
Readonly $ANNXML      => '/usr/local/bin/annxml';
Readonly $CONVERT     => '/usr/bin/convert';
Readonly $LWCAT       => '/usr/local/bin/lwcat';
Readonly $MIT2EDF     => '/usr/local/bin/mit2edf';
Readonly $PSCHART     => '/usr/local/bin/pschart';
Readonly $RDANN       => '/usr/local/bin/rdann';
Readonly $RDSAMP      => '/usr/local/bin/rdsamp';
Readonly $RRHIST      => '/usr/local/bin/rrhist';
Readonly $RRPLOT      => '/usr/local/bin/rrplot';
Readonly $SAMPFREQ    => '/usr/local/bin/sampfreq';
Readonly $SUMANN      => '/usr/local/bin/sumann';
Readonly $TIME2SEC    => '/usr/local/bin/time2sec';
Readonly $WFDBCAT     => '/usr/local/bin/wfdbcat';
Readonly $WFDB2MAT    => '/usr/local/bin/wfdb2mat';
Readonly $WFDBDESC    => '/usr/local/bin/wfdbdesc';
Readonly $WFDBMAP     => '/usr/local/bin/wfdbmap';
Readonly $WFDBSIGNALS => '/usr/local/bin/wfdbsignals';
Readonly $WFDBTIME    => '/usr/local/bin/wfdbtime';
Readonly $ZIP         => '/usr/bin/zip';

my $FILE = qr{(?:\w[-\w.]*)}; # valid file name
my $SUBDIR = qr{(?:\w[-\w.]*/)}; # valid subdirectory name

$ATM = lc(basename($0));

atm();

sub atm {
    read_param();
    read_dbinfo();
    read_rinfo();
    read_tlist();
    banner();
    show_form();
    show_output();
    footer();
}

# ------------------ functions invoked directly by atm() ---------------------

# read_param: read state variables used by this program
sub read_param {
    if (!param) {
	$action = 'Help';
    }
    else {
	# read form variables
	$tool = param('tool');
	($database) = (param('database') =~ m{^($SUBDIR*$FILE)$});
	($searchset) = (param('searchset') =~ m{^([A-Z]+[-+]*)$});
	$action = param('action');
	($rbase) = (param('rbase') =~ m{^($SUBDIR*$FILE?)$});
	($srecord) = (param('srecord') =~ m{^($SUBDIR*$FILE)$});
	$record = $rbase . $srecord;
	($annotator) = (param('annotator') =~ m{^($FILE)$});
	$signal_desc = param('signal');
	$sfreq = param('sfreq');
	($tstart) = (param('tstart') =~ m{^(\d*\.?\d*)$});
	($tdur) = (param('tdur') =~ m{^(\d*\.?\d*|e)$});
	($tfinal) = (param('tfinal') =~ m{^(\d*\.?\d*)$});
	$tfmt = param('tfmt');
	$dfmt = param('dfmt');
	($nbwidth) = (param('nbwidth') =~ m{^(\d+)$});
    }
}

# banner: start HTML output and print PhysioBank banner
sub banner {
    my $title='PhysioBank ATM';
    my %tags = ( 'http-equiv', 'Content-Type',
		 'content', 'text/html',
		 'charset', 'utf-8' );
    if ($database) { $title .= " ($database)"; }
    print header(-charset=>'utf-8'); #override default
    show_html("head0");
    show_html("menu");
    show_html("head2");
}

# read_dblist: read the list of PhysioBank databases and the lists of
# records and annotators associated with the selected database
sub read_dbinfo {
    my $i = 0;

    if ($ATM eq 'atm') {
	$DBLISTNAME = '/home/physionet/html/physiobank/database/DBS';
    }
    else {
	$DBLISTNAME = 'DBS';
    }
    if (open(DBS, $DBLISTNAME)) {
	@dblist = <DBS>;
	close(DBS);
    }
    else {
	@dblist = ('');
    }
    foreach $d (@dblist) {
	my @fields = split(/\t+/,$d);
	chop($fields[1]);
	if ($fields[0] =~ m{^($SUBDIR*$FILE)$}) {
	    $dblist[$i++] = $1;
	    $dblabels{$fields[0]} = $fields[1] . " (" . $fields[0] . ")";
	}
    }
    my $imax = $i;

    ($id) = (cookie('pbs_id') =~ /^([-A-Za-z0-9_.]{16,32})$/);
    if ($id) {	# add user's pbsearch results to list of databases
	$sindex = "/ptmp/atm/pbs/$id/index.html";
	if (open(SEARCHES, "<:utf8", $sindex)) {
	    @reslist = <SEARCHES>;
	    close(SEARCHES);
	}
	foreach $r (@reslist) {
	    my @fields = split(/\"/,$r);
	    my $tag = $fields[5];
	    @fields = split(/\S>/, $r);
	    my @labels = split(/<\//, $fields[3]);
	    $labels[0] =~ s/\&\#8745\;/AND/g;
	    $labels[0] =~ s/\&\#8746\;/OR/g;
	    $labels[0] =~ s/\&not\;/NOT/g;
	    $dblist[$i++] = $tag;
	    $dblabels{$tag} = "$tag \[$labels[0]\]";
	}
    }

    # now read the list of records belonging to $database
    $i = 0;
    foreach $d (@dblist) {
	if ($d eq $database) { last; }
	$i++;
    }
    if ($i < $imax) {   # we're looking at a database named in DBS
	@rlist = ();
	open LIST, '-|', "$WFDBCAT $database/RECORDS 2>/dev/null";
	while (<LIST>) {
	    if (/^(\w(?:[-\w.]|\/\w)*\/?)$/) {
		push @rlist, $1;
	    }
	}
	close LIST;

	set_record_in_db();
    }
    else {		# we're looking at a search result set
	if ($searchset ne $database) {  # we haven't seen it yet
	    $searchset = $database;
	    param('searchset'=>$searchset);
	}
    }
    if ($searchset) {
	if (open(SFILE, "/ptmp/atm/pbs/$id/$database")) {
	    @rlist = ();
	    while (<SFILE>) {
		if (/^(\w(?:[-\w.]|\/\w)*\/?)$/) {
		    push @rlist, $1;
		}
	    }
	    close(SFILE);

	    set_record_in_search();

	    $mfname = "/ptmp/atm/pbs/$id/$database-marks";
	    load_recmarks();
	    if ($action eq '+' || $action eq '-') {
		if ($marks{$record} ne $action) { save_recmarks(); }
	    }

	    # find the database of which $record is a member
	    $database = $dblist[0];  # the first one in DBS is the default
	    my $matchlen = 0;
	    foreach $d (@dblist) {
		if ($record =~ m/^$d/) {
		    my $len = length($d);
		    if ($len > $matchlen) {
			$database = $d;
			$matchlen = $len;
		    }
		}
	    }
	    # remove database prefix from $record
	    $rec = substr($record, $matchlen+1);
	    $record = $rec;
	    print "X-line224-record: $record\n";
	}
    }


    else {	# skip if we're looking at a search result
	# Now look for $rbase in @rlist.  If it's not there, set $rbase to
	# the value of the first entry in @rlist, and reset $tstart to 0.
	$i = 0;
	while (($i <= $#rlist) && ($rlist[$i] ne $rbase)) {
	    ++$i;
	}
	if ($i > $#rlist) {
	    $rbase = $rlist[0];
	    $tstart = 0;
	    param('tstart'=>$tstart);
	}
	
	# If $rbase ends in '/', it's a directory name.  In that case,
	# read the sublist of records if there is one.
	if ($rbase=~ /\/$/) {
	    @srlist = ();
	    open LIST, '-|', "$WFDBCAT $database/$rbase/RECORDS 2>/dev/null";
	    while (<LIST>) {
		if (/^(\w(?:[-\w.]|\/\w)*\/?)$/) {
		    push @srlist, $1;
		}
	    }
	    close LIST;
	
	    # Now look for $srecord in @srlist.  If it's not there, set
	    # $srecord to the value of the first entry in @srlist, set $record
	    # to $rbase/$srecord, and reset $tstart to 0.
	    $i = 0;
	    while (($i <= $#srlist) && ($srlist[$i] ne $srecord)) {
		++$i;
	    }
	    if ($i > $#srlist) {
		$srecord = $srlist[0];
		$record = $rbase . $srecord;
		$tstart = 0;
		param('tstart',$tstart);
	    }
	}
	else {
	    $record = $rbase;
	    $srecord = '';
	}
	param('record',$record);
    }

    # now read the list of annotators associated with $database
    @alist = ();
    $i = 0;
    open LIST, '-|', "$WFDBCAT $database/ANNOTATORS 2>/dev/null";
    while (<LIST>) {
	my @fields = split(/\t+/);
	chop($fields[1]);
	if ($fields[0] =~ /^($FILE)$/) {
	    $alist[$i++] = $1;
	    $alabels{$1} = $fields[1] . " (" . $fields[0] . ")";
	}
    }
    close LIST;
    # Now look for $annotator in @alist.  If it's not there, set $annotator to
    # the value of the first entry in @alist.
    $i = 0;
    while (($i <= $#alist) && ($alist[$i] ne $annotator)) {
	++$i;
    }
    if ($i > $#alist) {
	$annotator = $alist[0];
    }
}

# read_rinfo: read information about $record (the list of available signals,
#   the sampling frequency, and the duration)
sub read_rinfo {
    if ($record) {
	if ($signal_desc =~ /^(\d+)$/) {
	    $signal_num = $1;
	}
	elsif ($signal_desc eq 'all') {
	    $signal_desc = undef;
	}
	@slist = ();
	open LIST, '-|', "$WFDBSIGNALS $database/$record 2>/dev/null";
	while (<LIST>) {
	    chomp;
	    next if ($_ eq '');
	    push @slist, $_;
	    if ($_ eq $signal_desc and !defined $signal_num) {
		$signal_num = $#slist;
	    }
	}
	close LIST;
	if (defined $signal_num && $signal_num <= $#slist) {
	    $signal_desc = $slist[$signal_num];
	    param('signal', $signal_desc);
	}
	else {
	    $signal_num = $signal_desc = undef;
	    param('signal', 'all');
	}

	$sfreq = `$SAMPFREQ $database/$record 2>/dev/null`;
	($tfinal) = (`$TIME2SEC -r $database/$record e 2>/dev/null` =~ m{^(\d*\.?\d*)$});
	if ($tstart =~ /:/) {
	    ($tstart) = (`$TIME2SEC -r $database/$record $tstart 2>/dev/null` =~ m{^(\d*\.?\d*)$});
	}
    }
}

# read_tlist: read the list of available tools (plugins)
sub read_tlist {
    $tlistfile = 'Toolbox';
    if (open(TOOLS,$tlistfile)) {
	@tlist = <TOOLS>;
    }
    else {
	@tlist = ('');
    }
    $i = 0;
    foreach $t (@tlist) {
	@fields = ($t =~ /^(\w+)\s+(\S.*)$/);
	chomp($fields[1]);
	$tlist[$i++] = $fields[0];
	$tlabels{$fields[0]} = $fields[1];
    }
    # Now look for $tool in @tlist.  If it's not there, set $tool to "Help".
    $i = 0;
    while (($i <= $#tlist) && ($tlist[$i] ne $tool)) {
	++$i;
    }
    if ($i > $#tlist) {
	$tool = "Help";
    }
    else {
	$tool = $tlist[$i]; # untaint
    }
}

# show_form: print the HTML form for collecting user input
sub show_form {
    %dlabels=('10', '10 sec',
	      '60', '1 min',
	      '3600', '1 hour',
	      '43200', '12 hours',
	      'e', 'to end');

    if (@srlist) {
	$srmenu =  popup_menu(-name=>'srecord',
			     -onchange=>'submit()',
			     -value=>[@srlist]); 
    }
    else {
	$srmenu = '';
    }

    print start_form;   # this is in the works....
    print "\n" . '<div class="atm">' . "\n" . '<table>' . "\n" . '<tr>' . "\n" . '<th rowspan="4">Input</th>' . "\n" . '<td>' . "\n" . 
	'<div class="left1">Database:</div>' . "\n" . '<div class="left">' . "\n" .
      popup_menu(-name=>'database',
		 -onchange=>'submit()',
		 -style=>'width: 100%; max-width: 50em;',
		 -value=>[@dblist],
		 -labels=>{%dblabels}) .
      '<noscript><input type="submit" name="action" value="Refresh" />' .
      '</noscript>' . "\n" . '</div>' . "\n" . '</td>' . "\n" . '</tr>',
      '<tr>' . "\n" . '<td>' . "\n" . '<div class="left1">Record:</div>' . "\n" . '<div class="left">' . "\n" .
      '<select name="rbase" onchange="submit()" style="width: 100%;">';
    for $rec (@rlist) {
	print '<option ';
	if ($rec eq $rselected) { print 'selected="selected" '; }
	print 'value="' . $rec . '">' . $rec;
	$m = $marks{$rec};
	if ($m) { print " $m"; }
	print "</option>\n";
    }
    print '</select>' . $srmenu . hidden(-name=>'record', -value=>$record) .
	'</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . '<td>' . "\n" . 
	'<div class="left1">Signals:</div>' . "\n" . '<div class="left">' .
	popup_menu(-name=>'signal',
		   -onchange=>'submit()',
		   -value=>['all', @slist]) .
		   "\n" . '</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . '<td>' .
		   '<div class="left1">Annotations:</div>' . "\n" . '<div class="left" >' .
	popup_menu(-name=>'annotator',
		   -onchange=>'submit()',
		   -value=>[@alist],
		   -labels=>{%alabels}) .
		   '</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . 
		   '<th rowspan="3">Output</th>' . "\n" . '<td>' . "\n" . 
		   '<div class="left1">Length:</div>' . "\n" . '<div class="left">' .
	radio_group(-name=>'tdur',
		    -onchange=>'submit()',
		    -value=>['10','60','3600','43200','e'],
		    -labels=>{%dlabels},
		    -default=>'10') .
		    '</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . '<td>' .
		    '<div class="left1">Time&nbsp;format:</div>' . "\n" . '<div class="left">' .
	radio_group(-name=>'tfmt',
		    -value=>['time/date', 'elapsed time', 'hours', 'minutes',
			     'seconds', 'samples'],
		    -default=>'time/date') .
		    '</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . '<td>' .
		    '<div class="left1">Data&nbsp;format:</div>' . "\n" . '<div class="left">' .
	radio_group(-name=>'dfmt',
		    -value=>['standard', 'high precision', 'raw ADC units'],
		    -default=>'standard') .
		    '</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' .
		    '<th rowspan="1">Toolbox</th>' . "\n" . '<td>' . "\n" . '<div class="left">' .
	popup_menu(-name=>'tool',
		   -onchange=>'submit()',
		   -value=>[@tlist],
		   -labels=>{%tlabels}) .
		   '</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . 
		   '<th rowspan="2">Navigation</th>' . "\n" . '<td>' . "\n" . '<div class="left">' . "\n" . 
        submit(-name=>'action', -value=>'|<<') . "\n" .
        submit(-name=>'action', -value=>'<<') . "\n" .
	submit(-name=>'action', -value=>'<') . "\n" .
	submit(-name=>'action', -value=>'*') . "\n" .
	submit(-name=>'action', -value=>'>') . "\n" .
	submit(-name=>'action', -value=>'>>') . "\n" .
	submit(-name=>'action', -value=>'>>|') .
	'</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '<tr>' . "\n" . '<td>' .
	'<div class="left">' . "\n" .
        submit(-name=>'action', -value=>'Previous record');
        if ($searchset) {
            print submit(-name=>'action', -value=>'-') . "\n" .
                  submit(-name=>'action', -value=>'+') . "\n";
        }
        else {
            print submit(-name=>'action', -value=>'-', -disabled) . "\n" .
                  submit(-name=>'action', -value=>'+', -disabled) . "\n";
        }
    print submit(-name=>'action', -value=>'Next record') . "\n" .
	'</div>' . "\n" . '</td>' . "\n" . '</tr>' . "\n" . '</table><!-- end table -->' .
	'<div style="text-align: center; width: 100%; border-top: 2px dotted #aaa; padding: .8em 0; ">' . 

        submit(-name=>'action', -value=>'Help') . "\n" .
        submit(-name=>'action', -value=>'About ATM') . "\n" .
 	'</div>' . "\n" . '</div><!-- end atm -->' . "\n";

    set_twindow();

    if ($record) { 
	print "<div role='navigation' style='white-space: nowrap;'>" . "\n";
	show_navbar(); 
	print "\n.</div>\n";
    }

    print hidden(-name=>'tstart',-value=>$tstart) . "\n" .
          hidden(-name=>'tfinal',-value=>$tfinal) . "\n" .
    	  hidden(-name=>'sfreq',-value=>$sfreq) . "\n" .
          hidden(-name=>'action',-value=>$action) . "\n";
    print end_form . "\n";

    if (!$database) { $action="Help"; }
    if ($record) {
	require show_map;
#   print "<h2>Input</h2>\n";
	mod_show_map();
	print "\n" . '<table style="background: #248; color: #fff; width: 100%; margin: 1em 0;">' . "\n" .
            '<tr><td align="left" style="padding: 0.5em 1em;">' . "\n" .
	    '<b>Selected input:</b>' . " record $database/$record" . "\n";
	if (defined $signal_num) { print " ($signal_desc)". "\n"; }
	if ($annotator) { print ", annotator $annotator" . "\n"; }
	print ", from ", timstr($tstart);
	if ($tend > 0) { print " to ", timstr($tend); }
	print '</td><td align="right" style="padding: 0.5em 1em;">' . "\n" .
	   "<a href=/physiobank/database/$database/ style='color: #fff'>" . "\n" .
	   $dblabels{$database} . '</a></td></tr></table>' . "\n";
#    print "==== end show map l495<br>";
    }

    if (!$database) { $action="Help"; }
    if (!$record) { $action="Help"; }
    if (!$tstart) { $tstart = 0; }
    if (!$tend) { $tend = "end"; }
    if (!$tfmt) { $tfmt = "seconds"; }
}

# show_output: if user requested output, acquire and print the data
sub show_output {
    if ($database && $record) {
#	print "<h2>Output</h2>";
	# Create the working directory for this request if it doesn't exist.
	$baseurl = "/atm/$database/$record";
	if (defined $signal_num) {
	    $baseurl .= "/S$signal_num";
	}
	if ($annotator) {
	    $baseurl .= "/$annotator";
	}
	$baseurl .= "/$tstart/$tdur";
	$baseurl =~ tr/ /_/;
	$basepath = "/ptmp/$baseurl";
	mkpath($basepath);
    }
    if ($action eq 'Help') { show_html("help"); $action = ""; }
    elsif ($action eq 'About ATM') { show_html("about"); $action = ""; }
    else {
	require "$tool.pm";

	$mod_tool = "mod_$tool";
	&$mod_tool();
#    print "--- end output<br>";

    }
}

# footer:  finish the page
sub footer {
    show_html("footer");
    print end_html;
}

# ------------ other functions needed by those above --------------------------

# set_record_in_db: check if $rbase is in @rlist, and reset to @rlist[0] if not
sub set_record_in_db {
    $recindex = 0;
    if ($rbase) {
	for $r (0..$#rlist) {
	    $recindex = $r;
	    if ($rbase eq $rlist[$recindex]) { last; }
	}
	if ($rbase ne $rlist[$recindex]) {
	    $recindex = 0;
	}
    }
    if ($action eq 'Next record' && $recindex < $#rlist) {
	++$recindex;
	$rbase = $rlist[$recindex];
	$srecord = '';
    }
    elsif ($action eq 'Previous record' && $recindex > 0) {
	--$recindex;
	$rbase = $rlist[$recindex];
	$srecord = '';
    }
    $rselected = $rbase;
    param('rbase'=>$rbase);
    param('srecord'=>$srecord);
}

# set_record: check if $record is in @rlist, and reset to @rlist[0] if not
sub set_record_in_search {
    $recindex = 0;
    if ($record) {
	for $r (0..$#rlist) {
	    $recindex = $r;
	    if ($record eq $rlist[$recindex]) { last; }
	}
	if ($record ne $rlist[$recindex]) {
	    $recindex = 0;
	}
    }
    if ($action eq 'Next record' && $recindex < $#rlist) {
	++$recindex;
    }
    elsif ($action eq 'Previous record' && $recindex > 0) {
	--$recindex;
    }
    $record = $rlist[$recindex];
    $rselected = $record;
    param('record'=>$record);
}

# load_recmarks: retrieve marks if available
sub load_recmarks {
    if (-e $mfname) {
	%marks = %{retrieve($mfname)};
    }
}

# save_recmarks: add mark (the value of $action) for $record to the mark file
sub save_recmarks {
    $marks{$record} = $action;
    store \%marks, $mfname;

    $ofurl = "/atm/pbs/$id";
    $ofdir = "/ptmp$ofurl";
    $minusfn = "$ofdir/$database-";
    $plusfn = "$ofdir/$database+";
    $qfname = "$ofdir/index.html";
    $tfname = $qfname . '~';
    $np = 0; $nm = 0;

    open MINUSFILE, '>', $minusfn;
    open PLUSFILE, '>', $plusfn;
    foreach $rec (sort keys %marks) {
	if ($marks{$rec} eq '-') { print MINUSFILE "$rec\n"; $nm++; }
	elsif ($marks{$rec} eq '+') { print PLUSFILE "$rec\n"; $np++; }
    }
    close MINUSFILE;
    close PLUSFILE;

    # update query results index
    rename $qfname, $tfname;
    open QFILE, '>', $qfname or die $!;
    if (open(TFILE, $tfname)) {
	while (<TFILE>) {
	    if (/\> $database /) {
		print QFILE $_;
		if ($np > 0) {
		    $pcksum = `cksum $plusfn | cut '-d ' -f1`;
		    chomp($pcksum);
		    print QFILE '<br><input type="checkbox" name="qrlist"' .
			" value=\"$database+\" /> $database+ [$np] " .
			"<a href=$ofurl/$database+?cksum=$pcksum>" .
			"accepted from $database</a>\n";
		}
		if ($nm > 0) {
		    $mcksum = `cksum $minusfn | cut '-d ' -f1`;
		    chomp($mcksum);
		    print QFILE '<br><input type="checkbox" name="qrlist"' .
			" value=\"$database-\" /> $database- [$nm] " .
			"<a href=$ofurl/$database-?cksum=$mcksum>" .
			"rejected from $database</a>\n";
		}
	    }
	    else {
		unless (/\> $database[-+] /) { print QFILE $_; }
	    }
	}
	close TFILE;
    }
    close QFILE;    
}

# set_twindow: reset $tstart and $tend if any navigation buttons were clicked
sub set_twindow {
    if (!$action || ($action eq 'Refresh')) {
	$tstart = 0;
	param('tstart'=>$tstart);
    }
    if ($action eq '|<<') { # return to the beginning of the record
	$tstart = 0;
	param('action'=>'*');
    }
    if ($action eq '<<') { # skip back by 1 minute, 6 minutes, or 6 hours
	if ($tdur eq 'e') { $tstart = 0; } # special case: back to start
	else { 
	    $tstart -= 6*$tdur;
	    if ($tstart < 0) { $tstart = 0; }
	}
	param('action'=>'*');
    }
    if ($action eq '<') { # skip back by 10 seconds, 1 minute, or 1 hour
	if ($tdur eq 'e') { $tstart = 0; } # special case: back to start
	else {
	    $tstart -= $tdur;
	    if ($tstart < 0) { $tstart = 0; }
	}
	param('action'=>'*');
    }
    if ($action eq '>') { # skip ahead by 10 seconds, 1 minute, or 1 hour
	if ($tfinal == 0 || ($tstart + $tdur) < $tfinal) {
	    $tstart += $tdur;
	}
	param('action'=>'*');
    }
    if ($action eq '>>') { # skip ahead by 1 minute, 6 minutes, or 6 hours
	if ($tfinal == 0 || ($tstart + 6*$tdur) < $tfinal) {
	    $tstart += 6*$tdur;
	}
	param('action'=>'*');
    }
    if ($action eq '>>|') { # skip to last window
	if ($tdur ne 'e') {
	    while ($tstart + $tdur < $tfinal) {
		$tstart += $tdur;
	    }
	}
	param('action'=>'*');
    }
    param('tstart'=>$tstart);
    if ($tdur eq 'e') {
	$dt = $tfinal - $tstart;
	$tend = $tfinal;
    }
    else {
	$dt = $tdur;
	$tend = $tstart + $tdur;
	if ($tend > $tfinal && $tfinal > 0) {
	    $tend = $tfinal;
	    $dt = $tfinal - $tstart;
	}
	param('action'=>'*');
    }
}

# show_navbar:  show the navigation bar
sub show_navbar {
    # $nbwidth (the width of the browser window in pixels) is determined using
    # jQuery whenever the ATM refreshes itself (see links-physiobank.html).
    # The value determined by jQuery is not available until the time of the next
    # refresh, so it is necessary to set $nbwidth to a non-zero default value
    # when the ATM is first opened.  Note also that window resizing is not
    # reflected in $nbwidth until after a refresh.
    if (!$nbwidth) { $nbwidth = 800; }
#    print "<h2>Navigation</h2>\n<p>The rectangle shows the current observation window.  Click on the arrow on either side to move it.</p>\n";
    print hidden(-name=>'nbwidth',-value=>$nbwidth);

    ($x) = (param('left_arrow.x') =~ /^(\d+)/);
    if ($x) { $action = '<'; set_twindow(); }
    ($x) = (param('right_arrow.x') =~ /^(\d+)/);
    if ($x) { $action = '>'; set_twindow(); }

    if ($tfinal <= 0) { return; }
    
    ($x) = (param('left_bar.x') =~ /^(\d+)/);
    if ($x) {
	$t = $x / (0.93 * $nbwidth) * $tfinal;
	if ($t > $tstart - $tdur) {
	    $tstart -= $tdur;
	    if ($tstart < 0) { $tstart = 0; }
	}
	if ($tdur > 43200) { $tstart = 43200 * int($t/43200); }
	elsif ($tdur > 3600) { $tstart = 3600 * int($t/3600); }
	elsif ($tdur > 60) { $tstart = 60 * int($t/60); }
	else { $tstart = 10 * int($t/10); }
	set_twindow();
    }
    ($x) = (param('right_bar.x') =~ /^(\d+)/);
    if ($x) {
	$t = ($x / (0.93 * $nbwidth) + 0.02) * $tfinal + $tstart + $tdur;
        if ($t < $tstart - $tdur) {
	    $tstart += $tdur;
	    if ($tstart >= $tfinal) { $tstart -= $tdur; }
	}
	if ($tdur > 43200) { $tstart = 43200 * int($t/43200); }
	elsif ($tdur > 3600) { $tstart = 3600 * int($t/3600); }
	elsif ($tdur > 60) { $tstart = 60 * int($t/60); }
	else { $tstart = 10 * int($t/10); }
	set_twindow();
    }

    my $lmw = 5;  # width of left margin of nav bar, in percent
    my $lbw = int(93*$tstart/$tfinal + .5);  # width of left scroll area
    my $obw = int(93*$dt/$tfinal + .5); # width of observation window
    my $rbw;

    if ($obw < 1) {
	$obw = 1;
	if ($lbw + $obw > 93) { $lbw = 93 - $obw; }
    }
    $rbw = 93 - ($lbw + $obw);  # width of right scroll area

    if ($tstart > 0) { # left arrow will be shown
	$lbw -= 2;  # make room for it
	if ($lbw < 0) { # put it in the left margin if necessary
	    $lmw += $lbw; $lbw = 0;
	}
    }
    if ($tstart + $dt < $tfinal) { # right arrow will be shown
	$rbw -= 2;	# make room for it
    }
    

#    print "<img src=/icons/wbar.png style='padding-left: 1em;' width=\"$lmw\%\" height=21>";
#  vertical white bar, with width scaled? sets left margin....
    print "<img src=/icons/wbar.png style='padding-left: 1em; margin: 0 auto; padding: 0;' width= \"$lmw\%\" height=21>";
    if ($lbw > 0) {
	print "<input type=image name=left_bar src=/icons/bbar.png",
	      " title=\"click on the line to move to that location\"",
#	      " width=\"$lbw\%\" height=21 style='border: 1px solid green;'>";
	      " width=\"$lbw\%\" height=21>";
    }
    if ($tstart > 0) {
	print "<input type=image name=left_arrow src=/icons/left.png",
	      " style='width: \"2\%\";' height=21";
#	      " width=\"2\%\" height=21";
	if ($tdur eq 'e') { print " title=\"to start\">"; }
	else { print " title=\"-$dlabels{$tdur}\">"; }
    }
#    print "<img src=/icons/obar.png width=\"$obw\%\" height=21",
    print "<img src=/icons/obar.png style='padding: 0;' width=\"$obw\%\" height=21",
    " title=\"current observation window -- click on either side to move it\">";
    if ($tstart + $dt < $tfinal) {
	print "<input type=image name=right_arrow src=/icons/right.png",
	      " width=\"2\%\" height=21 title=\"+$dlabels{$tdur}\">";
    }
    if ($rbw > 0) {
	print "<input type=image name=right_bar src=/icons/bbar.png",
	      " title=\"click on the line to move to that location\"",
	      " width=\"$rbw\%\" height=21>\n";
    }

}

# show_html: open a PhysioBank ATM HTML file and print it
sub show_html {
    show_file("/home/physionet/html/physiobank/atm/" . $_[0] . ".html");
}

# show_file: open a file and print it
sub show_file {
    if (open(FILE, $_[0])) {
	while (<FILE>) {
	    print $_;
	}
	close(FILE);
    }
}

# show_pre: open a file and print it with HTML escapes
sub show_pre {
    if (open(FILE, $_[0])) {
	print "<pre>";
	while (<FILE>) {
	    s/</&lt;/g;
	    s/>/&gt;/g;
	    print $_;
	}
	close(FILE);
	print "</pre>";
    }
}

sub timstr {
    my $ts = `$WFDBTIME -r $database/$record $_[0]`;
    $ts = substr($ts, 32, 25);
}

sub unique_id {
    require Digest::MD5;

    my $md5 = new Digest::MD5;

    # Note that this is intended to be unique, not unguessable.
    # It should not be used for generating keys to sensitive data.
    my $id = $md5->md5_base64(time, $$);
    $id =~ tr|+/=|-_.|;   # Make non-word characters URL-friendly
    return $id;
}