#!/usr/bin/perl
# Fichier de transformation EDIGEO vers PostgreSQL
# Récupère un fichier THF d'une arborescence EDIGEO
# et génère un fichier SQL pour injection dans une
# Base de données PostgreSQL + PostGIS
#
# Copyright 2005, Médéric RIBREUX (mederic.ribreux@gmail.com)

use strict;
use Getopt::Std;
use vars qw($VERSION $opt_a $opt_r $opt_o $opt_p $opt_l $opt_h $opt_f $opt_s);
use vars qw(@liste_bloc %liste_OBJ %liste_relations %liste_points %liste_arcs %liste_polygones %liste_tables);

$VERSION = '0.45';

getopts("hp:s:l:o:r:a:");

if ($opt_h) { usage(); exit(0); }
if ($opt_p) { recup_POINT($opt_p); exit(0); }
if ($opt_l) { recup_LINES($opt_l); exit(0); }
if ($opt_s && $opt_o) { recup_GEOOBJ($opt_o,$opt_s); exit(0);}
if ($opt_s && !$opt_o) { recup_SCD($opt_s); exit(0);}
if ($opt_r) { recup_RELATION($opt_r); exit(0); }
if ($opt_a) { recup_POLY($opt_a); exit(0); }

# Si erreur d'arguments:
usage();
exit(0);

#------------------------------------------------------------------------------
# Fonction qui construit les objets du SCD
# arguments: recup_SCD (fichier,silent)
#	- fichier: le nom du fichier de définition de schéma
#	- silent: si 1 ne renvoie rien sur STDOUT (mode silencieux)
#------------------------------------------------------------------------------
sub recup_SCD {
my ($file,$silent,@lines,$ligne,$bloc,$name,$attr_nb,@attr,$attribut,$typ);

# Si on a plus d'un argument, on regarde la valeur de silent
if (scalar(@_)>=2) {
 $file = shift;
 $silent = shift;
}
else {
 $file = shift;
}

$file = shift;		# Nom du fichier à traiter
open(INFO, $file);		# On ouvre le fichier
@lines = <INFO>;		# on récupère tout dans une variable.
close(INFO);


# Traitement du fichier: on commence par découper le fichier en blocs
# Ces blocs sont délimités par des lignes vides
# Ensuite, pour chaque bloc, on fera de l'analyse syntaxique afin de remplir des variables
# Enfin, une fois les variables ajustées, on effectuera des actions adéquates
my $i=0;
my $j=0;
my @bloc=();
if ($silent!=1) {
print "\nCREATE SEQUENCE points_ogc_fid_seq
  INCREMENT 1
  MINVALUE 1
  MAXVALUE 9223372036854775807
  START 1
  CACHE 1;";
print "\nCREATE TABLE points(ogc_id int4 NOT NULL DEFAULT nextval('public.points_ogc_fid_seq'::text),
  nom char(50));";
print "\nSELECT AddGeometryColumn ('points','wkb_geometry',27571,'POINT',2);";

print "\nCREATE SEQUENCE lines_ogc_fid_seq
  INCREMENT 1
  MINVALUE 1
  MAXVALUE 9223372036854775807
  START 1
  CACHE 1;";
print "\nCREATE TABLE lines(ogc_id int4 NOT NULL DEFAULT nextval('public.lines_ogc_fid_seq'::text),
  nom char(50));";
print "\nSELECT AddGeometryColumn ('lines','wkb_geometry',27571,'LINESTRING',2);";

print "\nCREATE SEQUENCE polygones_ogc_fid_seq
  INCREMENT 1
  MINVALUE 1
  MAXVALUE 9223372036854775807
  START 1
  CACHE 1;";
print "\nCREATE TABLE polygones(ogc_id int4 NOT NULL DEFAULT nextval('public.lines_ogc_fid_seq'::text),
  nom char(50));";
