#!/usr/bin/perl

use Switch;

my $iocName = "cj" ;

my $inFileName   = "plcTagTest.csv";
my $outFileName  = "plc2epics_auto.db";


%hwList = (
    "AB:1756_IF16_Float_No_Alm:C" => "ai",
    "AB:1756_IF16_Float_No_Alm:I" => "ai",
    "AB:1756_IF16_Float_No_Alm:O" => "ai",

    "AB:1756_DI:C"                => "bi",

    "AB:1756_DO:C"                => "bi",

    "AB:1734_OE4:C"               => "ai",
    "AB:1734_OE4:I"               => "ai",
    "AB:1734_OE4:0"               => "ai",

    "AB:1756_IF16_Float_No_Alm:C" => "ai",
    "AB:1756_IF16_Float_No_Alm:I" => "ai",
    "AB:1756_IF16_Float_No_Alm:O" => "ai",

    "AB:1756_IF8_Float:C"         => "ai",
    "AB:1756_IF8_Float:I"         => "ai",
    "AB:1756_IF8_Float:O"         => "ai",
    );
%tagList = &readCsvFile( $inFileName );

print "\n";

#&printDebug( %tagList );

print "\n";

&makeDB( $outFileName,  %tagList );




#print "Position is at " , index("BOOL[5]", '8') ,  "\n";

#my $checkString = 'BOOL[125]';
#my $checkBool = $checkString =~ m/^\D{1,6}\[\d{1,}\]$/ ;

#print  "Match check is $checkBool \n";



###############################################################################

sub readCsvFile {
    local ( $plcFileName ) = @_;
    
    open( CSV_FILE, "$plcFileName" )  or die "Could not open input file $plcFileName \n" ;
    
    my $iLine = 0;
    my %plcTagList = () ;
    
    while ( my $Line = <CSV_FILE>  ) {
	chop $Line; 
#    print "Reading line $Line \n";
	if ( $Line eq "" ) { last ; }
	$Line =~ s/\"//g;

	my @Fields = split(/\,/, $Line ) ;
	my $plcTag = {};
	
#    print $Fields[0], $Fields[1], $Fields[2], $Fields[5] , "\n";
	
	$plcTag->{"clas" }   = $Fields[0];
	$plcTag->{"scope"}   = $Fields[1];
	$plcTag->{"name" }   = $Fields[2];
#	$plcTag->{"desc" }   = $Fields[3];
	$plcTag->{"type" }   = $Fields[4];
	$plcTag->{"refer"}   = $Fields[5];
	$plcTag->{"attr" }   = $Fields[6];
	
	my $tagName = $plcTag->{"name"} ;
	if( $plcTag->{"scope"} ne "" ) {
	    $tagName =  $plcTag->{"scope"} . "." . $plcTag->{"name"};
	}
#    print $plcTag->{"name"}, "\n";
	
	$plcTagList{$tagName} = $plcTag; 
#    print $plcTagList{$tagName}{"name"} , "\n";
	my $tmpList = $plcTagList{$tagName};
#    print $tmpList->{"name"}, "\n";
    }
    close ( CSV_FILE );
    %plcTagList;
}



