source: subversion/applications/utils/cadastre-france/cadget @ 24316

Revision 24316, 13.9 KB checked in by ocroquette, 3 years ago (diff)

Added support for vector cadaster sheets

  • Property svn:executable set to *
Line 
1#!/usr/bin/env perl -w
2
3use strict;
4use LWP;
5use Data::Dumper;
6use URI::Escape qw( uri_escape );
7use POSIX;
8use Getopt::Long;
9use Pod::Usage;
10use File::Copy;            # move
11use File::Spec::Functions; # catfile
12use File::Path qw(mkpath);
13use Digest::MD5;
14
15sub write_binfile {
16    my ($path, $content) = @_;
17    die "Missing path" if ! $path;
18    open(OUT, "> $path") || die "Could not write into $path";
19    binmode(OUT);
20    print OUT $content;
21    close OUT;
22}
23
24sub file_md5 {
25    my $file = shift || die "No path provided";
26    open(FILE, $file) or die "Can't open '$file': $!";
27    binmode(FILE);
28    my $md5 = Digest::MD5->new;
29    while (<FILE>) {
30        $md5->add($_);
31    }
32    close(FILE);
33    return $md5->hexdigest;
34}   
35
36my $ville;
37my $departement;
38my $feuille;
39my $agrandissement = 0.08;
40my $repertoire;
41my $garderTuiles;
42my $transparence;
43my $rognage = 1;
44
45# Le serveur renvoie  un fichier PNG affichant un message d'erreur
46# sous forme graphique dans certaines situations :
47my %mapMd5versErreur = (
48    "1e381cc332f1e2f38575d4e89701b8a9" => "Aucune carte avec les caractéristiques demandées n'est disponible", 
49    "126813103185c78725506506f1724ee3" => "Serveur indisponible",
50);
51   
52my $tmpFilename = tmpnam() . ".png";
53
54{
55    my ($help);
56    # Gestion des arguments :
57    GetOptions(
58            "ville=s"        => \$ville,
59            "departement=s"  => \$departement,
60            "feuille=s"      => \$feuille,
61            "agrandissement=f" => \$agrandissement,
62            "repertoire=s"   => \$repertoire,
63            "gardertuiles"   => \$garderTuiles,
64            "transparence"   => \$transparence,
65            "rognage!"       => \$rognage,
66            "help"           => \$help,
67            ) or pod2usage(2);
68   
69    ( $ville && $departement ) or pod2usage(2);
70    ( ! @ARGV ) or pod2usage(2);
71    pod2usage(2) if $help;
72    if ( $departement =~ /^\d{1,2}$/ ) {
73        $departement = sprintf ("%03d", $departement);
74    }
75    $repertoire = getcwd if ! defined($repertoire);
76}
77
78my $browser = LWP::UserAgent->new( );
79$browser->cookie_jar( {} );
80$browser->env_proxy();
81
82if ( 0 ) {
83    # Pour débugger les échanges HTTP :
84    my $maxlength = 100;
85    $browser->add_handler("request_send",  sub { shift->dump(maxlength=>$maxlength); return });
86    $browser->add_handler("response_done", sub { shift->dump(maxlength=>$maxlength); return });
87}
88
89my $repertoireTuiles = catfile($repertoire, "tuiles");
90
91foreach my $r ($repertoire, $repertoireTuiles) {
92    if ( $r && ! -d $r ) {
93        print "Création de $r...\n";
94        mkpath($r);
95    }
96
97    if ( $r && ! -d $r ) {
98        die "\"$r\" n'est pas un répertoire valide, et impossible de le créer";
99    }
100}
101
102my $response;
103
104print "Initialisation de la navigation et création du cookie...\n";
105$response = $browser->get("http://www.cadastre.gouv.fr/scpc/rechercherPlan.do");
106
107$response->is_error && die "Erreur de communication: " . $response->message;
108
109print "Activation de la commune...\n";
110$response = $browser->post(
111  'http://www.cadastre.gouv.fr/scpc/rechercherPlan.do',
112  [
113    'numeroVoie'  => "",
114    'indiceRepetition'  => "",
115    'nomVoie'  => "",
116    'lieuDit'  => "",
117    'ville'  => $ville,
118    'lieuDit'  => "",
119    'codePostal'  => "",
120    'codeDepartement'  => $departement,
121    'nbResultatParPage'  => 10,
122    'x' => 31,
123    'y' => 11,
124  ],
125);
126
127my $formatCadastre = ( $response->{_content} =~ "Vue d.ensemble de la commune" ? "vecteur" : "image" );
128# L'agrandissement est différent entre vecteur et image, 10 est un nombre magique pragmatique :
129$agrandissement *= 10 if $formatCadastre eq "vecteur";
130
131print "Récupération de la liste des feuilles...\n";
132$response = $browser->get("http://www.cadastre.gouv.fr/scpc/listerFeuillesParcommune.do?keepVolatileSession=&offset=1000");
133$response->is_error && die "Erreur de communication: " . $response->message;
134
135my @feuilles;
136{
137    my %feuilles;
138    while ( $response->{_content} =~ m/(afficherCarteFeuille|afficherCarteTa)\.do\?f=([0-9A-Za-z_]+)/g ) {
139        $feuilles{$2}++;
140    }
141    @feuilles = keys(%feuilles);
142}
143
144if ( ! @feuilles ) {
145    print STDERR "Impossible de récupérer la liste des feuilles\n";
146    print "Vérifier la ville (\"$ville\") et le département (\"$departement\")\n";
147    exit(1);
148}
149
150if ( $feuille ) {
151    if ( ! grep { $_ eq $feuille } @feuilles ) {
152        print STDERR "La feuille \"$feuille\" n'est pas disponible. Liste des feuilles:\n  " . join("\n  ", @feuilles) . "\n";
153        exit(1);
154    }
155    # On garde seulement la feuille de l'utilisateur :
156    @feuilles  = ($feuille);
157}
158
159@feuilles = sort @feuilles;
160print "Récupération de " . @feuilles . " feuille(s)...\n";
161
162my $nFeuille = 0;
163for my $feuille (@feuilles) {
164    $nFeuille++;
165
166    # Nom de base pour stocker les tuiles et la feuille :
167    my $basename = "$departement-$ville-$feuille-$agrandissement";
168    $basename =~ s/\s/_/g;
169
170    my $feuilleFilename = $basename . "-feuille.png";
171    my $feuilleFilepath = catfile($repertoire, $feuilleFilename);
172   
173    if ( -f $feuilleFilepath ) {
174        printf "  La feuille $feuille (%d/%d) est déjà prête (%s)\n", $nFeuille, 1+$#feuilles, $feuilleFilename;
175        next;
176    }
177
178    printf "  Activation de la feuille %s (%d/%d)...\n", $feuille, $nFeuille, 1+$#feuilles;
179    $response = $browser->get("http://www.cadastre.gouv.fr/scpc/afficherCarteFeuille.do?f=$feuille&dontSaveLastForward&keepVolatileSession=");
180    $response->is_error && die "Erreur de communication: " . $response->message;
181   
182   
183    my ($xmin, $ymin, $xmax, $ymax);
184    {
185        my $content = $response->{_content};
186        $content =~ s/[\s\n]+/ /g;
187        $content =~ m/new GeoBox\s*\((.*?)\)/;
188        my $s = $1;
189        die "Impossible de récupérer la bbox pour $feuille" if ! $s;
190        $s =~ s/\s+//g;
191        $s =~ m/([0-9\.]+),([0-9\.]+),([0-9\.]+),([0-9\.]+)/ or die "Impossible de parser la bbox pour $feuille ($s)";
192        ($xmin, $ymin, $xmax, $ymax) = ($1, $2, $3, $4);
193    }
194    # print "Trouvé la bbox: " . join(", ", ($xmin, $ymin, $xmax, $ymax)) . "\n";
195   
196    # Taille maximale acceptée par le serveur :
197    my $width = 1100;
198    my $height = 850;
199   
200    my ($x1, $y1, $x2, $y2) = ($xmin, $ymin, $xmin, $ymin);
201   
202    my ($i, $j, $n) = ( 0, 0, 0);
203   
204    my ($xd, $yd) = ( $width / $agrandissement, $height / $agrandissement);
205   
206    my ($xtiles, $ytiles) = ( ceil(($xmax-$xmin)/$xd), ceil(($ymax-$ymin)/$yd));
207   
208   
209    my @tuileFilepaths;
210
211    # Téléchargement des tuiles :   
212    while ( $j < $ytiles ) {
213        $y2 = $ymax - $j * $yd;
214        $y1 = $y2 - $yd;
215        $i=0;
216        while ( $i < $xtiles ) {
217            $n++;
218            $x1 = $xmin + $i * $xd;
219            $x2 = $x1 + $xd;
220            $i++;
221   
222            my $tuileFilename = sprintf "%s-tuile-%05d.png", $basename, $n;
223            my $tuileFilepath = catfile($repertoireTuiles, $tuileFilename);
224            push @tuileFilepaths, $tuileFilepath;
225            if ( -f $tuileFilepath && ! $mapMd5versErreur{file_md5($tuileFilepath)} ) {
226                printf "    La tuile %3d sur %3d est déjà téléchargée (%s).\n", $n,  ($xtiles * $ytiles), $tuileFilename;
227                next;
228            }
229
230            my %params = (
231                bbox      => "$x1,$y1,$x2,$y2",
232                exception => "application/vnd.ogc.se_inimage",
233                format    => "image/png",
234                height    => $height,
235                layers    => undef, # voir ci-dessous
236                request   => "GetMap",
237                styles    => undef, # voir ci-dessous
238                version   => "1.1",
239                width     => $width,
240            );
241           
242            if ( $formatCadastre eq "image" ) {
243                $params{layers} = "CDIF:PMC\@$feuille,CDIF:DRAPEAU";
244                $params{styles} = "";
245            }
246            else {
247                $params{layers} = "CDIF:LS3,CDIF:LS2,CDIF:LS1,CDIF:PARCELLE,CDIF:NUMERO,CDIF:PT3,CDIF:PT2,CDIF:PT1,CDIF:LIEUDIT,CDIF:SUBSECTION,CDIF:SECTION,CDIF:COMMUNE";
248                $params{styles} = "LS3_90,LS2_90,LS1_90,PARCELLE_90,NUMERO_90,PT3_90,PT2_90,PT1_90,LIEUDIT_90,SUBSECTION_90,SECTION_90,COMMUNE_90";
249            }
250           
251            my $params = join("&", map { $_ . "=" . ($params{$_}) } keys(%params) );
252            my $url = "http://www.cadastre.gouv.fr/scpc/wms?$params";
253           
254            my $succes = 0;
255            my $essais = 0;
256            my $maxEssais = 3;
257            while ( ! $succes ) {
258                $essais++;
259                printf "    Récupération de la tuile %3d sur %3d pour la feuille %s (Bbox: %06.0f,%06.0f,%06.0f,%06.0f)\n", $n, $xtiles * $ytiles, $feuille, $x1, $y1, $x2, $y2;
260                print "     Essai $essais / $maxEssais\n" if $essais > 1;
261                $response = $browser->get($url);
262                $succes = 1;
263                my $md5 = Digest::MD5::md5_hex($response->{_content});
264                my $erreur = $mapMd5versErreur{$md5};
265                if ( $response->is_error ) {
266                    print STDERR "Erreur de communication: " . $response->message . " (essai $essais)\n";
267                    $succes = 0;
268                }
269                elsif ( $erreur ) {
270                    print STDERR "Le serveur du cadastre a renvoyé une erreur (\"$erreur\")\n";
271                    $succes = 0;
272                }
273               
274                if ( ! $succes && $essais >= $maxEssais ) {
275                    die "Trop d'erreur, abondon";
276                }
277                elsif ( ! $succes ) {
278                    printf "    La tuile %3d sur %3d pour la feuille %s va être téléchargée à nouveau\n", $n, $xtiles * $ytiles, $feuille;
279                }
280            }
281            write_binfile($tmpFilename, $response->{_content}) or die "Impossible d'écrire $tmpFilename";
282            move($tmpFilename, $tuileFilepath) or die "Impossible d'écrire $tuileFilepath";
283        }
284        $j++;
285    }
286   
287    {
288        # Collage des tuiles, nécessite ImageMagick :
289        printf "  Collage des tuiles pour créer la feuille \"%s\" dans \"%s\"...\n", $feuille, $feuilleFilename;
290
291        my @params = ("montage", @tuileFilepaths, "-tile", "${xtiles}x${ytiles}", "-geometry", "${width}x$height+0+0");
292        system(@params, $tmpFilename) and die "montage a retourné une erreur";
293
294        @params = ("convert", $tmpFilename);
295        # -trim permet de retirer le bord tout blanc automatiquement
296        push @params, "-trim" if $rognage;
297
298        if ( ! $transparence ) {
299            push @params, "png8:".$feuilleFilepath;
300            system(@params) and die "convert a retourné une erreur";
301        }
302        else {
303            printf "  Conversion en image transparente pour la feuille \"%s\" dans \"%s\"...\n", $feuille, $feuilleFilename;
304            if ( $formatCadastre eq "image" ) {
305                push @params, (qw(-negate -alpha set  -channel RGBA -fill none -opaque black), $feuilleFilepath);
306            }
307            else {
308                push @params, (qw(-alpha set  -channel RGBA -fill none -opaque white), $feuilleFilepath);
309            }
310           
311            system(@params) and die "convert a retourné une erreur";
312        }
313    }
314   
315    unless ( $garderTuiles ) {
316       printf "  Effacement des tuiles de la feuille \"%s\"...\n", $feuille;
317       unlink @tuileFilepaths;
318    }
319}
320
321unless ( $garderTuiles ) {
322   printf "Suppression du répertoire des tuiles\n";
323   rmdir($repertoireTuiles) or warn "Impossible de supprimer $repertoireTuiles : $!";
324}
325
326print "Terminé.\n";
327
328__END__
329=head1 NAME
330
331cadget - Télécharge les feuilles du cadastre sous forme d'image PNG
332
333=head1 SYNOPSIS
334
335   cadget --ville "LA VILLE" --departement NUM [--feuille NOM] [--agrandissement FLOAT] --repertoire [chemin]
336
337   cadget --help
338
339   ATTENTION:
340   - le collage des tuiles nécessite ImageMagick
341   
342Options:
343
344   --ville          Le nom de la ville, par exemple "LE BUGUE"
345   --departement    Le numéro du département, par exemple "24"
346   --feuille        (optionel) Le nom de la feuille à récupérer spécifiquement, par exemple "C3067000AB01"
347   --agrandissement (optionel) le facteur d'agrandissement, 0.08 par défaut. Valeurs empiriques raisonnables: 0.08 à 0.5
348   --repertoire     (optionel) répertoire dans lequel sauvegarder les tuiles et le résultat final
349   --gardertuiles   (optionel) permet de garder les fichiers PNG correspondant aux tuiles (effacées par défaut)
350   --transparence   (optionel) transforme la feuille finale pour un affichage blanc sur transparent (au lieu de noir sur blanc)
351   --norognagne     (optionel) désactive le rognage automatique des bords blancs
352   --help L'aide
353
354Pour connaitre les noms exactes des villes et feuilles, faire une recherche sur http://www.cadastre.gouv.fr
355
356Exemples:
357   Pour télécharger les feuilles de "LE BUGUE" en Dordogne avec une précision faible:
358     cadget --ville "LE BUGUE" --departement 24
359   Ou en plus court :
360     cadget -v "LE BUGUE" -d 24
361
362   Pour télécharger les feuilles du Buisson-de-Cadouin en Dordogne avec une précision élevée:
363     cadget -v "LE BUISSON-DE-CADOUIN" -d 24 -a 0.4
364
365   Pour faciliter le travail de superposition dans JOSM, utiliser l'option --transparence (-t) :
366     cadget -v "LE BUGUE" -d 24 -t
367   
368Pour plus d'information, voir aussi :
369http://wiki.openstreetmap.org/wiki/WikiProject_Cadastre_Français/cadget
370
371=head1 HISTORIQUE
372
3732010-11-21
374  Correction d'un bug concernant l'option --repertoire
375  Ajout du support pour les feuilles au format vecteur (téléchargées sous forme de PNG aussi)
376
3772010-11-16
378  Ajout du support des tableaux d'assemblage
379
3802010-11-04 (2)
381  Support des proxy via la variable d'environnment http_proxy
382
3832010-11-04
384  Ajout de l'option -transparence pour faciliter le travail de superposition (dans JOSM)
385  Les bords inutiles (blancs) sont désormais supprimés
386  Sans l'option -transparence, la sortie PNG est désormais en couleurs indexées pour alléger les fichiers
387  Les tuiles sont désormais téléchargées dans un sous-repertoire
388  Corrigé: erreur à propos de make_path avec de vieilles versions des librairies
389 
3902010-10-26
391  Seules les communes de Dordogne marchaient. Corrigé.
392  Ajout de l'option --gardertuiles
393
394=cut
Note: See TracBrowser for help on using the repository browser.