Lab::Measurement - Log, describe and plot data on the fly

  use Lab::Measurement;

  my $measurement=new Lab::Measurement(
      sample            => $sample,
      title             => $title,
      filename_base     => 'qpc_pinch_off',
      description       => $comment,

      live_plot         => 'QPC current',

      columns           => [
          {
              'unit'            => 'V',
              'label'           => 'Gate voltage',
              'description'     => 'Applied to gates via low path filter.',
          },
          {
              'unit'            => 'V',
              'label'           => 'Amplifier output',
              'description'     => "Voltage output by current amplifier set to $amp.",
          }
      ],
      axes              => [
          {
              'unit'            => 'V',
              'expression'      => '$C0',
              'label'           => 'Gate voltage',
              'min'             => ($start_voltage < $end_voltage) ? $start_voltage : $end_voltage,
              'max'             => ($start_voltage < $end_voltage) ? $end_voltage : $start_voltage,
              'description'     => 'Applied to gates via low path filter.',
          },
          {
              'unit'            => 'A',
              'expression'      => "abs(\$C1)*$amp",
              'label'           => 'QPC current',
              'description'     => 'Current through QPC',
          },
          {
              'unit'            => '2e^2/h',
              'expression'      => "(\$A1/$v_sd)/$g0)",
              'label'           => "Total conductance",
          },
          {
              'unit'            => '2e^2/h',
              'expression'      => "(1/(1/abs(\$C1)-1/$U_Kontakt)) * ($amp/($v_sd*$g0))",
              'label'           => "QPC conductance",
              'min'             => -0.1,
              'max'             => 5
          },

      ],
      plots             => {
          'QPC current'    => {
              'type'          => 'line',
              'xaxis'         => 0,
              'yaxis'         => 1,
              'grid'          => 'xtics ytics',
          },
          'QPC conductance'=> {
              'type'          => 'line',
              'xaxis'         => 0,
              'yaxis'         => 3,
              'grid'          => 'ytics',
          }
      },
  );

  $measurement->start_block();

  my $stepsign=$step/abs($step);
  for (my $volt=$start_voltage;$stepsign*$volt<=$stepsign*$end_voltage;$volt+=$step) {
      $knick->set_voltage($volt);
      usleep(500000);
      my $meas=$hp->read_voltage_dc(10,0.0001);
      $measurement->log_line($volt,$meas);
  }

  my $meta=$measurement->finish_measurement();

  $measurement=new Lab::Measurement(%config);

  sample        => '',  # see Meta
  title         => '',  # single line
  filename      => '',
  filename_base => '',  # for auto_naming
  description   => '',  # multi line

  columns       => [],
  axes          => [],
  plots         => [],  # See Meta

  live_plot     => '',  # Name of plot that is to be plotted live
  live_refresh  => '',
  live_latest   => '',

  writer_config => {},  # Configuration options for Lab::Data::Writer

  $block_num=$measurement->start_block($label);

  $measurement->log_line(@data);

  $meta=$measurement->finish_measurement();

  $now=$measurement->now_string();

#$Id: Measurement.pm 495 2006-08-14 15:46:01Z schroeer $

package Lab::Measurement;

use strict;
use warnings;
#use encoding::warnings;
use Data::Dumper;
use Lab::Data::Writer;
use Lab::Data::Meta;
use Lab::Data::Plotter;

our $VERSION = sprintf("0.%04d", q$Revision: 495 $ =~ / (\d+) /);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = {};
    bless ($self, $class);

    my %params=@_;
        #sample         => '',
        #title          => '',  # single line
        #filename       => '',
        #filename_base  => '',  # for auto_naming
        #description    => '',  # multi line
        #
        #columns        => [],
        #axes           => [],
        #plots          => {},
        #constants      => [],
        
        #live_plot      => '',
        #live_refresh   => '',
        #live_latest    => '',
        
        #writer_config  => {},

    # Filenamen finden
    if ($params{filename_base}) {
        my $fnb=$params{filename_base};
        my $last=(sort {$b <=> $a} grep {s/$fnb\_(\d+)\..*/$1/} glob "$fnb\_*")[0];
        $last=0 unless $last;
        $params{filename}=$fnb."_".(sprintf "%03u",$last+1);
    }

    my $desc_add=$params{filename}."; started at ".now_string()."\n";
    $desc_add =~ s/_/\\\\_/g;
    $params{description}.=$desc_add;

    # Writer erzeugen, Log öffnen
    my $writer=new Lab::Data::Writer($params{filename},$params{writer_config});
    # header schreiben
    $writer->log_comment("Sample $params{sample}");
    $writer->log_comment($params{title});
    $writer->log_comment($params{description});
    $writer->log_comment('Recorded with $Id: Measurement.pm 495 2006-08-14 15:46:01Z schroeer $');
        
    # Meta erzeugen
    my $meta=new Lab::Data::Meta({
        data_complete           => 0,
        sample                  => $params{sample},
        dataset_title           => $params{title},
        dataset_description     => $params{description},
        data_file               => ($writer->get_filename)[0].".".$writer->configure('output_data_ext'),
    });
    $meta->column($params{columns});
    $meta->axis($params{axes});
    $meta->plot($params{plots});
    $meta->constant($params{constants});
    my ($filename,$path,$suffix)=($writer->get_filename(),$writer->configure('output_meta_ext'));
    $meta->save("$path$filename.$suffix");
    
    # Liveplot starten
    if ($params{live_plot}) {
        my %options;
        if ($params{live_latest}) {
            $options{live_latest}=$params{live_latest};
        }
        $self->{live_plotter}=new Lab::Data::Plotter($meta,\%options);
        $self->{live_plotter}->start_live_plot($params{live_plot},$params{live_refresh});
    }
    
    $self->{writer}=$writer;
    $self->{meta}=$meta;
    
    return $self;
}