print "\nSELECT AddGeometryColumn ('polygones','wkb_geometry',27571,'POLYGON',2);";
}
foreach $ligne (@lines) {
 # Quand on trouve un objet, on place un flag
 if ($ligne =~ m/^RTYSA03:/ ) {
 if ($i==1) {
  if ($silent!=1) {
  print "\nCREATE SEQUENCE ".lc($name)."_ogc_fid_seq
  INCREMENT 1
  MINVALUE 1
  MAXVALUE 9223372036854775807
  START 1
  CACHE 1;";
  print "\nCREATE TABLE ".lc($name)." (ogc_id int4 NOT NULL DEFAULT nextval('public.".$name."_ogc_fid_seq'::text), nom char(50)";
  foreach $attribut (@attr) {
  print ", ".$attribut." char(255)";
  }
  print ");";
 
  print "\nSELECT AddGeometryColumn ('".lc($name)."','wkb_geometry',27571,".$typ.",2);";
  }
  $liste_tables{lc($name)}=$typ;
  $i=0; @attr=();

 }
 if ($ligne =~ m/^RTYSA03:OBJ/ ) { $i=1;}
 }
 
 # Quand on trouve le nom de l'objet, on le récupère:
 if ($ligne =~ m/^RIDSA/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $name=$buf{ZV};
 }

 # Quand on trouve le type de l'objet, on le stocke
 if ($ligne =~ m/^KNDSA03/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $typ="'GEOMETRY'";
 if ($buf{ZV}=~ m/PCT/) { $typ="'POINT'";}
 if ($buf{ZV}=~ m/LIN/) { $typ="'LINESTRING'";}
 if ($buf{ZV}=~ m/ARE/) { $typ="'POLYGON'";}
 }

 # Quand on trouve le nombre d'attributs, on le récupère et on place un flag:
 if ($ligne =~ m/^AACSN/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $attr_nb=$buf{ZV};
 }

 # Quand on trouve un attribut, on le stocke:
 if ($ligne =~ m/^AAPCP/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 push(@attr,substr ($buf{ZV},rindex($buf{ZV},";")+1));
 }
}
}

# Fonction qui construit les points géographiques
# En argument: le nom du fichier .VEC
sub recup_POINT {
my ($file,$silent,@lines,$ligne,$bloc,$name,$attr_nb,@attr,$attribut,$X,$Y);

# Si on a plus d'un argument, on regarde la valeur de silent
if (scalar(@_)>=2) {
 $file = shift;
 $silent = shift;
}
else {
 $file = shift;
}

#print "Nom du fichier à traiter:".$file;
open(INFO, $file);		# On ouvre le fichier
@lines = <INFO>;		# on récupère tout dans une variable.
close(INFO);


my $i=0;
my $j=0;
my @bloc=();

foreach $ligne (@lines) {
 # Si on a une définition d'objet géographique,
 if ($ligne =~ m/^RTYSA03/ ) {
 
 # Si on est en cours de création d'un objet, on ferme tout: 
 if ($i==1) {
  if ($silent!=1) {
  print "\nINSERT INTO points (wkb_geometry,nom) VALUES (GeomFromText('POINT(".$X." ".$Y.")',27571),'".lc($name)."');";
 }
 $i=0;
 
 }
 if ($ligne =~ m/RTYSA03:PNO/) {$i=1; }
 }
 
 # Quand on trouve le nom de l'objet, on le récupère:
 if ($ligne =~ m/^RIDSA/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $name=$buf{ZV};
 }

 # Quand on trouve le nombre d'attributs, on le récupère et on place un flag:
 if ($ligne =~ m/^AACSN/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $attr_nb=$buf{ZV};
 }

 # Quand on trouve un attribut, on le stocke:
 if ($ligne =~ m/^AAPCP/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 push(@attr,substr ($buf{ZV},rindex($buf{ZV},";")+1));
 }
 
 # Quand on trouve les coordonnées, on les stocke:
 if ($ligne =~ m/^CORCC/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 chop($buf{ZV});
 $X = substr($buf{ZV},0,index($buf{ZV},";"));
 $Y = substr($buf{ZV},length($X));
 $X =~ s/\+//;
 $Y =~ s/[;\+]+//;
 }

}
}


