From 31931330a802acee1cecbec5c3e17170539e6859 Mon Sep 17 00:00:00 2001 From: Ronaldo Mercado Date: Wed, 26 May 2010 23:20:36 +0100 Subject: [PATCH 1/2] removing ezca strings mapping --- src/cap5/capr.pl | 98 +++++++++++++++++++++++++----------------------- 1 file changed, 52 insertions(+), 46 deletions(-) diff --git a/src/cap5/capr.pl b/src/cap5/capr.pl index c418a0f82..a445e55ad 100644 --- a/src/cap5/capr.pl +++ b/src/cap5/capr.pl @@ -17,13 +17,6 @@ use CA; ######### Globals ########## -my $hostArch; -if ( defined $ENV{"EPICS_HOST_ARCH"} ) { - $hostArch = $ENV{"EPICS_HOST_ARCH"} ; -} else { - $hostArch="solaris-sparc"; -} - our( $opt_h, $opt_d, $opt_f, $opt_r); my $theDbdFile; @@ -34,29 +27,29 @@ my $bIdx = 2; my %device = (); # Empty hash to record which rec types have device support my $DEBUG=0; # DEBUG -# EPICS field types referenced to their equivalent EZCA types +# EPICS field types my %fieldType = ( - DBF_STRING => "ezcaString", - DBF_BYTE => "ezcaByte", - DBF_CHAR => "ezcaByte", - DBF_UCHAR => "ezcaChar", - DBF_SHORT => "ezcaShort", - DBF_USHORT => "ezcaLong", - DBF_LONG => "ezcaLong", - DBF_ULONG => "ezcaDouble", - DBF_FLOAT => "ezcaFloat", - DBF_DOUBLE => "ezcaDouble", - DBF_ENUM => "ezcaString", - DBF_MENU => "ezcaString", - DBF_DEVICE => "ezcaString", - DBF_INLINK => "ezcaString", - DBF_OUTLINK => "ezcaString", - DBF_FWDLINK => "ezcaString", - DBF_NOACCESS => "ezcaNoAccess" + DBF_CHAR => "DBF_CHAR", + DBF_UCHAR => "DBF_CHAR", + DBF_DOUBLE => "DBF_FLOAT", + DBF_FLOAT => "DBF_FLOAT", + DBF_LONG => "DBF_LONG", + DBF_SHORT => "DBF_LONG", + DBF_ULONG => "DBF_LONG", + DBF_USHORT => "DBF_LONG", + DBF_DEVICE => "DBF_STRING", + DBF_ENUM => "DBF_STRING", + DBF_FWDLINK => "DBF_STRING", + DBF_INLINK => "DBF_STRING", + DBF_MENU => "DBF_STRING", + DBF_OUTLINK => "DBF_STRING", + DBF_STRING => "DBF_STRING", + DBF_NOACCESS => "DBF_NOACCESS", ); # globals for sub caget my %callback_data; +my %timed_out; my $callback_incomplete; my $cadebug = 0; @@ -69,9 +62,12 @@ HELP_MESSAGE() if $opt_h; if($opt_d) { # command line has highest priority $theDbdFile = $opt_d; } -elsif (exists $ENV{CAPR_DBD_FILE}) { # Use the env var if it exists - $theDbdFile = $ENV{CAPR_DBD_FILE}; +elsif (exists $ENV{EPICS_CAPR_DBD_FILE}) { # Use the env var if it exists + $theDbdFile = $ENV{EPICS_CAPR_DBD_FILE}; } # Otherwise use the default set above +elsif (exists $ENV{EPICS_BASE}) { + $theDbdFile = $ENV{EPICS_BASE} . "/dbd/softIoc.dbd"; +} else { die "No dbd file defined. ('capr.pl -h' gives help)\n"; } @@ -101,12 +97,15 @@ if($ARGV[0] =~ m/\s+\d/) { # If we replace comma with a space, } $ARGV[0] =~ s/\s+//; # Remove any spaces $ARGV[0] =~ s/\..*//; # Get rid of field name if it's there -$ARGV[1] = 0 unless defined $ARGV[1]; # default interest level is 0 -$ARGV[1] =~ s/\D//g; # Make sure we only use digits -$ARGV[1] = $ARGV[1] || 0; # interest defaults to 0 +if ( defined $ARGV[1] ) { + $ARGV[1] =~ s/\D//g; # Make sure we only use digits + $ARGV[1] = $ARGV[1] || 0; # blank => interest level set to 0 +} +else { + $ARGV[1] = 0; # interest defaults to 0 +} printRecord($ARGV[0], $ARGV[1]); # Do the do - ########## End of main ########### @@ -260,16 +259,17 @@ sub printField { $field = $fieldName . ":"; - if( $dataType eq "ezcaString" ) { + if( $dataType eq "DBF_STRING" ) { $outStr = sprintf("%-5s %s", $field, $fieldData); } elsif ( $base eq "HEX" ) { - $outStr = sprintf("%-5s %x", $field, $fieldData); - } elsif ( $dataType eq "ezcaDouble" || $dataType eq "ezcaFloat" ) { + my $val = ( $dataType eq "DBF_CHAR" ) ? ord($fieldData) : $fieldData; + $outStr = sprintf("%-5s %x", $field, $val); + } elsif ( $dataType eq "DBF_DOUBLE" || $dataType eq "DBF_FLOAT" ) { $outStr = sprintf("%-5s %.8f", $field, $fieldData); - } elsif ( $dataType eq "ezcaChar" ) { + } elsif ( $dataType eq "DBF_CHAR" ) { $outStr = sprintf("%-5s %d", $field, ord($fieldData)); }else { - # ezcaByte, ezcaShort, ezcaLong + # DBF_LONG, DBF_SHORT, DBF_UCHAR, DBF_ULONG, DBF_USHORT $outStr = sprintf("%-5s %d", $field, $fieldData); } @@ -306,6 +306,7 @@ sub caget { #clear results; %callback_data = (); + %timed_out = (); eval { CA->pend_io($wait); }; if ($@) { @@ -313,8 +314,7 @@ sub caget { my $err = (@chans > 1) ? 'some PV(s)' : "'" . $chans[0]->name . "'"; print "Channel connect timed out: $err not found.\n"; foreach my $chan (@chans) { - $callback_data{$chan->name} = "" - unless $chan->is_connected; + $timed_out{$chan->name} = ( $chan->is_connected ) ? 0 : 1; } @chans = grep { $_->is_connected } @chans; } else { @@ -366,7 +366,7 @@ sub printRecord { if($field eq "DTYP" && !(exists($device{$recType}))) { next; } ($fType, $fInterest, $base) = getFieldParams($recType, $field); - unless( $fType eq "ezcaNoAccess" ) { + unless( $fType eq "DBF_NOACCESS" ) { if( $interest >= $fInterest ) { $fToGet = $name . "." . $field; push @fields_pr, $field; @@ -383,9 +383,15 @@ sub printRecord { for (my $i=0; $i < scalar @readlist; $i++) { $field = $fields_pr[$i]; $fToGet = $readlist[$i]; - $data = $callback_data{$fToGet}; - $fType = $ftypes[$i]; - chomp $data; + if ( $timed_out{$fToGet} ) { + $fType = $fieldType{DBF_STRING}; + $data = ""; + } + else { + $fType = $ftypes[$i]; + $data = $callback_data{$fToGet}; + chomp $data; + } $col = printField($field, $data, $fType, $base, $col); } print("\n"); # Final line feed @@ -438,15 +444,15 @@ sub HELP_MESSAGE { " capr.pl [-d dbd_file] -f \n", " capr.pl [-d dbd_file] \n", "Description:\n", -" Attempts to perform a record print \"dbpr\" via channel access\n", -" for record_name at a given interest level.\n", -" The default interest level is 0.\n\n", +" Attempts to perform a 'dbpr' record print via channel access for record_name at a given\n", +" interest level. The default interest level is 0.\n\n", " If used with the f or r options, prints fields/record type lists.\n", "\n", "Options:\n", " -h: Help: Prints this message\n", " -d Dbd file: specify dbd file used to read record definitions.\n", -" If omitted, the environment variable CAPR_DBD_FILE must be defined\n", +" The default can be specified with the EPICS_CAPR_DBD_FILE environment\n", +" variable. The default file is \$(EPICS_BASE)/dbd/softIoc.dbd\n", " -r Prints the list of record types\n", " -f Prints list of fields, interest level, type and base for the\n", " given record type\n", From 07d51b65b249fd2c503643e315dd51508dae0149 Mon Sep 17 00:00:00 2001 From: Ronaldo Mercado Date: Wed, 26 May 2010 23:49:21 +0100 Subject: [PATCH 2/2] consistently use double quotes --- src/cap5/capr.pl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cap5/capr.pl b/src/cap5/capr.pl index a445e55ad..9519078e1 100644 --- a/src/cap5/capr.pl +++ b/src/cap5/capr.pl @@ -55,7 +55,7 @@ my $cadebug = 0; ######### Main program ############ -HELP_MESSAGE() unless getopts('hd:f:r'); +HELP_MESSAGE() unless getopts("hd:f:r"); HELP_MESSAGE() if $opt_h; # Select the dbd file to use @@ -69,7 +69,7 @@ elsif (exists $ENV{EPICS_BASE}) { $theDbdFile = $ENV{EPICS_BASE} . "/dbd/softIoc.dbd"; } else { - die "No dbd file defined. ('capr.pl -h' gives help)\n"; + die "No dbd file defined. (\"capr.pl -h\" gives help)\n"; } parseDbd($theDbdFile); @@ -217,7 +217,7 @@ sub getRecType { my $fields_read = caget( $name ); - if ( $fields_read != 1 ) { die "Record \"$_[0]\" not found\n"; } + if ( $fields_read != 1 ) { die "Could not determine \"$_[0]\" record type.\n"; } $data = $callback_data{ $name }; chomp $data; $data =~ s/\s+//; @@ -311,7 +311,7 @@ sub caget { eval { CA->pend_io($wait); }; if ($@) { if ($@ =~ m/^ECA_TIMEOUT/) { - my $err = (@chans > 1) ? 'some PV(s)' : "'" . $chans[0]->name . "'"; + my $err = (@chans > 1) ? "some PV(s)" : "\"" . $chans[0]->name . "\""; print "Channel connect timed out: $err not found.\n"; foreach my $chan (@chans) { $timed_out{$chan->name} = ( $chan->is_connected ) ? 0 : 1; @@ -444,7 +444,7 @@ sub HELP_MESSAGE { " capr.pl [-d dbd_file] -f \n", " capr.pl [-d dbd_file] \n", "Description:\n", -" Attempts to perform a 'dbpr' record print via channel access for record_name at a given\n", +" Attempts to perform a \"dbpr\" record print via channel access for record_name at a given\n", " interest level. The default interest level is 0.\n\n", " If used with the f or r options, prints fields/record type lists.\n", "\n",