sub makeDB {
    local ( $dbFileName, %plcTagList ) = @_ ;
    
    open( DB_FILE , ">$dbFileName"  )  or die "Could not open output file $dbFileName  \n" ;

    print "Making DB file $dbFileName \n";

    foreach $tagName ( sort keys %plcTagList ) { 
	my $dbName = $iocName . ":" . 
	    $plcTagList{$tagName}{"scope"} .  ":" . 
	    $plcTagList{$tagName}{"name"}; 
	my $plcName;
	if( $plcTagList{$tagName}{"scope"} ne "" ) {
	    $plcName = "Program:" . $plcTagList{$tagName}{"scope"} . "." .
		$plcTagList{$tagName}{"name"};
	} else {
	    $plcName = $plcTagList{$tagName}{"name"};
	}


	my $dbName = '$(IOC)'; 
	if( $plcTagList{$tagName}{"scope"} ne "" ) {
	   $dbName .= ":" . $plcTagList{$tagName}{"scope"}  . ":"  .
	       $plcTagList{$tagName}{"name"};
	} else {
	    $dbName .= ":"  .  $plcTagList{$tagName}{"name"};
	}

	my $tagScope = $plcTagList{$tagName}{"scope"};

	print "$tagName : plcClas  is $plcTagList{$tagName}{'clas'} , " .
	    "plcRef is  $plcTagList{$tagName}{'refer'}  \n"; 

	my ( $plcType, $plcLength ) = &getTagType( $tagName, \%plcTagList );

	my $waveOpt = 1;
	if( $plcTagList{$tagName}{"clas"} eq "ALIAS"  ) {
	    $waveOpt = 0;
	}
	my ( $dbType , $dbLength  ) = &getRecType( $plcType, $plcLength, $waveOpt);

# do not make EPICS records for tag names which indicate 
# complicated tag structure such as AOI	
	my $nameIsOK = &checkPlcName( $plcName );
	if(  not $nameIsOK ) {
	    $dbType = "noType";
	}

# Do not make EPICS record for hardware type tag
	if( exists $hwList{substr( $plcTagList{$tagName}{"type"} , 0, 
				   rindex( $plcTagList{$tagName}{"type"}, ":" ) )} ) {
	    $dbType = "noType";
	}

	print "$plcName : dbType is $dbType , plcType is $plcType, waveOpt is $waveOpt \n";

	if ( $dbType ne "noType" ) {
	    print DB_FILE "grecord($dbType,\"$dbName\") \n";
	    print DB_FILE "{ \n";
	    print DB_FILE "   field(SCAN, \"1 second\") \n";
	    print DB_FILE "   field(DTYP, \"EtherIP\") \n";
#	    print DB_FILE "   field(PREC, \"2\")\n";
	    print DB_FILE "   field(INP, \"\@\$(PLC) $plcName\")\n";
	    if( $dbType eq "ai" or $dbType eq "ao" ) {
		print DB_FILE "   field(PREC, \"2\")\n";
	    }
	    print DB_FILE "\#PLC TYPE $plcType  \n";
	    print DB_FILE "} \n";
	}
    }

    close ( DB_FILE );
}



sub getTagType { 
    local ( $tagName, $listPtr ) = @_; 

    my $tmpName  = $tagName;
    my $plcClas  = $listPtr->{$tmpName}{"clas" } ;
    my $plcType  = $listPtr->{$tmpName}{"type" } ;
 
    print "tmpName is $tmpName, plcClas is $plcClas, plcType is $plcType \n";
    while( $plcClas eq "ALIAS" ) {

	my $plcRef   = $listPtr->{$tmpName}{"refer"} ;
	my $plcScope = $listPtr->{$tmpName}{"scope"} ;

	( $refName, $refScope) = &getRefName( $plcRef, $plcScope, $listPtr );
	if( $refScope ne "" ) {
	    $tmpName = $refScope . "." . $refName;
	} else {
	    $tmpName = $refName;
	}
	$plcClas  = $listPtr->{$tmpName}{"clas" } ;
	$plcType  = $listPtr->{$tmpName}{"type" } ;

	print "refName is $refName, tmpName is $tmpName, plcClas is $plcClas, plcType is $plcType \n";
    }

    my $type;
    my $length;
    if( $plcClas eq "TAG" ) {
	( $type,  $length ) = &getPlcTypeLength( $plcType );
	print "Found real type $type, length $length  $ptr \n";
    }
    return ( $type,  $length );
}





