#
#  (gH)   --  cf.pl  ;  TimeStamp (unix) : 18 Août 01 17:50
#

sub syntaxe {

  print "\n" ;
  print " cf 1.4 -- (gH) ; conversion et creation de fichiers \n" ;
  print "                  pour Dbase, Mysql, Sas, Rbase.            \n" ;
  print "\n" ;
  print " syntaxe  : $ligSyntax\n\n"  ;
  print " options  : -fl  = ajout de labels en ligne 1\n"   ;
  print "            -fs  = création d'un fichier de structure\n"   ;
  print "            -ft  = création d'un fichier texte bien cadré\n"   ;
  print "\n" ;
  print " exemples : cf vins R                 \n"   ;
  print "                    # crée le fichier vins.r à partir de vins.dat \n" ;
  print "            cf -fs elf M                 \n"   ;
  print "                    # crée les fichier elf.col et elf.msql à partir de elf.dat \n" ;
  print "            cf -ft avions S                 \n"   ;
  print "                    # crée les fichiers avions.txt et avions.sas à partir de avions.dat \n" ;
  print "            cf -fl elf                  \n"   ;
  print "                    # ajoute en ligne 1 du fichier elf.dat les noms de colonne\n" ;
  print "            cf     cps85                \n"   ;
  print "                    # décrit le fichier cps85.dat " ;
  print "\n" ;
  print " aide     : cf --help\n\n" ;

  if (length($ARGV[0])>0) {

     print << "EOH" ;

     Un dossier fait référence à un fichier .dat
                            et à un fichier .col

     - Dans un .dat on devrait toujours avoir des libellés en ligne 1 et colonne 1 ;
       par exemple :

          (ligne 1)  ID    SEXE AGE PROF
          (ligne 2)  A001  1    25  2
          (ligne 3)  B002  2    16  4
                  ...
       mais sinon le programme invente les noms C001 C002 C003 etc.
       sans les rajouter dans le fichier. Utiliser l'option -fl
       pour rajouter ces noms dans le fichier des données.

     - Un fichier .col contient par ligne une description de colonne
       avec un numéro de colonne et un nom de colonne
       par exemple :

          (ligne n)  2  SEXE

       mais si le fichier n'existe pas, le programme invente les définitions 1 C001, 2 C002 etc.
       sans créer le fichier. Utiliser l'option -fs pour créer le fichier .col

     - S'il n'y a pas concordance entre le .dat et le .col on utilise
       le .dat comme source de renseignements.

     - L'analyse du .dat fournit les renseignements suivants :

          . nombre de lignes en tout
          . nombre de lignes de données
          . indication de la présence de la ligne d'intitulé des colonnes
          . nombre de lignes vides non retenues
          . nombre moyen de colonnes par ligne

     - Si on dispose d'un fichier structure .str pour Dbase, il suffit d'utiliser le programme
       numerote pour créer le .col ; par exemple :

          numerote elf.str > elf.col

     - Si on dispose d'un fichier .dbf pour Dbase, on peut construire le fichier .str et le
       fichier .sdf avec l'option -c de la commande dscdbf.

EOH

  } ; # finsi aide supplémentaire

} ; # sub syntaxe

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