#------------------------------------------------------------------------------
# Fonction qui récupère les arcs
# Arguments: recup_LINES (fichier,silent)
#	- fichier = nom du fichier vecteur contenant les définitions de polygones
#	- silent = si silent existe et vaut 1, on n'affiche rien.
#------------------------------------------------------------------------------
sub recup_LINES {
my ($file,$silent,@lines,$ligne,$bloc,$name,$attr_nb,@attr,$attribut,$coords,$X,$Y);

# Si on a plus d'un argument, on regarde la valeur de silent
if (scalar(@_)>=2) {
 $file = shift;
 $silent = shift;
}
else {
 $file = shift;
}

open(INFO, $file);		# On ouvre le fichier
@lines = <INFO>;		# on récupère tout dans une variable.
close(INFO);


my $i=0;
my $j=0;
my @bloc=();

foreach $ligne (@lines) {
 # Si on a une définition d'objet géographique,
 if ($ligne =~ m/^RTYSA03/ ) {
 
 # Si on est en cours de création d'un objet, on ferme tout: 
 if ($i==1) {
  if ($silent!=1) { print "\nINSERT INTO lines (wkb_geometry,nom) VALUES (GeomFromText('LINESTRING(".$coords.")',27571),'".$name."');"; }
  $i=0;
  $liste_arcs{$name}=$coords;
 }
 if ($ligne =~ m/RTYSA03:PAR/) {$i=1;$coords=""; }
 }
 
 # Quand on trouve le nom de l'objet, on le récupère:
 if ($ligne =~ m/^RIDSA/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $name=$buf{ZV};
 }

 # Quand on trouve le nombre d'attributs, on le récupère et on place un flag:
 if ($ligne =~ m/^AACSN/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $attr_nb=$buf{ZV};
 }

 # Quand on trouve un attribut, on le stocke:
 if ($ligne =~ m/^AAPCP/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 push(@attr,substr ($buf{ZV},rindex($buf{ZV},";")+1));
 }
 
 # Quand on trouve les coordonnées, on les ajoute:
 if ($ligne =~ m/^CORCC/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 chop($buf{ZV});
 $X = substr($buf{ZV},0,index($buf{ZV},";"));
 $Y = substr($buf{ZV},length($X));
 $X =~ s/\+//;
 $Y =~ s/[;\+]+//;
 if ($coords=="") { $coords=$X." ".$Y; }
 else { $coords=$coords.",".$X." ".$Y; }
 }

}
}


