#!/usr/bin/perl

# ******** Common Routines ******** 
# 挿入・書換・検索・削除


# -------- ファイル関数設定 --------

sub fl_fileformat{
   ($file1) = @_;

    splice @f2_LINES;
    splice @f2_rcrdlist;
    $f1_linenmbr=&io_fileread("2",$file1,"err");

    $f1_file       = $file1;
    $f1_line0      = $f2_LINES[0];
    $f1_line1      = $f2_LINES[1];
#print "DEBUG 00fl30 sub fl_fileformat 10 - $file1<br />$f2_LINES[0]<br />\n";

    @f1_title      = split("_SP_",$f2_LINES[0]);
    @f1_format     = split("_SP_",$f2_LINES[1]);
    $f1_colnmbr    = @f1_title;

    $errmsg = "";
    my @path      = split("\/",$file1);
    my $f1_filename  = pop @path;

#print "DEBUG 00fl30 sub fl_fileformat 20 - $f1_filename - $f1_title[0]<br />\n";
    if(substr($f1_filename,2,1) eq "-"){
#print "DEBUG 00fl30 sub fl_fileformat 21 - $f1_filename - $f1_title[0]<br />\n";
         $f1_type     = "var";
         $f1_keylen   = length($f1_format[0]);
         $f1_order    = substr($f1_title[0],3,3);      # ?????? 位置不可解　inc/dec/fst/lst
         $f1_order2   = substr($f1_title[0],6,3);      # ?????? 位置不可解　trs(transfer)/thd(thread) 
#print "DEBUG 00fL30 sub fl_fileformat 22 - $f1_filename - $f1_type - $f1_keylen - $f1_order - $f1_order2<br />\n";

    }
    else{
         $errmsg = $errmsg."<li>".$file1."：ファイル名の３字目のコードが「 - 」（可変長データ）ではありません。</li>\n";
#print "DEBUG 00fx10 sub file_format 30 - $file1<br />\n";
    }
    $f1_title[0]   = "キーコード";
#print "DEBUG 00fl30 sub fl_fileformat 30 - $f1_order<br />\n";

    if($f1_order eq "inc" || $f1_order eq "lst"){
         $f1_ordermark = "/"; 
    }
    elsif($f1_order eq "dec" || $f1_order eq "fst"){
         $f1_ordermark = "|";
    }
    else{
         $errmsg = $errmsg. "<li>".$f1_order."：キーの指定「inc、dec、fst、lst」が間違っています。</li>\n";
    }
#print "DEBUG 00fx10 sub file_format 40 - $f1_order - $f1_keylen - $f1_type - $f1_nmbrlen<br />\n";

#    if($f1_colnmbr != @f1_format){
#        $errmsg = $errmsg."<li>項目数第１行が第０行：".$f1_colnmbr."と異なります。</li>\n";   UTF-8 では不可
#    }	
#print "DEBUG 00fx10 sub file_format 60 - $f1_order - $err_nmbr - $errmsg<br />\n";

    if($f1_title[$f1_colnmbr-1] ne "END\n" || $f1_format[$f1_colnmbr-1] ne "END\n"){
         $errmsg = $errmsg.$f1_colnmbr." - ".$f1_format[$f1_colnmbr-1]."<li>第０・１・行の最終項目（「END」マーク）が不整です。</li>\n";
    }
#print "DEBUG 00fx10 sub file_format 70 - $f1_order - $err_nmbr - $errmsg<br />\n";

    if($errmsg ne ""){
         $errmsg  = $file1."：ファイル・フォーマット・チェック（最初２行）<br /><ol>\n\n".$errmsg."</ol>\n"; 
         $errref1 = "プログラムエラー：".$prjcode0." - ".$work." - ".$prgname." - cg_00fl30x - file_format";
         &io_errexit($errmsg,$errref1,$manager);
    }
#print "DEBUG 00fx10 sub file_format 90 - $file1 - $f1_type<br />\n";
}


# *********** 主要ルーティン ********

