#!/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 = ; 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 = ; 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/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 () { 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 () { 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 () { 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 () { 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 () { 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 = ; } 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" . '
' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '', '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '' . "\n" . '
Input' . "\n" . '
Database:
' . "\n" . '
' . "\n" . popup_menu(-name=>'database', -onchange=>'submit()', -style=>'width: 100%; max-width: 50em;', -value=>[@dblist], -labels=>{%dblabels}) . '' . "\n" . '
' . "\n" . '
' . "\n" . '
Record:
' . "\n" . '
' . "\n" . '' . $srmenu . hidden(-name=>'record', -value=>$record) . '
' . "\n" . '
' . "\n" . '
Signals:
' . "\n" . '
' . popup_menu(-name=>'signal', -onchange=>'submit()', -value=>['all', @slist]) . "\n" . '
' . "\n" . '
' . '
Annotations:
' . "\n" . '
' . popup_menu(-name=>'annotator', -onchange=>'submit()', -value=>[@alist], -labels=>{%alabels}) . '
' . "\n" . '
Output' . "\n" . '
Length:
' . "\n" . '
' . radio_group(-name=>'tdur', -onchange=>'submit()', -value=>['10','60','3600','43200','e'], -labels=>{%dlabels}, -default=>'10') . '
' . "\n" . '
' . '
Time format:
' . "\n" . '
' . radio_group(-name=>'tfmt', -value=>['time/date', 'elapsed time', 'hours', 'minutes', 'seconds', 'samples'], -default=>'time/date') . '
' . "\n" . '
' . '
Data format:
' . "\n" . '
' . radio_group(-name=>'dfmt', -value=>['standard', 'high precision', 'raw ADC units'], -default=>'standard') . '
' . "\n" . '
Toolbox' . "\n" . '
' . popup_menu(-name=>'tool', -onchange=>'submit()', -value=>[@tlist], -labels=>{%tlabels}) . '
' . "\n" . '
Navigation' . "\n" . '
' . "\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=>'>>|') . '
' . "\n" . '
' . '
' . "\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" . '
' . "\n" . '
' . '
' . submit(-name=>'action', -value=>'Help') . "\n" . submit(-name=>'action', -value=>'About ATM') . "\n" . '
' . "\n" . '
' . "\n"; set_twindow(); if ($record) { print "
" . "\n"; show_navbar(); print "\n.
\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 "

Input

\n"; mod_show_map(); print "\n" . '' . "\n" . '
' . "\n" . 'Selected input:' . " 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 '' . "\n" . "" . "\n" . $dblabels{$database} . '
' . "\n"; # print "==== end show map l495
"; } 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 "

Output

"; # 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
"; } } # 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 () { if (/\> $database /) { print QFILE $_; if ($np > 0) { $pcksum = `cksum $plusfn | cut '-d ' -f1`; chomp($pcksum); print QFILE '
$database+ [$np] " . "" . "accepted from $database\n"; } if ($nm > 0) { $mcksum = `cksum $minusfn | cut '-d ' -f1`; chomp($mcksum); print QFILE '
$database- [$nm] " . "" . "rejected from $database\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 "

Navigation

\n

The rectangle shows the current observation window. Click on the arrow on either side to move it.

\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 ""; # vertical white bar, with width scaled? sets left margin.... print ""; if ($lbw > 0) { print ""; " width=\"$lbw\%\" height=21>"; } if ($tstart > 0) { print ""; } else { print " title=\"-$dlabels{$tdur}\">"; } } # print ""; if ($tstart + $dt < $tfinal) { print ""; } if ($rbw > 0) { print "\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 () { print $_; } close(FILE); } } # show_pre: open a file and print it with HTML escapes sub show_pre { if (open(FILE, $_[0])) { print "
";
	while () {
	    s//>/g;
	    print $_;
	}
	close(FILE);
	print "
"; } } 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; }