#------------------------------------------------------------------------------
# Fonction qui récupère les polygones
# Arguments: recup_POLY (fichier,silent)
#	- fichier = nom du fichier vecteur contenant les définitions de polygones
#	- silent = si silent existe et vaut 1, on n'affiche rien.
#------------------------------------------------------------------------------
sub recup_POLY {
my ($file,$silent,@lines,$ligne,$bloc,$name,$attr_nb,@attr,$attribut,$coords,$X,$Y);

# Si on a plus d'un argument, on regarde la valeur de silent
if (scalar(@_)>=2) {
 $file = shift;
 $silent = shift;
}
else {
 $file = shift;
}

recup_RELATION($file);
recup_LINES($file,1);

open(INFO, $file);		# On ouvre le fichier
@lines = <INFO>;		# on récupère tout dans une variable.
close(INFO);


my $i=0;
my $j=0;
my $k=0;
my @bloc=();

foreach $ligne (@lines) {
my (%liste_relation_polygone,$ordre);
 # Si on a une définition d'objet géographique,
 if ($ligne =~ m/^RTYSA03/ ) {
 
 # Si on est en cours de création d'un objet, on ferme tout: 
 if ($i==1) {

  # pour chaque polygone, on va récupérer ses relations avec les arcs
  foreach $attr_nb (keys(%liste_relations)) {
   if ($liste_relations{$attr_nb} =~ m/$name/) { 
    # on ne s'interesse qu'aux arcs, le reste n'a pas de sens.
    if ($liste_relations{$attr_nb} =~ m/PAR/) {
     # Il faut récupérer le nom de l'arc:
     my @t = grep(/PAR/,split /\|/,$liste_relations{$attr_nb});
     if (scalar(@t)==1) {
      my @t2 = split(/;/,$t[0]);
      $liste_relation_polygone{$t2[3]}=$liste_arcs{$t2[3]};
     } 
     if (scalar(@t)>1) { print "unsupported !"; }
    }
   }
  }

  $j=scalar(keys(%liste_relation_polygone));
  # Deux cas: un seul arc: il s'agit d'un polygone simple:
  #print "\nNombre d'arcs:".$j;
  # Premier cas: plusieurs arcs pour un polygone => Construction par assemblage itératif
  if ($j>1) {
   my (%point_init,%point_final,@buffer_point);
   foreach $k (keys(%liste_relation_polygone)) {
   #print "\n".$k."->".$liste_relation_polygone{$k};
   }
   my ($arc_ref,$arc_dep,$arc_temp,$arc_def,@coords,@buffer_arc,$nb_ref,$nb_ref_prev);
   # on tri les arcs en fonction de leurs noeuds de départ et de fin:

   # l'arc de départ:
   @buffer_arc=keys(%liste_relation_polygone);
   $arc_dep=$buffer_arc[0];
   
   $coords[0]=$liste_relation_polygone{$arc_dep};
   delete($liste_relation_polygone{$arc_dep});
   
   # Une boucle qui assure qu'on gère tous les arcs de A à Z...
   while (scalar(keys(%liste_relation_polygone))>0) {
   
   #print ("\n Arcs à traiter:".scalar(keys(%liste_relation_polygone)));
   #foreach $k (keys(%liste_relation_polygone)) { print "\n Arc ".$k; }
   #print ("\n Coords=".$coords[-1]);

   # Gestion de la progression:
   $nb_ref_prev=$nb_ref;
   $nb_ref=scalar(keys(%liste_relation_polygone));

   # Gestion des trous:
   # Si on ne progresse plus:
   if ($nb_ref>0 && $nb_ref==$nb_ref_prev) {
   #print "\nTrou detected...";
   # On ensile les coordonnées:
   # On remet à jour l'arc de référence avec le premier qui vient:
   @buffer_arc=keys(%liste_relation_polygone);
   $arc_dep=$buffer_arc[0];
   push(@coords,$liste_relation_polygone{$arc_dep});
   # Si cet Arc est un polygone
   }

   # on extrait les noeuds finaux de l'arc de référence:
   my $init_ref=init_point($coords[-1]);
   my $final_ref=final_point($coords[-1]);
   
   #print "\ninit_ref=".$init_ref;
   #print "\nfinal_ref=".$final_ref;

   

   # on trouve les arcs qui ont des liaisons avec l'arc de référence:
   foreach $k (keys(%liste_relation_polygone)) {
    
     # cas 1: init arc_ref= final arc => Arc + Arc_ref     
     if ($init_ref eq final_point($liste_relation_polygone{$k})) {
      #print "\nCas 1:";
      $coords[-1]=final_point_delete($liste_relation_polygone{$k}).",".$coords[-1];
      #print ("\n Suppression de l'arc:".$k);
      delete($liste_relation_polygone{$k});
     }
     # cas 2: init arc_ref= init arc => invers(Arc) + Arc_ref     
     elsif ($init_ref eq init_point($liste_relation_polygone{$k})) {
      #print "\nCas 2:";
      @coords[-1]=final_point_delete(arc_inverse($liste_relation_polygone{$k})).",".@coords[-1];
      #print ("\n Suppression de l'arc:".$k);
      delete($liste_relation_polygone{$k});
     }
     # cas 3: final arc_ref= init arc => Arc_ref + Arc
     elsif ($final_ref eq init_point($liste_relation_polygone{$k})) {
      #print "\nCas 3:";
      $coords[-1]=$coords[-1].",".init_point_delete($liste_relation_polygone{$k});
      #print ("\n Suppression de l'arc:".$k); 
      delete($liste_relation_polygone{$k});
     }
     # cas 4: final arc_ref= final arc => Arc_ref + Inverse(Arc)
     elsif ($final_ref eq final_point($liste_relation_polygone{$k})) {
      #print "\nCas 4:";
      $coords[-1]=$coords[-1].",".init_point_delete(arc_inverse($liste_relation_polygone{$k}));
      #print ("\n Suppression de l'arc:".$k);
      delete($liste_relation_polygone{$k});
     }
     
   } # Fin du foreach
   } # Fin du while

   # Fabrication des coordonnées des polygones:
   $arc_ref="(".join ("),(",@coords).")";
   $liste_polygones{$name}=$arc_ref;
   if ($silent!=1) { print "\nINSERT INTO polygones (nom,wkb_geometry) VALUES ('".$name."',GeomFromText('POLYGON(".$liste_polygones{$name}.")',27571));"; }
  }
  # Deuxième cas: construction simple:
  else {
   my @buffer_arc=keys(%liste_relation_polygone);
   $liste_polygones{$name}="(".$liste_arcs{$buffer_arc[0]}.")";
   if ($silent!=1) { print "\nINSERT INTO polygones (nom,wkb_geometry) VALUES ('".$name."',GeomFromText('POLYGON(".$liste_polygones{$name}.")',27571));"; }
  }

  $i=0;
 
 }
 if ($ligne =~ m/RTYSA03:PFE/) {$i=1; }
 }
 
 # Quand on trouve le nom de l'objet, on le récupère:
 if ($ligne =~ m/^RIDSA/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $name=$buf{ZV};
 }

 
}
}