sub DESTROY {
    my $self=shift;
    if ($self->{writer}) {
        $self->finish_measurement();
    }
}

sub log_line {
    my $self=shift;
    $self->{writer}->log_line(@_);
    
    if ($self->{live_plotter}) {
        $self->{live_plotter}->update_live_plot();
    }
}

sub start_block {
    my ($self,$label)=@_;
    my $num=$self->{writer}->log_start_block();
    my $now=now_string();
    $self->{meta}->block_timestamp($num,$now);
    $self->{meta}->block_label($num,$label) if ($label);
    print "Started block $num at $now";
    print " ($label)" if ($label);
    print "\n";
}

sub finish_measurement {
    my $self=shift;
    $self->{meta}->data_complete(1);
    my ($filename,$path,$suffix)=($self->{writer}->get_filename(),$self->{writer}->configure('output_meta_ext'));
    $self->{meta}->save("$path$filename.$suffix");
    if ($self->{live_plotter}) {
        $self->{live_plotter}->stop_live_plot();
        delete $self->{live_plotter};
    }
    delete $self->{writer};
    return delete $self->{meta};
}

sub now_string {
    my ($sec,$min,$hour,$mday,$mon,$year)=localtime(time);
    return sprintf "%4d/%02d/%02d-%02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec;
}

#magisches Interface
sub log {
    my $self=shift;
    my ($datum,$column,$description)=@_;
    
    if ((defined $self->{magic_log}->{column}->[$column]->{status})
        && ($self->{magic_log}->{column}->[$column]->{status} eq 'fresh')) {
        #spalte enthält wert, der noch nicht geloggt worden ist
        unless ($self->{magic_log}->{started}) {
            #header müssen erst noch erzeugt werden
            $self->{magic_log}->{started}=1;
            my $cc=$self->{config}->{comment_char};
            my $nl=$self->{config}->{line_sep};
            my $header_text="$cc Data recorded by $0 on ".localtime(time).$nl;
            for (0..$#{$self->{magic_log}->{column}}) {
                $header_text.=sprintf("%s column %u: %s%s",$cc,$_,$self->{magic_log}->{column}->[$_]->{description},$nl);
            }
            print {$self->{Filehandle}} $header_text;
        }
        my $num_unfresh=0;
        # weiss nimmer was das soll
        for (@{$self->{magic_log}->{column}}) {
            if ($_->{status} eq 'set') {
                $num_unfresh++;
            }
        }
        
        #ist das die letzte Spalte?
        if ($column == $#{$self->{magic_log}->{column}}) {
            #ausgeben
            my $last_col=$#{$self->{magic_log}->{column}};
            $self->log_line(map{
                $self->{magic_log}->{column}->[$_]->{status}='set';
                $self->{magic_log}->{column}->[$_]->{datum}
            } (0..$last_col));
        } else {
        #   warn "Du Bauer hast irgendwas verbockt: $column $datum\n";
            $self->{magic_log}->{column}->[$column]->{status}='fresh';
            $self->{magic_log}->{column}->[$column]->{datum}=$datum;
        }           
    } else {
        #spalte momentan leer
        unless ($self->{magic_log}->{column}->[$column]->{status}) {
            $self->{magic_log}->{column}->[$column]->{description}=$description;
        }
        $self->{magic_log}->{column}->[$column]->{status}='fresh';
        $self->{magic_log}->{column}->[$column]->{datum}=$datum;
    }
}

1;

__END__