sub litDonnees {

  # lecture des données, vérification du nb de colonnes
  # on ignore les lignes qui commencent par dièse
  # si la ligne 1 ne contient que des mots,
  # on dit que c'est une ligne de labels, c'est
  # à dire de noms de colonne
  # on ne vérifie pas que chaque ligne a
  # le meme nombre de colonnes mais on donne le nb moyen
  # de colonnes...

  my ($nblData,$nbcData,$sumnbcData) =  (0,0,0)  ;
  $nbv = 0 ;
  $nblT = 0 ;
  open(FDAT,"<$nomfDat") or die(" impossible d'ouvrir $nomfDat en lecture \n") ;

  while (<FDAT>) {
    $nblT++ ;
    $ligTxt  = $_ ;
    @ligDat  = split(" ",$_) ;
    $longTxt = length($ligTxt) ;
    if (($longTxt)==1) { $nbv++ ; } ;
    if ((substr($ligDat[0],0,1) ne "#") and ($longTxt>1)) {
      $nbcData = 1 + $#ligDat ;
      $nbOcc{$nbcData}++;
      $nblData++ ;

      # analyse de la ligne un

      if ($nblData==1) {
          ## print " ligne un : @ligDat ".(1+$nbcData)." mot(s)\n";
          $nbidCol = 0 ;
          foreach $mot (@ligDat) {
              $Mot = $mot ;
              $nbmodif = ($Mot =~ s/[A-Za-z]//g) ;
              if ($nbmodif>0) { $nbidCol++ }
              ## print " mot : $mot avec $nbmodif modifs\n " ;
          } ; # fin pour chaque mot de ligDat
          ## print " donc $nbidCol idCol \n" ;
          if ($nbidCol>=$nbcData-1) { # on a trouvé une ligne de labels
             $presLabel     = 1 ; # label des colonnes
             $jcol =  0 ;
             $ligLabel = $ligTxt ;
             foreach $mot (@ligDat) {
                 $jcol++ ;
                 $nomCol[$jcol] = $mot ;
                 ## print " $jcol : $mot \n" ;
             } ; # fin pour chaque mot de ligDat
          } ;
      } ; # fin # analyse de la ligne un

      # on se sert de la ligne2 pour analyser le format

      if ($nblData==2) {
         $nCol   = 1 ;
         $ligneD = $ligTxt ;
         $longCol[$nCol] = 0 ;
         $iCol   = 0 ;
         $lonLig = length($ligneD) ;
         while ($iCol<$lonLig) {
           $carC = substr($ligneD,$iCol,1) ;
           $carP = substr($ligneD,$iCol-1,1) ;
           if (($carC eq " ") and ($carP ne " ")) {
              $nCol++ ;
           } ; # fin de si
           $iCol++ ;
           $longCol[$nCol]++ ;
           # gestion du type et des décimales
           $decCol[$nCol] = 0 ;
           if ($nCol==1) { $typCol[$nCol] = "C" ; } else { $typCol[$nCol] = "N" ; } ;
         } ; # fin tant que
         $nbCol = $nCol ;
         ##print "                  1         2         3         4         5         6\n" ;
         ##print " ligne : 1234567890123456789012345678901234567890123456789012345678901234\n" ;
         ##print " ligne : $ligneD avec $lonLig car ; donc $nbCol col\n" ;
         ##$nCol =  1;
         ##while ($nCol<$nbCol) {
           ##print " col $nCol long = ". $longCol[$nCol]."\n" ;
           ##$nCol++ ;
         ##} ; # fin tant que
      } ; # fin # analyse de la ligne deux

      # transfert des données dans le tableau matData

      if (($nblData>1) or (($nblData==1) and ($presLabel==0))) {
        $sumnbcData += $nbcData ;
        $jCol = 0 ;
         foreach $mot (@ligDat) {
            $jCol++ ;
            ## print " en $nblData,$jCol :  $mot  nbcdata $nbcData\n" ;
            $matData[$nblData-1][$jCol] = $mot ;
         } ; # fin pour chaque
      } ; # fin de si

    } ; # fin de ce n'est pas un commentaire
  } ; # fin tant que

  close(FDAT) ;
  if ($presLabel==1) { $nblData = $nblData -1 ; } ; # on ote la ligne des labels
  $nbcData = $sumnbcData / $nblData ;

  # s'il n'y a pas de ligne de label, on crée les labels
  # C001, C002 etc.

  if ($presLabel==0) {
  $ligLabel = "" ; $ilig = 1 ;
  while ($ilig<= $nbcData) {
     $nomCol[$ilig] = $ilig ;
     while (length($nomCol[$ilig])<3) { $nomCol[$ilig] = "0".$nomCol[$ilig] } ;
     $nomCol[$ilig] = "C".$nomCol[$ilig] ;
     $ligLabel .= $nomCol[$ilig]." " ;
     $ilig++ ;
  } ; } ; # fin tant que et fin de si presLabel = 0

  return ($nblData,$nbcData) ;

} ; # fin litDonnees

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

sub sprintG { # comme sprintf mais ne déborde pas

# par exemple sprintG(25,$pom) équivaut à sprintf("%-25s",$pom)

    my ($len,$phr) = ($_[0],$_[1]) ;
    my $fmt = "%-".$len."s" ;
    my $lph = sprintf($fmt,$phr." "x50) ;
    return substr($lph,0,$len) ;

} ; # fin sub sprintG

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

sub datHeur {

    my ($sec,$min,$hour,$mday,$mmon,$year)=localtime();
    $mmon = $mmon + 1 ;
    $year = $year + 1900 ;
    if (length($sec)<2)  { $sec = "0$sec" } ;
    if (length($mday)<2) { $mday = "0$mday" } ;
    if (length($mmon)<2) { $mmon = "0$mmon" } ;
    $now  = $mday."/".$mmon."/".$year;
    $now .= " ".$hour.":".$min ;

    return $now ;

} ; # fin sub datHeur

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

sub ajouteLigneUn {

  if ($presLabel==1) {
     print " ajout de la ligne 1 (labels) pour $nomfDat refusée :\n" ;
     print " il y a déjà une ligne de lables, à savoir \n" ;
     print "           $ligLabel\n" ;
     return ;
  } ; # fin si

  $jcol = 1 ;
  $ligLab   = "" ;
  while ($jcol<=$nbc) {
      $ligLab .= "$nomCol[$jcol] " ;
      $jcol++;
  } ; # fin tant que

  # recopie temporaire avec ajout de la ligne des labels dans cf.tmp

  my $fsor = "cf.tmp" ;
  open(FSOR,">$fsor") or die(" impossible d'ouvrir $fsor en écriture\n") ;
  print FSOR "$ligLab\n" ;
  open(FDAT,"<$nomfDat") or die(" 2. impossible d'ouvrir $nomfDat en lecture \n") ;
  while (<FDAT>) { print FSOR $_ ; } ;
  close(FDAT) ; close(FSOR) ;

  # recopie de cf.tmp dans le fichier original

  open(FSOR,"<$fsor") or die(" impossible d'ouvrir $fsor en lecture\n") ;
  open(FDAT,">$nomfDat") or die(" impossible d'ouvrir $nomfDat en écriture \n") ;
  while (<FSOR>) { print FDAT $_ ; } ;
  close(FDAT) ;   close(FSOR) ;
  print " nouvelle ligne 1 du fichier $nomfDat :\n" ;
  print "           $ligLab\n" ;
  $presLabel = 1 ;

} ; # fin sub ajouteLigneUn

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

sub creeFstr {

  my $fStr = $nomBase.".col" ;
  print "Création du fichier structure $fStr pour $nomfDat $nbl x $nbc \n" ;
  my $ilig = 1 ;
  open(FSTR,">$fStr")  or die(" impossible d'écrire dans $fStr.\n") ;
  while ($ilig<=$nbc) {
    $fmt_nblig = sprintf("%3d",$ilig) ;
    $fmt_idlig = sprintf("%-4s",$nomCol[$ilig]) ;
    print FSTR "$fmt_nblig $fmt_idlig\n" ;
    print " $fmt_nblig $fmt_idlig\n" ;
    $ilig++ ;
  } ; # fin tant que
  close(FSTR) ;

} ; # fin sub creeFstr

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

sub  sortieCadree {

  my $fsTxt = $nomBase.".txt" ;
  open(FSTXT,">$fsTxt") or die(" impossible d'écrire dans $fsTxt.\n") ;

  my ($iLig,$jCol) = (1,0) ;
  while ($iLig<=$nbl) {
    $ligSr = "" ;
    if ($iLig==1) { print "Premières lignes du fichier cadré $fsTxt : \n" ; } ; # fin si sur ilig=1
    $jCol = 1 ;
    while ($jCol<=$nbc) {
      $lm      = $longCol[$jCol] ;
      $vdm     = $matData[$iLig][$jCol] ;
      ##print " $iLig $jCol : #$vdm# " ;
      if ($jCol==1) { $fmt_val = sprintG($lm,$vdm) ; } else { $fmt_val = sprintf("%".$lm."d",$vdm) ;} ; # fin de si sur jCol = 1
      $ligSr .=  $fmt_val ;
      $jCol++ ;
    } ; # fin tant que sur jCol
    if ($iLig<=5) { print "     ".sprintG(50,$ligSr)."\n" ; } ;
    print FSTXT "$ligSr  \n" ;
    $iLig++ ;
  } ; # fin tant que sur iLig
  close(FSTXT) ;

} ; # fin sub  sortieCadree


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

sub valx  { my $valeur = $_[0] ;

   # renvoi le caractère dont on donne le code decimal
   # par exemple valx( 65 ) est A

   $d = sprintf("%x",$valeur) ; ## if (length(d)==1) { d= "0"d }
   if ($valeur < 16)  { $d = "0$d" ; } ;
   $a = substr($d,0,1) ; $b = substr($d,1,1) ;
   if ($a eq "a") { $a = 10 ; }   ; if ($b eq "a") { $b = 10 ; } ;
   if ($a eq "b") { $a = 11 ; }   ; if ($b eq "b") { $b = 11 ; } ;
   if ($a eq "c") { $a = 12 ; }   ; if ($b eq "c") { $b = 12 ; } ;
   if ($a eq "d") { $a = 13 ; }   ; if ($b eq "d") { $b = 13 ; } ;
   if ($a eq "e") { $a = 14 ; }   ; if ($b eq "e") { $b = 14 ; } ;
   if ($a eq "f") { $a = 15 ; }   ; if ($b eq "f") { $b = 15 ; } ;
   $e = 16*$a+$b ; $res = sprintf("%c",$e) ;
   ## print " pour $valeur on renvoie $res \n" ;
   return $res ;

} ; # fin sub valx

sub decomp16 {

   # decomposition en base 16 et écriture sur nbz/2 octets

   my ($nombre , $nbz , $resD ) = ($_[0],$_[1], "" ) ;
   my $ie = 0 ;
   my $k = 1 ;
   while ($k<=$nbz) { $bz[$k] = 0 ; $k++ ; } ;
   while ($nombre>0) {
      $ie++ ; $mm  = int($nombre/16) ; $nn  = $nombre - 16*int($nombre/16) ;
      $bz[$ie] = $nn ; $nombre = $mm ;
   } ; # fin tant que sur nombre

   my $j = 1 ;
   while ($j<=$nbz/2) {
       $resD .= &valx(16*$bz[2*$j]+$bz[2*$j-1]) ;
       $j++ ;
   } ; # fin pour j
   return $resD ;

} ; # fin sub decpmp16

sub conversion_Dbase() {

  my $fDbase = $nomBase.".dbf" ;
  my $fstr   = $nomBase.".stb" ;

  # on crée le fichier structure

  open(FDBF,">$fDbase") or die(" impossible d'écrire dans $fDbase") ;
  binmode FDBF ; ## TRES IMPORTANT !! sinon 0A devient 0D 0A

  open(FSTR,">$fstr") or die(" impossible d'écrire dans $fstr") ;
  my $i = 1 ;
  my $ligStr = "" ;
  while ($i<=$nbc) {
      $ligStr .= sprintf("%-15s",$nomCol[$i])." " ;
      if ($i==1) { print "Premières lignes du fichier structure $fstr :\n" ; } ;
      if ($i==1) { $ligStr .= "C " ; } else { $ligStr .= "N " ; } ;
      $ligStr .= sprintf("%2d"  ,$longCol[$i])." " ;
      $ligStr .= "0" ; ### ??? sprintf("%1d"  ,$decCol[$i]) ;
      print FSTR "$ligStr\n" ;
      if ($i<=5) { print  "     $ligStr\n" ; } ;
      $ligStr = "" ;
      $i++ ;
  } ; # fin pour i
  close(FSTR) ;


  my $lonCcar = 0 ;
  my $lonCnum = 0 ;

  # parcours du fichier structure

  $ndc = 0 ;
  open(FSTR,"<$fstr") or die(" impossible de lire dans $fstr") ;

  while (<FSTR>) {  $ndc++  ;
    ($m1,$m2,$m3,$m4) = split(" ",$_) ;
    $m1           =~ s/[a-z]/[A-Z]/g ;
    $nomCol[$ndc] = $m1 ;
    $m2           =~ s/[a-z]/[A-Z]/g ;
    $typCol[$ndc] = substr($m2."?",0,1) ;
    $longCol[$ndc] = $m3 ;
    $decCol[ndc]  = $m4 ;
    if ($typCol[$ndc] eq "C") { $lonCcar += $longCol[$ndc] } ;
    if ($typCol[$ndc] eq "N") { $lonCnum += $longCol[$ndc] } ;

  } ; # fintant que

  # octet  0 : 83 si champ mémo, 3 sinon

  $c = 3  ;
  $d = sprintf("%c",$c) ;
  ## print "pour $c on renvoie $d\n" ;
  print FDBF $d ;

  # octets 1 à 3 : date en AA MM DD
  # exemple : 10 janvier 99 donne 63 01 0A

  my ($dsec,$dmin,$dhour,$dday,$dmon,$dyear)=localtime();
  $dmon  = $dmon + 1   ;
  $dyear = $dyear - 100 ;
  print FDBF &valx($dyear) ;
  print FDBF &valx($dmon) ;
  print FDBF &valx($dday) ;

  # octets 4 à 7 : nombre d'enregistrements
  # si count vaut   a b c d e f g h en base 16
  # on écrit  gh ef cd ab
  # exemple : 98010 donne 0 0 0 1 7 E D A
  # qu'on code en DA 7E 01 00

  print FDBF &decomp16($nbl,8) ;

  # octets 8-9 : longueur totale de l'en-tête
  # si lent  vaut   a b c d  en base 16
  # on écrit  cd ab
  # exemple : 32  donne 0 2 0 0
  # qu'on code en 20 00
  # longueur : 32 + flogdcount*32 + 1

  $lent = 32*(1+$nbc) + 1 ;
  print FDBF &decomp16($lent,4) ;

  # octets 10-11 : longueur de chaque enregistrement

  $lenr = 1 + $lonCcar + $lonCnum ;
  print FDBF &decomp16($lenr,4)  ;

  # octets 12-31 : réservés

  my $i = 1 ;
  while ($i<=20) {
      print FDBF &valx(0) ; $i++ ;
  } ; # fin pour sur i

  my $ic = 1 ;
  while ($ic<=$nbc) {
    # pour chaque champ 32 octets :
    # 00-10 nom de la zone (compléter sur 10 car avec des zéros en hexa)
    #    11 type  C N  L D M
    # 12-15 place pour l'adresse
    #    16 taille de la zone
    #    17 nb de décimales pour type N
    # 18-31 réservés

    $nomf = substr($nomCol[$ic]."                    ",0,11) ;
    $i = 1 ;
    while ($i<=11) {
      if (substr($nomf,$i-1,1) eq " ") { print FDBF &valx(0) ; }
                          else     { print FDBF substr($nomf,$i-1,1) ; } ;
      $i++ ;
    } ; # fin pour i

    if ($ic==1) { print FDBF "C" ; } else { print FDBF "N" ; } ;

    $i = 1 ;
    while ($i<=4) {
        print FDBF &valx(0) ; $i++ ;
    } ; # fin pour i

    print FDBF &valx($longCol[$ic]) ;

    if ($ic==1) { print FDBF &valx(0) ; } else { print FDBF &valx($decCol[$ic]) ; } ; ### ??? décimales ;

    $i = 18 ;
    while ($i<=31) {
          print FDBF &valx(0) ; $i++ ;
    } ; # fin pour i

    $ic++ ;

  } # fin pour ic

  # octet de valeur 13 comme indicateur de fin des descripteurs

  print FDBF &valx(13) ;

  # on met les données (octet 0, valeur 32 enreg. non "deleted" )

  $fsdf = $nomBase.".txt" ;
  open(FSDF,"<$fsdf") or die(" impossible de lire dans $fsdf") ;
  $idl = 0 ;
  while (<FSDF>) { $idl++ ;
    $ligT = $_ ;
    print FDBF &valx(32) ;
    $deb = 1 ;
    $i   = 1 ;
    while ($i<=$nbc) {
        $fin = $deb + $longCol[$i] ;
        $mot = substr($ligT,$deb-1,$longCol[$i]) ;
        if ($typCol[$i] eq "C") {
           while (length($mot)<$longCol[$i]) { $mot .= "_" ; }  ;
        } ; # fin si C
        if ($typCol[$i] eq "N") {
           $specf = "%".$longCol[$i].".".$decCol[$i]."f"  ;
           $mot   = sprintf($specf,$mot) ;
        } ; # fin si N
        $j = 1 ;
        while ($j<=length($mot)) {
            print FDBF substr($mot,$j-1,1) ;
            $j++ ;
        } # fin pour j
        $deb = $fin ;
        $i++ ;
    } ; # fin pour i
  } ; # fin tant que

  # fermeture du fichier de sortie formatée

  close(FSDF) ;

  # fermeture du fichier dbf avec indicateur de fin de fichier

  print FDBF &valx(26) ;
  close(FDBF) ;
  print "Conversion en Dbase -> $fDbase et $fstr\n" ;

  return ;

} ; # fin sub conversion_Dbase


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

sub conversion_Mysql() {

  my $fMysql = $nomBase.".msql" ;
  print "Conversion en Mysql -> $fMysql\n" ;
  open(FCNV,">$fMysql") or die(" impossible d'écrire dans $fMysql.\n") ;

  print FCNV "# $fMysql -- construit par cf ; $dateHeure (gH) \n\n" ;

  if ($presLabel==0) {
    print " impossible de poursuivre : noms des colonnes en ligne 1 non fournis.\n" ;
    return -1 ;
  } ; # fin si sur presLabel

  # suppression éventuelle de l'ancienne table

  print FCNV "drop table if exists $nomBase ;\n" ;

  # création de la table

  $jcol = 1 ;
  $rLabels = "create table $nomBase (\n" ;
  while ($jcol<=$nbc) {
    $nomcol   = &sprintG(15,$nomCol[$jcol]) ;
    if ($jcol==1) {
       $rLabels .= "   $nomcol varchar(".$longCol[$jcol].") not null" ;
    } else {
       $rLabels .= "   $nomcol int(".$longCol[$jcol].") not null" ;
    } ; # fin si sur jcol=1
    if ($jcol<$nbc) { $rLabels .= "," ; } ;
    $rLabels .= "\n" ;
    $jcol++ ;
  } ; #  fin tant que sur jcol
  $rLabels .= ") ;" ;
  print FCNV "$rLabels\n" ;

  if ($presLabel==0) {
    $nomMat = $nomBase ;
  } else {
    $nomMat = $nomBase."[1:nbl,2:nbc] " ;
  } ; # fin de si sur presLabel

  # insertion dans la table

  $ilig = 1 ;
  while ($ilig<=$nbl) {
    $ligIns  = "replace into $nomBase values(" ;
    $jcol = 1 ;
    while ($jcol<=$nbc) {
      if ($jcol==1) {
         $ligIns .= "'$matData[$ilig][$jcol]'" ;
      } else {
         $ligIns .= $matData[$ilig][$jcol] ;
      } ; # fin si sur jcol=1
      if ($jcol<$nbc) { $ligIns .= "," ; } ;
      $jcol++ ;
     } ; #  fin tant que sur jcol
    $ligIns .= ") ;" ;
    print FCNV "$ligIns\n" ;
    $ilig++ ;
  } ; #  fin tant que sur ilig
  # REPLACE INTO eusers VALUES (7,2,2000,'buldawg02@aol.com','buldawg02',173,'ebay');

  print FCNV "\n# pour vérification : " ;
  print FCNV "\n    select count(*) from $nomBase ;\n" ;

  print FCNV "\n# -- fin de $fMysql\n" ;
  close(FCNV) ;
} ; # fin sub conversion_Mysql

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

sub conversion_Rbase() {

  my $fRbase = $nomBase.".r" ;
  print "Conversion en Rbase -> $fRbase\n" ;
  open(FCNV,">$fRbase") or die(" impossible d'écrire dans $fRbase.\n") ;

  print FCNV "# $fRbase -- construit par cf ; $dateHeure (gH) \n" ;
  print FCNV "\n   source(\"statgh.r\") ;\n\n" ;

  print FCNV "   $nomBase   <-   read.table(\"$nomfDat\",header=TRUE) ; \n" ;
  print FCNV "   dims   <-   dim($nomBase) ; \n" ;
  print FCNV "   nbl    <-   dims[1] ; \n";
  print FCNV "   nbc    <-   dims[2] ; \n\n" ;

  if ($presLabel==0) {
    print " impossible de poursuivre : noms des colonnes en ligne 1 non fournis.\n" ;
    return -1 ;
  } ; # fin si sur presLabel

  $jcol = 1 ;
  $rLabels = "" ;
  while ($jcol<=$nbc) {
    $nomcol = sprintG(10,$nomCol[$jcol]) ;
    print FCNV "   $nomcol <- ".$nomBase."[,".$jcol."] ; \n" ;
    if ($jcol>1) {
       $rLabels .= "\"".$nomCol[$jcol]."\"" ;
       if ($jcol<$nbc) { $rLabels .= "," ; } ;
    } ; # fin si sur jcol > 1
    $jcol++ ;
  } ; #  fin tant que sur jcol

  if ($presLabel==0) {
    $nomMat = $nomBase ;
  } else {
    $nomMat = $nomBase."[1:nbl,2:nbc] " ;
  } ; # fin de si sur presLabel
  print FCNV "\n   laMat <- $nomMat ; \n" ;
  print FCNV "\n   allQT(laMat,c($rLabels)); \n\n" ;

  print FCNV "\n# -- fin de $fRbase\n" ;
  close(FCNV) ;

} ; # fin sub conversion_Rbase

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

sub conversion_Sas() {

  # il faut analyser la ligne 1 de la sortie cadrée pour trouver le cadrage

  $nomfTxt = $nomBase.".txt" ;

  open(FTXT,"<$nomfTxt") or die(" impossible d'ouvrir $nomfTxt en lecture \n") ;
  $nbltxt = 0 ;

  while (<FTXT>) {
    $ligTxt  = $_ ;
    $nbltxt++ ;
    if ($nbltxt==1) {
         $nCol   = 1 ;
         $ligneD = $ligTxt ;
         $longCol[$nCol] = 0 ;
         $iCol   = 0 ;
         $lonLig = length($ligneD) ;
         while ($iCol<$lonLig) {
           $carC = substr($ligneD,$iCol,1) ;
           $carP = substr($ligneD,$iCol-1,1) ;
           if (($carC eq " ") and ($carP ne " ")) {
              $nCol++ ;
              $longCol[$nCol] = 0 ;
           } ; # fin de si
           $iCol++ ;
           $longCol[$nCol]++ ;
         } ; # fin tant que
         $nbCol = $nCol ;
         ###print "                  1         2         3         4         5         6\n" ;
         ###print " ligne : 1234567890123456789012345678901234567890123456789012345678901234\n" ;
         ###print " ligne : $ligneD avec $lonLig car ; donc $nbCol col\n" ;
         $nCol =  1;
         while ($nCol<$nbCol) {
           if ($nCol==1) { $debCol[$nCol] = 1 } else {  $debCol[$nCol] = $finCol[$nCol-1] + 1 }  ;
           $finCol[$nCol] = $debCol[$nCol] + $longCol[$nCol] - 1  ;
           ###print " col $nCol long = ". $longCol[$nCol]." de ".$debCol[$nCol]." à ".$finCol[$nCol]."\n" ;
           $nCol++ ;
         } ; # fin tant que
         leave ;
      } ; # fin # analyse de la ligne deux
  } ; # fin tant que
  close(FTXT) ;

  my $fSas = $nomBase.".sas" ;
  print "Conversion en Sas   -> $fSas\n" ;

  open(FCNV,">$fSas") or die(" impossible d'écrire dans $fSas.\n") ;
  print FCNV "/* $fSas -- construit par cf ; $dateHeure (gH) */\n" ;
  print FCNV "/* s'utilise par %include('$fSas') ; */\n\n" ;

  print FCNV "   filename $nomBase '$nomBase.txt' ; \n" ;
  print FCNV "   data $nomBase ; \n" ;
  print FCNV "      infile $nomBase ; \n" ;

  if ($presLabel==0) {
    print " impossible de poursuivre : noms des colonnes en ligne 1 non fournis.\n" ;
    return -1 ;
  } ; # fin si sur presLabel

  $jcol    = 1 ;
  $rLabels = "      input " ;
  while ($jcol<=$nbc) {
    # sas demande au plus 8 caractères par colonne
    $nomcol   =  substr($nomCol[$jcol]." "x8,0,7) ;
    $nomcol   =~ s/ //g ;
    $rLabels .= $nomcol." " ;
    if ($jcol==1) { $rLabels .= " \$ " ; } ;
    $rLabels .= $debCol[$jcol]."-".$finCol[$jcol]." " ;
    $jcol++ ;
    if (length($rLabels)>70) {
       print FCNV "$rLabels\n" ;
       $rLabels = " "x6 ;
    } ; # fin de si
  } ; #  fin tant que sur jcol
  $rLabels .= " ; " ;

  print FCNV "$rLabels\n" ;

  print FCNV "\n   * pour v‚rification ; \n" ;
  print FCNV "   proc print data=$nomBase ; \n" ;
  print FCNV "   run ; \n " ;

  print FCNV "\n\n/* -- fin de $fSas */\n" ;
  close(FCNV) ;

} ; # fin sub conversion_Sas()

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

# programme principal

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


$ligSyntax = "cf [ [options] Nom_Dossier [ D | M | R | S | A ] | --help ]"  ;

if (($#ARGV==-1)or ($ARGV[0] eq "--help")) { &syntaxe() ; exit 0 } ;

$ligArg  = " ".join(" ",@ARGV)." " ;
##print " arguments : *$ligArg* \n " ;

# détection des options et récupération du nom de dossier

$numArg  = 0 ;
while ((substr($ARGV[$numArg],0,1) eq "-") and ($numArg<=$#ARGV)) { $numArg++ ; } ;

if  ($numArg>$#ARGV) {
    print " Erreur ! vous n'avez pas donné le nom du dossier à traiter\n" ;
    print " Rappel de la syntaxe : \n" ;
    print "        $ligSyntax\n" ;
    exit -1 ;
} ; # fin si

$nomBase = $ARGV[$numArg] ;
$nomfDat = $nomBase ;
##print " 1 - *$numArg* donc $nomBase ET $nomfDat \n" ;
if(substr($nomfDat,-4,4) ne ".dat") {
   $nomBase = $nomfDat ; $nomfDat .= ".dat" ;
} else {
   $nomBase = substr($nomBase,0,length($nomBase)-4) ;
} ; # fin de si
##print " 2 - *$numArg* donc $nomBase ET $nomfDat \n" ;

$dateHeure = &datHeur() ;

# détection des formats de conversion

$cnv_all   = 0 ;
$cnv_Dbase = 0 ;
$cnv_Mysql = 0 ;
$cnv_Rbase = 0 ;
$cnv_Sas   = 0 ;

while ($numArg<=$#ARGV) {
##print " ".$ARGV[$numArg]." vu \n" ;
    if ($ARGV[$numArg] eq "A") { $cnv_all  = 1 ; } ;
    if ($ARGV[$numArg] eq "D") { $cnv_Dbase = 1 ; } ;
    if ($ARGV[$numArg] eq "M") { $cnv_Mysql = 1 ; } ;
    if ($ARGV[$numArg] eq "R") { $cnv_Rbase = 1 ; } ;
    if ($ARGV[$numArg] eq "S") { $cnv_Sas   = 1 ; } ;
    $numArg++ ;
} ; # fin tant que

if ($cnv_all==1) {
   $cnv_all   = 1 ;
   $cnv_Dbase = 1 ;
   $cnv_Mysql = 1 ;
   $cnv_Rbase = 1 ;
   $cnv_Sas   = 1 ;
} ; # fin si toutes conversions

# lecture des données

$presLabel     = 0 ; # indicateur de label des colonnes
$nbCnv = $cnv_Dbase + $cnv_Mysql + $cnv_Rbase + $cnv_Sas ;
print  "Analyse du fichier $nomfDat :\n" ;

($nbl,$nbc) = litDonnees($nomfDat) ;

$f_nbT      = sprintf("%4d",$nblT) ;
$f_nbl      = sprintf("%4d",$nbl) ;
$f_nbL      = sprintf("%4d",$presLabel) ;
$f_nbc      = sprintf("%4.1f",$nbc) ;
$f_nbv      = sprintf("%4d",$nbv) ;

print "   $f_nbT   ligne(s) en tout \n" ;
print "   $f_nbl   ligne(s) de données \n" ;
print "   $f_nbL   ligne    d'intitulé des colonnes \n" ;
print "   $f_nbv   ligne(s) vide(s) NON RETENUE(S)\n" ;
print "     $f_nbc colonne(s) par ligne (en moyenne) \n" ;

# traitement des options

if (index($ligArg," -fl ")>=0) { &ajouteLigneUn() } ;
if (index($ligArg," -fs ")>=0) { &creeFstr() } ;
if (index($ligArg," -ft ")>=0) { &sortieCadree() } ;

# traitement des conversions

if ($nbCnv>0)      { &sortieCadree()     ; } ;
if ($cnv_Dbase==1) { &conversion_Dbase() ; } ;
if ($cnv_Mysql==1) { &conversion_Mysql() ; } ;
if ($cnv_Rbase==1) { &conversion_Rbase() ; } ;
if ($cnv_Sas  ==1) { &conversion_Sas()   ; } ;

# -- fin de cf.pl