# Return the referenced tag name after dropping the 
# square bracket part
sub getRefName {
    my ( $plcRef, $plcScope, $listPtr ) = @_;
    my $refName = $plcRef;

#

    if( $plcRef =~ m/^.{1,}\.Ch\d{1,}Data$/ or 
	$plcRef =~ m/^.{1,}\.Ch\d{1,}Fault$/ or 
	$plcRef =~ m/^.{1,}\.ReceiveRecordNumber$/ or 
	$plcRef =~ m/^.{1,}\.Data\.\d{1,}$/ ) {
# it is a hardware tag pointing to data field
# or fault field on a hardware module
	print "Matched $plcRef \n";
	my $perPos = index( $plcRef, "\." );
	print "Period position is $perPos \n";
	$refName  = substr( $plcRef, 0, $perPos );

    } elsif( $plcRef =~ m/^.{1,}\[\d{1,}\]$/ ) {
# it is a alias to an element of a array tag
#
	my $lbPos = index( $plcRef, '[' );
	my $rbPos = index( $plcRef, ']' );
	$refName  = substr( $plcRef, 0, $lbPos );
    }

    if ( $plcScope  ne "" ) {
	my $testName = $plcScope . "." . $refName;
	if( not exists $listPtr->{$testName} ) {
	    $refScop = "";
	}
    }

    ( $refName, $refScope );
}


#Find the EPICS record type and length knowing what data type 
# and length  for the corresponding PLC tag  is
sub getRecType { 
    my ( $plcType, $plcLength, $waveOpt ) = @_;
    my $recType = "noType";
    my $recLength = 0;
    
    print "Position of last : is ", rindex( $plcType, ":" ), " \n";
    print "Substring is |", substr( $plcType, 0, rindex( $plcType, ":" ) ), "|\n";
    print $hwList{substr( $plcType, 0, rindex( $plcType, ":" ) )},  " Should match ", 
    $hwList{"AB:1756_IF16_Float_No_Alm:I"}, " \n";

    if( $plcLength == 0 || $waveOpt == 0 ) {
	$recLength = 0;
	switch ( $plcType ) {
	    case "BOOL"   { $recType = "bi" }
	    case "DINT"	  { $recType = "ai" }
	    case "INT"	  { $recType = "ai" }
	    case "SINT"	  { $recType = "ai" }
	    case "REAL"	  { $recType = "ai" }
	    case "STRING" { $recType = "stringin" }
	    else {
		if( exists $hwList{substr( $plcType, 0, rindex( $plcType, ":" ) )} )  {
		    print "Assigning \n";
		    $recType = $hwList{substr( $plcType, 0, rindex( $plcType, ":" ) )};
		} else {
		    { $recType = "noType" }
		}
	    } 
	    
	}
    } elsif( $plcType eq "DINT" or $plcType eq "INT" or 
	     $plcType eq "SINT" or $plcType eq "REAL" ) {
	$recType =  "waveform";
	$recLength = $plcLength;
    }
    print "Returning ( $recType, $recLength ) \n";
    return ( $recType, $recLength );
}


# Find the actual PLC record type and length knowing what data type 
# field of the corresponding PLC tag is
sub getPlcTypeLength { 
    my ( $plcType ) = @_;
    my $type;
    my $length;

    if( $plcType =~ m/^\D{1,}\[\d{1,}\]$/ ) {
	my $lbPos  = index( $plcType, '[' );
	my $rbPos  = index( $plcType, ']' );
	$type   = substr( $plcType, 0, $lbPos );
	$length = substr( $plcType, $lbPos+1, ($rbPos - $lbPos - 1) );
    } else {
	$length = 0;
	$type = $plcType;
    }
    return ( $type, $length ) ;
}


#
# checks that the tagname does not have parts 
# that indicate a complicated structure like 
# AOI (add-on istructions) 
#
sub  checkPlcName{
    my ( $plcName ) = @_;
    my $nameIsOK = 1;
    if ( index( $plcName, "AOI" ) >= 0 ) {
	$nameIsOK = 0;
    }
    $nameIsOK;
}

sub printDebug {
    my ( %plcTagList ) = @_;
    print "Printing tag list which was read \n" ;
    foreach $tagName ( sort keys %plcTagList ) { 
	print "Tag $tagName : \n";
	my $plcTag = $plcTagList{$tagName};
	foreach my $field ( sort keys %{$plcTag} ) {
#	print " $field: $plcTag->{$field} ";
	    printf( "%10s %25s", $field, $plcTag->{$field} );
	}
	print "\n";
    }
}
