use Data::Dumper;
use Pod::Usage;
use serial_communication;
+use plotting_tool;
+use logging_tool;
+use shm_manager;
+
# use manage_settings;
# use Switch;
-
my $self = this->new();
$self->main();
my $class = shift;
my %options = @_;
- my $self = {}; # put tons of default values here (if you wish);
-
- $self->{constants} = {
+ my $self = {
+ appName => "peltierControl",
+ tty => "/dev/ttyACM1",
+ baudrate => 115200,
+ }; # put tons of default values here (if you wish);
- };
-
$self = {
%$self,
%options
sub main {
# go to other methods from here
+
+
+ my $isHttpReq = $ENV{HTTP_USER_AGENT};
+ print header('text/plain') if $isHttpReq;
my $self = shift;
# receive CGI query
# go only to methods that are in the following dispatch table:
# if associated value is one, sub can be called via CGI
- $self->{dispatch} = {
- help => 1,
- test => 1,
- read_register => 1,
- write_register => 1,
- find_baseline => 1,
- signal_range => 1,
- count => 1
- };
+# $self->{dispatch} = {
+# help => 1,
+# test => 1,
+# get_serial_data => 1
+# };
# if method exists, execute it, if not complain and show help message
- if ($self->{dispatch}->{$action} ) {
+
+ # if dispatch table exists, only execute subs from dispatch table,
+ # else execute any subs
+ if ( not(defined($self->{dispatch})) or $self->{dispatch}->{$action} ) {
my $args = $self->CGI_parameters();
# here the corresponding method is called
-sub setup_serial {
- my $self = shift;
- # create new register IO object, with CGI parameters "tty" and "baudrate"
- my $regio_options = $self->CGI_parameters(items => ["tty","baudrate"]);
- $self->{serial} = regio->new(%$regio_options);
-}
sub help {
my $self = shift;
my $verbose = shift;
-# print "This is the help message!\n";
- pod2usage(verbose => $verbose);
+ print "This is the help message!\n";
+ # pod2usage(verbose => $verbose);
exit;
+}
+
+##################################################
+## Test routines ##
+##################################################
+
+
+
+sub test_shm {
+ my $self = shift;
+ $self->{shm_manager} = shm_manager->new(
+ shm => $self->{shm},
+ dataDir => $self->{dataDir}
+ );
+
+# $self->{shm_manager}->createShm();
+# $self->{shm_manager}->writeShm($self->CGI_parameters);
+# return $self->{shm_manager}->readShm();
+ return $self->{shm_manager}->existShm();
+
}
+
sub test {
my $self = shift;
my %options = @_;
print "key: $item\tvalue: ".$options{$item}."\n";
}
exit;
+}
+
+sub daemon_test {
+ daemonize();
+ sleep 20;
+ system("echo 'demon output' > /u/maps/daemon_out.txt");
+}
+
+
+sub die_test {
+ my $self = shift;
+
+ my $ttyID = $self->{tty};
+ $ttyID =~ s/^.*\///;
+ my $shm_manager = shm_manager->new(shmName => $self->{appName}."-".$ttyID );
+
+ $shm_manager->writeShm({ die => 1});
+
+}
+
+sub log_test {
+ my $self = shift;
+
+ my $ttyID = $self->{tty};
+ $ttyID =~ s/^.*\///;
+ my $shm_manager = shm_manager->new(shmName => $self->{appName}."-".$ttyID );
+ my $serial_communication = serial_communication->new(
+ tty => $self->{tty},
+ baudrate => $self->{baudrate}
+ );
+
+ my $logging_tool = logging_tool->new(
+ shm_manager => $shm_manager,
+ serial_communication => $serial_communication
+ );
+
+ $logging_tool->set_column_names(["temp","pid","setpoint"]);
+ $logging_tool->main(verbose => 1);
+
+
+
+}
+
+##################################################
+## daemon routines ##
+##################################################
+
+sub daemonize {
+ # chdir '/' or die "Can't chdir to /: $!";
+
+ defined(my $pid = fork) or die "Can't fork: $!";
+ if($pid){
+ print "this instance has terminated, the other one is a demon now\n";
+ exit;
+ }
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
+ open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
+ POSIX::setsid or die "Can't start a new session: $!";
+ umask 0;
}
--- /dev/null
+package logging_tool;
+
+
+use strict;
+use warnings;
+use POSIX;
+
+
+sub new {
+ my $class = shift;
+ my %options = @_;
+ my $self = {
+ column_names => ["x","y","z"],
+ delay => 2,
+ %options
+ };
+
+ die "logging tool must receive a serial_communication module instance\n"
+ unless defined($self->{serial_communication});
+ die "logging tool must receive a shm_manager module instance\n"
+ unless defined($self->{shm_manager});
+
+ bless($self, $class);
+}
+
+
+
+sub set_column_names {
+ my $self = shift;
+ $self->{column_names} = shift;
+ # as argument I expect a ref to an array
+}
+
+
+
+sub main {
+
+ my $self = shift;
+ my %options = @_;
+ my $verbose = $options{verbose};
+
+ my $now;
+ my $data;
+ my $shmHash;
+
+ my $shm_manager = $self->{shm_manager};
+
+ my $dataFile = $shm_manager->{dataFile};
+
+ my $serial = $self->{serial_communication};
+
+ unless($shm_manager->existShm()){
+ $shm_manager->createShm();
+ }
+
+
+ unless(-e $dataFile){
+ open(LOG,"> ".$dataFile);
+ print LOG "#time\t#".join("\t#",@{$self->{column_names}})."\n";
+ close(LOG);
+ }
+
+
+ LOGLOOP: while(1){
+
+ $shmHash = $shm_manager->readShm();
+
+
+ open(LOG,">> ".$dataFile);
+ $data = $serial->communicate();
+ $now = sprintf "%02d.%02d.%02d_%02d:%02d:%02d",(localtime)[3],((localtime)[4] +1),((localtime)[5] -100),(localtime)[2],(localtime)[1],(localtime)[0];
+ print LOG "$now\t";
+ print "$now\t" if $verbose;
+ for my $column_name (@{$self->{column_names}}) {
+ print LOG $data->{$column_name}."\t";
+ print $data->{$column_name}."\t" if $verbose;
+ }
+ print LOG "\n";
+ print "\n" if $verbose;
+ close(LOG);
+
+
+ for(my $i=0; $i<$self->{delay};$i++){
+ last LOGLOOP if($shmHash->{die}); #die when you are told to
+ sleep 1;
+ }
+
+ }
+
+
+}
+
+
+
+1;
\ No newline at end of file
--- /dev/null
+package plotting_tool;
+
+
+use strict;
+use warnings;
+use POSIX;
+
+
+sub new {
+ my $class = shift;
+ my %options = @_;
+ my $self = {
+ plotfile => "/dev/null",
+ datafile => "/dev/null",
+ last_n => "40",
+ title => "Temperature",
+ %options
+ };
+
+ bless($self, $class);
+}
+
+
+sub plot {
+
+ my $self = shift;
+ my %options = @_;
+
+ my $plotfile = $self->{plotfile};
+ my $datafile = $self->{datafile};
+ my $last_n = $self->{last_n};
+ my $title = $self->{title};
+
+ my $gnuplot = "/usr/bin/gnuplot";
+
+
+ open(GNUPLOT,"|$gnuplot");
+print GNUPLOT <<EOF;
+
+set style line 1 lc rgb '#8b1a0e' pt 1 ps 1 lt 1 lw 2 # --- red
+set style line 2 lc rgb '#5e9c36' pt 6 ps 1 lt 1 lw 2 # --- green
+
+set style line 11 lc rgb '#808080' lt 1
+set border 3 back ls 11
+set tics nomirror
+
+set style line 12 lc rgb '#808080' lt 0 lw 1
+set grid back ls 12
+
+set terminal gif size 800,600
+set output "$plotfile"
+set title "$title"
+set xdata time
+set timefmt "\%d.\%m.\%Y_\%H:\%M:\%S"
+set format x " \%H:\%M"
+set xtics rotate
+set ylabel "temperature in °C"
+set yrange [-20:30]
+plot "< tail -$last_n $datafile" using 1:2 title "p" w linespoints
+EOF
+ close(GNUPLOT);
+
+
+}
+
+
+
+1;
\ No newline at end of file
-# sub read {
-# my $self = shift;
-# my $addr = shift;
-# my $val = $self->communicate("R".chr($addr));
-# printf("response: %d\n",$val) if $self->{verbose};
-# return $val;
-# }
-#
-# sub write {
-# my $self = shift;
-# my $addr = shift;
-# my $value = shift;
-#
-# print "send addr:$addr value:$value\n" if $self->{verbose};
-#
-# my $byte3 = chr(int($value)>>24);
-# my $byte2 = chr((int($value)>>16)&0xFF);
-# my $byte1 = chr((int($value)>>8)&0xFF);
-# my $byte0 = chr(int($value)&0xFF);
-#
-# $self->communicate("W".chr($addr).$byte3.$byte2.$byte1.$byte0);
-# }
-
-
-# sub communicate {
-# my $self = shift;
-# my $command = shift;
-#
-# my $ack_timeout=0.5;
-# my $rstring;
-#
-# $self->{port}->are_match("");
-# $self->{port}->read_char_time(1); # avg time between read char
-# $self->{port}->read_const_time(0); # const time for read (milliseconds)
-# $self->{port}->lookclear;
-# $self->{port}->write("$command\n");
-#
-# my $ack = 0;
-#
-# my ($count, $a) = $self->{port}->read(12);# blocks until the read is complete or a Timeout occurs.
-#
-# if($a=~ m/R(.{4})/s) {
-# $rstring= $1;
-# $ack=1;
-# }
-#
-# if($ack){
-# # my $byte3 = ord(substr($rstring,0,1));
-# # my $byte2 = ord(substr($rstring,1,1));
-# # my $byte1 = ord(substr($rstring,2,1));
-# # my $byte0 = ord(substr($rstring,3,1));
-# # my $val = (($byte3<<24)|($byte2<<16)|($byte1<<8)|$byte0);
-# my $val = unpack('l',reverse pack('a4',substr($rstring,0,4)));
-# return $val;
-# } else {
-# print "no answer\n" if $self->{verbose};
-# }
-# }
-
-
sub communicate {
+ my $self = shift;
+ my $command = shift; # variable not used
- my $command = $_[0]; # variable not used
-
-
+ my $port = $self->{port};
$port->lookclear;
-
+ $port->write("$command\n") if defined($command);
# read what has accumulated in the serial buffer
my $pid;
my $setpoint;
- for (my $i = 0; ($i<200) ;$i++) {
+ for (my $i = 0; ($i<300) ;$i++) {
my $a = $port->lookfor;
- unless(defined($temp)){
- if( $a =~ m/Temperature = ([\+\-0-9\.]+) Celsius/) {
- $temp = $1;
- }
- } else {
- if( $a =~ m/PID Output = ([\+\-0-9\.]+)/) {
- $pid = $1;
- return ($temp,$pid);
- }
+ if( $a =~ m/Setpoint = ([\+\-0-9\.]+) Celsius/) {
+ $setpoint = $1;
+ }
+ if( $a =~ m/Temperature = ([\+\-0-9\.]+) Celsius/) {
+ $temp = $1;
+ }
+ if( defined($temp) and defined($setpoint) and $a =~ m/PID Output = ([\+\-0-9\.]+)/) {
+ $pid = $1;
+ last;
}
Time::HiRes::sleep(.01);
}
--- /dev/null
+/dev/shm
\ No newline at end of file
--- /dev/null
+package shm_manager;
+
+
+use strict;
+use warnings;
+use POSIX;
+
+use Storable qw(lock_store lock_retrieve);
+
+
+sub new {
+ my $class = shift;
+ my %options = @_;
+ my $self = {
+ %options
+ };
+
+ die "shm_manager must get an shmName" unless defined($self->{shmName});
+
+ $self->{shmFile} = "/dev/shm/".$self->{shmName};
+ $self->{dataDir} = $self->{shmFile}."_data";
+ $self->{dataFile} = $self->{dataDir}."/data";
+
+
+ bless($self, $class);
+}
+
+
+sub existShm {
+ my $self = shift;
+ return 1 if( -e $self->{shmFile} );
+ return 0;
+}
+
+sub createShm {
+ my $self = shift;
+ die "shm ".$self->{shmFile}." already exists!\n" if( -e $self->{shmFile} );
+
+ lock_store({},$self->{shmFile});
+ die "data directory ".$self->{dataDir}." already exists!\n" if( -e $self->{dataDir} );
+ mkdir $self->{dataDir};
+};
+
+
+sub deleteShm {
+ my $self = shift;
+ unlink $self->{shmFile};
+# unless (defined( $self->{plotDir} )){
+# $self->{plotDir} = $self->{shmFile}."_plots";
+# }
+ system("rm -rf ".$self->{dataDir});
+}
+
+sub readShm {
+ my $self = shift;
+
+ if ( -e $self->{shmFile} ){
+ return $self->{requests} = lock_retrieve($self->{shmFile});
+ } else {
+ die "shm does not exist!";
+ }
+}
+
+sub writeShm {
+ my $self = shift;
+ my $shmHash = shift;
+ if ( -e $self->{shmFile} ){
+ lock_store($shmHash,$self->{shmFile});
+ } else {
+ die "shm does not exist!\n";
+ }
+}
+
+
+
+1;
\ No newline at end of file
jspc29 / labtools.git / commitdiff