sub fl_filecheck{
    ($file1) = @_;
    &fl_fileformat($file1);
    if($f1_type eq "var"){
         $f2_SIZE=&io_fileread("",$file1,"err");
    }
    else{
         $f2_SIZE=&io_fileread("",$f1_fixfile,"err");
    }
    $dspmsg = "ファイル・チェック（全行）（cg_00fl30x - sub file_check）\n";
    $dspmsg = $dspmsg."<br />".$file1."：項目数 - ".$f1_colnmbr."、総行数（頭書２行を含む） - ".$f2_SIZE."\n";
    $errmsg = "";
    for(my $i=2;$i<$f2_SIZE;$i++){
#print "DEBUG sub file_check - $file1 - $i - $f2_SIZE - $f2_LINES[$i]<br />\n";
         $errmsg1 = &fl_rcrdcheck($i,$f2_LINES[$i]);
         if($errmsg1 ne ""){
             $errmsg  = $errmsg.$errmsg1;
             if(length($errmsg)>5000){
                 $errmsg = $dspmsg."<ol>".$errmsg."</ol>";
                 &io_dspexit($errmsg);
             }
         }
     }
     if($errmsg ne ""){
          $errmsg = $dspmsg."<ol>".$errmsg."</ol>";
          &io_dspexit($errmsg);
     }
     return($dspmsg);
}

sub fl_rcrdcheck{
     my($line,$record) = @_;
     $line = $line - 1; 
     my @fld = split("_SP_",$record);
     my $nmbr = @fld;
     $errmsg1 = "";
#print "DEBUG sub rcrd_check - $line - $nmbr - $record<br />\n";
     if($nmbr != $f1_colnmbr || substr($fld[$f1_colnmbr-1],0,3) ne "END"){
          $errmsg1 = $errmsg1."<li>".$line." 行目、項目数（".$f1_colnmbr."）：".$nmbr."、END 欄：".$fld[$f1_colnmbr-1]."</li>\n";
          $err_nmbr++;
     }
     if($f1_type eq "var" && length($fld[0]) != $f1_keylen){
          $errmsg1 = $errmsg1."<li>".$line." 行目、キー長（".$f1_keylen."）：".$fld[0]."</li>\n";
          $err_nmbr++;
     }
     return $errmsg1;
}
sub fl_rcrdinsert{
    ($file1) = @_;
    &fl_fileformat($file1);
#print "DEBUG 00fx10 sub rcrd_insert 20 - $file1 - $f1_type<br />\n";
    $errmsg = &fl0_floatinsert;
#print "DEBUG 00fx10 sub fl_rcrdinsert 20 - $errmsg<br />\n";
    return($errmsg);
}
sub fl_rcrdrewrite{
    ($file1) = @_;
    &fl_fileformat($file1);

#print "DEBUG 00fx10 sub fl_rcrdrewrite 20 - $errmsg<br />\n";
    $errmsg = &fl0_floatrewrite;
    return($errmsg)
}

sub fl_rcrdsearch{
    ($file1) = @_;

    &fl_fileformat($file1);

    $f2_SIZE=&io_fileread("",$file1,"err");
    substr($f2_LINES[1],0,1) = $f1_ordermark;
    $f2_rcrdnmbr = 0;

#print "DEBUG 00fx10 sub rcrd_search 81 - $file1 - $f1_order - $f1_keylist[0]<br />\n";

    &fl0_floatsearch;

#print "DEBUG 00fx10 sub rcrd_search 82 - $file1 - $f1_order - $f1_keylist[0] - $f2_rcrdnmbr<br />@f2_rcrdlist<br />\n";
    close(f0_FILE);	 
}

sub fl_rcrddelete{
    ($file1) = @_;

    &fl_fileformat($file1);

    $f2_SIZE=&io_fileread("",$file1,"err");
    substr($f2_LINES[1],0,1) = $f1_ordermark;
    $f2_rcrdnmbr = 0;

#print "DEBUG 00fx10 sub rcrd_delete 90 - $file1 - $f1_type - $f1_order - $f2_rcrdnmbr<br />@f2_rcrdlist<br />\n";

    if($f1_type eq "var"){
        &fl0_floatdelete;
    }
}

# ************** 副ルーティン（ファイル・チェック）**************

# ************** 副ルーティン（挿入・書替）**************

# -------- データ挿入--------

