From 1de0752a14a24561487b12068e1870db3dbc7f30 Mon Sep 17 00:00:00 2001 From: Maps Date: Thu, 20 Nov 2014 22:43:40 +0100 Subject: [PATCH] quite some progress on background processes --- peltier_controller/webGUI/index.pl | 129 ++++++++++++++---- peltier_controller/webGUI/logging_tool.pm | 95 +++++++++++++ peltier_controller/webGUI/plotting_tool.pm | 68 +++++++++ .../webGUI/serial_communication.pm | 88 ++---------- peltier_controller/webGUI/shm | 1 + peltier_controller/webGUI/shm_manager.pm | 76 +++++++++++ 6 files changed, 359 insertions(+), 98 deletions(-) create mode 100644 peltier_controller/webGUI/logging_tool.pm create mode 100644 peltier_controller/webGUI/plotting_tool.pm create mode 120000 peltier_controller/webGUI/shm create mode 100644 peltier_controller/webGUI/shm_manager.pm diff --git a/peltier_controller/webGUI/index.pl b/peltier_controller/webGUI/index.pl index 395cb2f..65be60e 100755 --- a/peltier_controller/webGUI/index.pl +++ b/peltier_controller/webGUI/index.pl @@ -17,11 +17,14 @@ use CGI::Carp qw(fatalsToBrowser); 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(); @@ -32,12 +35,12 @@ sub new { 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 @@ -49,6 +52,10 @@ sub new { 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 @@ -57,18 +64,17 @@ sub main { # 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 @@ -90,22 +96,37 @@ sub main { -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 = @_; @@ -116,7 +137,67 @@ sub test { 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; } diff --git a/peltier_controller/webGUI/logging_tool.pm b/peltier_controller/webGUI/logging_tool.pm new file mode 100644 index 0000000..8d27720 --- /dev/null +++ b/peltier_controller/webGUI/logging_tool.pm @@ -0,0 +1,95 @@ +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 diff --git a/peltier_controller/webGUI/plotting_tool.pm b/peltier_controller/webGUI/plotting_tool.pm new file mode 100644 index 0000000..d34fdcb --- /dev/null +++ b/peltier_controller/webGUI/plotting_tool.pm @@ -0,0 +1,68 @@ +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 <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 @@ -120,17 +60,17 @@ sub communicate { 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); } diff --git a/peltier_controller/webGUI/shm b/peltier_controller/webGUI/shm new file mode 120000 index 0000000..0d99fd7 --- /dev/null +++ b/peltier_controller/webGUI/shm @@ -0,0 +1 @@ +/dev/shm \ No newline at end of file diff --git a/peltier_controller/webGUI/shm_manager.pm b/peltier_controller/webGUI/shm_manager.pm new file mode 100644 index 0000000..f400762 --- /dev/null +++ b/peltier_controller/webGUI/shm_manager.pm @@ -0,0 +1,76 @@ +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 -- 2.43.0