# Fonction qui récupère les objets géographiques élaborés
sub recup_GEOOBJ {
my ($file,$scd_file,@lines,$ligne,$name,$attr_nb,$attr_list,$attr_val,$coords,$X,$Y,$table);
$file = shift;		# Nom du fichier à traiter
$scd_file = shift;
recup_SCD($scd_file,1);
recup_POINT($file,1);
recup_POLY($file,1);

open(INFO, $file);		# On ouvre le fichier
@lines = <INFO>;		# on récupère tout dans une variable.
close(INFO);


my $i=0;
my $j=0;
$attr_list="";
my @bloc=();
foreach $ligne (@lines) {
 
 # Si on a une définition d'objet géographique,
 if ($ligne =~ m/^RTYSA03/ ) {
 
 # Si on est en cours de création d'un objet, on ferme tout: 
 if ($i==1) {

  # on vérifie les relations qui existent pour cet objet:
  foreach $attr_nb (keys(%liste_relations)) {
   if ($liste_relations{$attr_nb} =~ m/FEA;$name/) {
     
    # Cas 1: objet <-> point (PNO)
    if ($liste_relations{$attr_nb} =~ m/PNO/) {
     # Il faut récupérer le nom du point:
     my @t = grep(/PNO/,split /\|/,$liste_relations{$attr_nb});
     my @t2 = split(/;/,$t[0]);
     $coords=", GeomFromText('POINT(".$liste_points{$t2[3]}.")',27571)";
     $attr_list=$attr_list.",wkb_geometry";
    } # fin du cas 1 
      
    # Cas 2: objet <-> arc (PAR)
    if ($liste_relations{$attr_nb} =~ m/PAR/) {
     # Il faut récupérer le nom de l'arc:
     my @t = grep(/PAR/,split /\|/,$liste_relations{$attr_nb});
     # Si je n'ai qu'un seul arc:
     
     if (scalar(@t)==1) {
      my @t2 = split(/;/,$t[0]);
      # si c'est un arc simple:
      if (is_polygon($liste_arcs{$t2[3]}) && $liste_tables{$table} =~ m/POLYGON/) { $attr_list=$attr_list.",wkb_geometry"; $coords=", GeomFromText('POLYGON((".$liste_arcs{$t2[3]}."))',27571)"; }
      else { $attr_list=$attr_list.",wkb_geometry"; $coords=", GeomFromText('LINESTRING(".$liste_arcs{$t2[3]}.")',27571)"; }
      # Si j'ai plusieurs arcs:
      if (scalar(@t)>1) { print "Unsupported !"; }
     } # fin du scalar
    } # fin du cas 2

    # Cas 3: objet <-> face (PFE)
     if ($liste_relations{$attr_nb} =~ m/PFE/) {
     # Il faut récupérer le nom de la face:
     my @t = grep(/PFE/,split /\|/,$liste_relations{$attr_nb});
     # Si je n'ai qu'une seule face:
     
     if (scalar(@t)==1) {
      my @t2 = split(/;/,$t[0]);
      $coords=", GeomFromText('POLYGON(".$liste_polygones{$t2[3]}.")',27571)";
      $attr_list=$attr_list.",wkb_geometry";
     }
     # Si j'ai plusieurs faces:
      if (scalar(@t)>1) { print "Unsupported !"; }
     
    } # fin du cas 3
   } # fin de la recherche des relations
  } # fin du foreach (scan des relations)

 print "\nINSERT INTO ".$table." (nom".$attr_list.") VALUES ('".$name."'". $attr_val.$coords.");";

 $i=0;
 $attr_list="";
 $attr_val="";
 
 }
 if ($ligne =~ m/RTYSA03:FEA/) {$i=1;$coords=""; $attr_list="";}
 }
 
 # Quand on trouve le nom de l'objet, on le récupère:
 if ($ligne =~ m/^RIDSA/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $name=$buf{ZV};
 }

 # Quand on trouve le nombre d'attributs, on le récupère
 if ($ligne =~ m/^AACSN/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $attr_nb=$buf{ZV};
 }

 # Quand on trouve un attribut, on stocke son nom:
 if ($ligne =~ m/^ATPCP/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $attr_list=$attr_list.",".substr ($buf{ZV},rindex($buf{ZV},";")+1);
 }
 
 # Quand on trouve la valeur d'un attribut, on stocke la valeur:
 if ($ligne =~ m/^ATV/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $buf{ZV}=~ s/'+/\\'/;
 $attr_val=$attr_val.",'".$buf{ZV}."'";
 }
 # Quand on trouve la table, on l'ajoute:
 if ($ligne =~ m/^SCPCP/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 $table=substr ($buf{ZV},rindex($buf{ZV},";")+1);
 }

}

}