sub fl0_floatinsert{
     $f2_SIZE = &io_fileread("",$file1,"err");
     substr($f2_LINES[1],0,1) = $f1_ordermark;

     if($f1_order eq "inc" || $f1_order eq "dec"){
         $f1_key = $f1_data[0];
         my $keylen = length($f1_key);

#print "DEBUG 00fl30 sub fl0_floatinsert 01 $f1_keylen - $f1_data[0] - $keylen<br />\n";

         if($keylen != $f1_keylen){
              $errmsg = "キー：".$f1_key."（".$keylen."）、規定（".$f1_keylen."）外の長さは認められません。\n";
              return($errmsg);
         }
         $f2_matchnmbr = 0;
         &fl0_finding;
         if($f2_matchnmbr>0){
             $errmsg = "（cg_00fl20x - sub float_insert）".$f1_key."：同じキーのデータが既に存在します。\n";
             return($errmsg);
         }
     }
     elsif($f1_order eq "fst" || $f1_order eq "lst"){
         my $line;
         if($f1_order eq "fst"){
             $line = $f2_LINES[2];
             $f1_insline = 2;
         }
         elsif($f1_order eq "lst"){
             $line = $f2_LINES[$f2_SIZE - 1];
             $f1_insline = $f2_SIZE;
         }
         (my $key, my $other) = split("_SP_",$line);
         $f1_data[0] = &st_nmbrform($f1_keylen,'0',$key+1);
         $f1_key = $f1_data[0];
#print "DEBUG 00fx10 sub float_insert - 02 - $file1 - $f1_order - $f1_type - $f2_SIZE - $line<br />$f2_LINES[7]<br />\n";
    }
    &fl_rcrdform;
#print "DEBUG 00fx10 sub float_insert - 03 - $file1 - $f1_order - $f1_insline<br />$f1_record<br />\n";
    splice(@f1_LINES,0);
    for(my $i=0;$i<$f1_insline;$i++){
        $f1_LINES[$i]  = $f2_LINES[$i];
    }
    $f1_LINES[$f1_insline] = $f1_record;
    for(my $i=$f1_insline;$i<$f2_SIZE;$i++){
        $f1_LINES[$i+1] = $f2_LINES[$i];
    }
    &io_filewrite("",$file1,"err");
    return($errmsg);
}
# -------- データ書換 --------

sub fl0_floatrewrite{

    $f1_key = $f1_data[0];
    my $keylen = length($f1_key);
print "DEBUG 00fl30 sub fl0_floatrewrite 01 - $f1_keylen - $f1_data[0] - $keylen<br />\n";

    if($keylen != $f1_keylen){
        $errmsg = "キー：".$f1_key."（".$keylen."）、規定（".$f1_keylen."）外の長さは認められません。\n";
        return($errmsg);
    }
    &fl_rcrdform;
    $f2_SIZE=&io_fileread("",$file1,"err");
#print "DEBUG 00xa - 65 - $file1 - $f2_SIZE<br />\n";

    substr($f2_LINES[1],0,1) = $f1_ordermark;

    $f2_matchnmbr = 0;
    
    &fl0_finding;
    if($f2_matchnmbr == 0){
         $errmsg = "（cg_00fl20x - sub float_rewrite）".$f1_key."：該当コードのレコードは存在しません。\n";
         return $errmsg;
#        &err_exit($errmsg);
    }
    elsif($f2_matchnmbr > 1){
         $errmsg = "（cg_00fl20x - sub float_rewrite）".$f1_key."：該当コードのレコードが複数あります。\n";
         return $errmsg;
#        &err_exit($errmsg);
    }
#print "DEBUG 00xa - 65 - $file1 - $f1_type - $f2_matchline - $f2_SIZE<br />$f2_record<br />@f2_LINES<br />\n";
    if($f1_type eq "var"){
         $size  = $f2_SIZE;
         @f1_LINES = @f2_LINES;
         $f1_LINES[$f2_matchline] = $f1_record;
#print "DEBUG 00xa - 65 - $file1 - $f2_matchline - $size<br />$f1_record<br />@f1_LINES<br />\n";
         &io_filewrite($size,$file1,"err");
#print "DEBUG 00fl30 sub fl0_floatrewrite 65 - $errmsg<br />\n";
         return($errmsg);
    }
}
# -------- 入力データチェック　共通サブルーチン--------

sub fl_rcrdform{
#print "DEBUG 00fx10 sub rcrd_form - 01 - $file1 - $f1_type - $f1_colnmbr<br />@f1_data<br />\n";

     if($f1_type eq "var"){
         $f1_data[$f1_colnmbr-1] = "END";
         $f1_record = join("_SP_",@f1_data);
         $f1_record =~ s/\n/<br \/>/g;      #「改行」をファイル記録用に
     }
     else{
        $errmsg = "$f1_type = ".$f1_type."、ファイルのタイプ（可変長='var'）不明です。\n";
        $errref1 = "プログラムエラー：".$prjcode0." - ".$work." - ".$prgname." - cg_00fl30x - rcrd_form";
        &io_errexit($errmsg,$errref1,$manager);
     }
#   unshift(@f1_data,$nodata);
}

# ************** 副ルーティン（検索・削除）**************

# -------- データ検索 --------

sub fl0_floatsearch{
    $f8_keynmbr  = 0;
    $f2_rcrdnmbr = 0;
    for(my $i=0; $i<$f1_keynmbr;$i++){
        $f1_key = $f1_keylist[$i];
        if($f1_key eq ""){next;}
        $f2_matchnmbr=0;
        &fl0_finding;
        if($f2_matchnmbr == 0){
            $f8_keylist[$f8_keynmbr]= $f1_key;
            $f8_keynmbr++;
        }
    }
}