#------------------------------------------------------------------------------
# Fonction qui gère les relations entre objets
#------------------------------------------------------------------------------
sub recup_RELATION {
my ($file,@lines,%reference,$ligne,$bloc,$name,$attr_nb,@attr,$attribut);
my ($coords,$X,$Y,$table);

$file = shift;		# Nom du fichier à traiter
open(INFO, $file);		# On ouvre le fichier
@lines = <INFO>;		# on récupère tout dans une variable.
close(INFO);


my $i=0;
my $j=0;

$coords="";

# On scanne toutes les lignes de relation
foreach $ligne (@lines) {
 # Si on a une définition d'objet géographique,
 if ($ligne =~ m/^RTYSA03/ ) {
 
 # Si on est en cours de création d'un objet, on ferme tout: 
 if ($i==1) {
 $liste_relations{$name}=$coords;
 #print ("\nRelation ".$name.": ".$coords);
 $i=0;
 }
 if ($ligne =~ m/RTYSA03:LNK/) {$i=1;$coords="";$j=0; }
 }
 
 # Quand on trouve un élément de relation:
 if ($ligne =~ m/^FTP/ && $i==1) {
 my %buf=edigeo_enregistrement($ligne);
 if ($j==0) {$coords=$buf{ZV};$j++;}
 else { $coords.="|".$buf{ZV};  }
 }

 # Quand on trouve le nom de la liaison, on le récupère:
 if ($ligne =~ m/^RIDSA/ && $i==1) {
  my %buf=edigeo_enregistrement($ligne);
  $name=$buf{ZV};
 }

}

}
#------------------------------------------------------------------------------
# Fonction de lecture basique des enregistrements logiques EDIGEO:
# le principe:
# un enregistrement logique consiste en une ligne de texte formée de la manière suivante:
# ZN sur 3 caractères = Nom de l'enregistrement
# ZNAT sur 1 caractère = Nature de l'enregistrement
# ZF sur 1 caractère = 
#------------------------------------------------------------------------------
sub edigeo_enregistrement {
my $param=shift(@_);

my %enregistrement=("ZN",substr($param,0,3),
		    "ZNAT", substr($param,3,1),
		    "ZF" , substr($param,4,1),
		    "ZL" , substr($param,5,2),
		    "ZV", substr($param,8,substr($param,5,2)));

return %enregistrement;
 
}

#------------------------------------------------------------------------------
# Fonction qui indique si un arc est un polygone
#------------------------------------------------------------------------------
sub is_polygon {
my $param=shift;
my @t=split(/,/,$param);
if ($t[0]==$t[-1]) { return 1; }
else { return 0 };
}

#------------------------------------------------------------------------------
# Fonction qui renvoie le noeud initial d'un arc
#------------------------------------------------------------------------------
sub init_point {
my @buffer_point;
my $arc_coords=shift;
@buffer_point=split /,/ , $arc_coords;
return @buffer_point[0];
}

#------------------------------------------------------------------------------
# Fonction qui renvoie le noeud final d'un arc
#------------------------------------------------------------------------------
sub final_point {
my @buffer_point;
my $arc_coords=shift;
@buffer_point=split /,/ , $arc_coords;
return @buffer_point[-1];
}

#------------------------------------------------------------------------------
# Fonction qui supprime le noeud initial d'un arc
#------------------------------------------------------------------------------
sub init_point_delete {
my @buffer_point;
my $arc_coords=shift;
@buffer_point=split /,/ , $arc_coords;
shift (@buffer_point);
return (join (",",@buffer_point));
}

#------------------------------------------------------------------------------
# Fonction qui supprime le noeud final d'un arc
#------------------------------------------------------------------------------
sub final_point_delete {
my @buffer_point;
my $arc_coords=shift;
@buffer_point=split /,/ , $arc_coords;
pop (@buffer_point);
return (join (",",@buffer_point));
}

#------------------------------------------------------------------------------
# Fonction qui renvoie l'inverse d'un arc:
#------------------------------------------------------------------------------
sub arc_inverse {
my @buffer_point;
my $arc_coords=shift;
@buffer_point=split /,/ , $arc_coords;
return (join (",",reverse (@buffer_point)));
}

#------------------------------------------------------------------------------
# Fonction d'aide en ligne
#------------------------------------------------------------------------------
sub usage {
print <<__USAGE__;
Usage
    edigeo2pg [-h] [-v] [-s schema] [-p vecteur] [-l vecteur] [-a vecteur] [-o vecteur] 

Options
    -h
        Cette information
    -v
        Affiche la version du script
    -s schema
	Génère sur STDOUT le schéma sql de la base de données PostGIS à partir du fichier SCD


__USAGE__
}


__END__