# -------- 検索　共通サブルーチン--------

sub fl0_finding{

      local $min  = 1;
      local $max  = $f2_SIZE-1;
      local $line = $min;
      &fl0_findingcheck;

      if($line<0){return;}
      $line = $max;
      &fl0_findingcheck;

      if($line<0){return;}
      my $t=0;
      while(1){
           $t++;
           $line = int(($min + $max)/2);
           if($line == $min){
               $f1_insline=$min + 1;
               return;
           }
           elsif($t>20){
               $errmsg = "（cg_00fl20x - sub finding）プログラム・エラー\n";
               $errref1 = "プログラムエラー：".$prjcode0." - ".$work." - ".$prgname." - cg_00fl30x - sub finding";
               &io_errexit($errmsg,$errref1,$manager);
           }
           else{
               &fl0_findingcheck;
               if($line<0){return;}
           }
      }
}

sub fl0_findingcheck{
     my $keylen = length($f1_key);
     my $key = substr($f2_LINES[$line],0,$keylen);
#print "DEBUG 00fl30 sub fl0_findingcheck 10 - $min - $max - $line - $f1_key - $key<br />\n";

     if(($f1_order eq "inc" || $f1_order eq "lst") && $f1_key gt $key || ($f1_order eq "dec" || $f1_order eq "fst") && $f1_key lt $key){
          $min = $line;
     }
     elsif(($f1_order eq "inc" || $f1_order eq "lst") && $f1_key lt $key || ($f1_order eq "dec" || $f1_order eq "fst") && $f1_key gt $key){
          $max = $line;
     }
     else{
#print "DEBUG 00fx10 sub check 11 - $min - $max - $line - $f1_key - $key<br />\n";
          &fl0_findinglist;
          $line = -1;
          return;
     }
}

sub fl0_findinglist{
     my $keylen = length($f1_key);
     while(1){
           $line = $line-1;
           my $key = substr($f2_LINES[$line],0,$keylen);
           if($line<2 || $key ne $f1_key){last;}
     }    
     while(1){
           $line++;
           my $key = substr($f2_LINES[$line],0,$keylen);
           if($line>$f2_SIZE-1 || $key ne $f1_key){last;}
           else{
               $f2_rcrdlist[$f2_rcrdnmbr] = $f2_LINES[$line];
               $f2_rcrdnmbr++;
               $f2_matchnmbr++;
               $f2_matchline = $line;
               $f2_record    = $f2_LINES[$line];
           }
     }
} 

# ------- データ削除 -------

sub fl0_floatdelete{

    $f2_rcrdnmbr = 0;
    @f0_keylist  = @f1_keylist;
#print "DEBUG 00va - 71 - $f2_SIZE - $f1_keynmbr<br />@f1_keylist<br />\n";

    $f1_LINES[0] = $f2_LINES[0];
    $f1_LINES[1] = $f2_LINES[1];
    for(my $i=2;$i<$f2_SIZE;$i++){
        my $check  = 0;
        for(my $k=0;$k<$f1_keynmbr;$k++){
            $f1_key   = $f1_keylist[$k];
            if($f1_key eq ""){next;}
            my $keylen = length($f1_key);
            my $key = substr($f2_LINES[$i],0,$keylen);

#print "DEBUG 00va - 73 - $i - $k - $f1_keynmbr<br />$key - $f1_key<br />\n";

            if($key eq $f1_key){
                 $check=1;
                 $f2_rcrdlist[$f2_rcrdnmbr] = $f2_LINES[$i];
                 $f2_rcrdnmbr++;
                 $f0_keylist[$k] = "";
                 last;
            }
        }
#print "DEBUG 00va - 74 - $f2_rcrdnmbr<br />@f0_keylist<br />\n";
        if($check==1){
            next;	
        }
        else{
            $f1_LINES[$i-$f2_rcrdnmbr]=$f2_LINES[$i];
        }
    }
    $size = $f2_SIZE-$f2_rcrdnmbr;
    &io_filewrite($size,$file1,"err");
    $f8_keynmbr=0;
    for($k=0;$k<$f1_keynmbr;$k++){
        if($f0_keylist[$k] ne ""){
            $f8_keylist[$f8_keynmbr] = $f0_keylist[$k];
            $f8_keynmbr++;
        }
    }
#print "DEBUG 00xa - 75 - $f8_keynmbr<br />@f8_keylist<br />\n";
}
1;