← Back to branch summary

~kosova/+junk/openstreetmapkosova

« back to all changes in this revision

Viewing changes to ShapeToOsm.pm

  • Committer: Andreas Horst
  • Date: 2010-12-03 17:53:39 UTC
  • Revision ID: andreas@goetherad-20101203175339-mykimko25lw0cxdx
started to refactor

Show diffs side-by-side

added added

removed removed

Lines of Context:
ShapeToOsm.pm
 
1
package ShapeToOsm;
 
2
=pod 
 
3
    
 
4
=head1 description
 
5
    
 
6
=head2 usage 
 
7
 
 
8
    use ShapeToOsm;
 
9
 
 
10
ShapeToOsm::ShapeToOsm ($file,$prefix,$defaulttags,$proj);
 
11
 
 
12
=cut 
 
13
 
 
14
# Copyright (c) 2006 Gabriel Ebner <ge@gabrielebner.at>
 
15
# updated in 2008 by Tobias Wendorff <tobias.wendorff@uni-dortmund.de>
 
16
# hacks by James Michael DuPont JamesMikeDuPont@googlemail.com
 
17
# HTML-Entities based on ideas of Hermann Schw&#65533;rzler
 
18
# Gau&#65533;-Kr&#65533;ger implementation based on gauss.pl by Andreas Achtzehn
 
19
# version 1.3 (17. September 2008)
 
20
 
 
21
use Geo::ShapeFile;
 
22
use Geo::Proj4;
 
23
use HTML::Entities qw(encode_entities_numeric);
 
24
use Math::Trig;
 
25
use Data::Dumper;
 
26
use strict;
 
27
use warnings;
 
28
 
 
29
 
 
30
## GLOBAL DATA
 
31
my @nodes;
 
32
my @tags;
 
33
my $waycount;
 
34
my $i = -1;
 
35
my $dir;
 
36
my $proj;
 
37
my $prefix;
 
38
 
 
39
my $outfile=0;
 
40
 
 
41
sub ShapeToOsm
 
42
{
 
43
    my $file = shift;
 
44
    $prefix = shift;
 
45
    my $default_tags = shift;
 
46
    $proj = shift;
 
47
 
 
48
    $dir = "out${prefix}";
 
49
    mkdir "$dir" unless -d "out";
 
50
    $file =~ s/\.shp$//;
 
51
    my $shpf = Geo::ShapeFile->new($file);
 
52
    warn "File:". $shpf;
 
53
 
 
54
    open OUT , ">${dir}/${prefix}_ways_1.osm" or die "cannot open $dir ";
 
55
    print OUT "<?xml version='1.0'?>
 
56
<osm version='0.5' generator='shp2osm.pl'>";
 
57
 
 
58
    proc_shpf($shpf,$default_tags);
 
59
 
 
60
## FINALLY CLOSE THE LAST ONE
 
61
        print OUT '    </osm> ';
 
62
        close OUT;
 
63
        $outfile=0;
 
64
 
 
65
}
 
66
 
 
67
 
 
68
sub tags_out {
 
69
    my ($tags) = @_;
 
70
    my %tags = $tags ? %$tags : ();
 
71
    delete $tags{'_deleted'} unless $tags{'_deleted'};
 
72
 
 
73
    while ( my ( $k, $v ) = each %tags ) {
 
74
        my $key = encode_entities_numeric($k);
 
75
        my $val = encode_entities_numeric($v);
 
76
#            warn "no valu $v for $k" unless $val;
 
77
        push @tags , '    <tag k="'. $key .'" v="'. $val ."\"/>\n" if $val;
 
78
    }
 
79
 
 
80
}
 
81
 
 
82
sub node_out {
 
83
    my ( $lon, $lat, $tags ) = @_;
 
84
    my $id = $i--;
 
85
    
 
86
    if($proj) {
 
87
        my ($wgs84lon, $wgs84lat) = gk2geo($lon, $lat);
 
88
        push @nodes , "  <node id='$id' visible='true' lat='$wgs84lat' lon='$wgs84lon' />\n";
 
89
    } else {
 
90
        push @nodes , "  <node id='$id' visible='true' lat='$lat' lon='$lon' />\n";         
 
91
    }
 
92
    $id;
 
93
}
 
94
 
 
95
sub seg_out {
 
96
    my $id = $i+1;
 
97
    $id;
 
98
}
 
99
 
 
100
sub way_out {
 
101
    my ( $segs, $tags ) = @_;
 
102
    my $id = $i--;
 
103
    $waycount++;
 
104
    if ($waycount % 100 ==0)
 
105
    {
 
106
        print "new file $waycount\n";
 
107
        print OUT '     </osm>';
 
108
        close OUT;
 
109
 
 
110
 
 
111
        $outfile=1;
 
112
        open OUT , ">$dir/${prefix}_ways_${waycount}.osm";
 
113
        print OUT "<?xml version='1.0'?>
 
114
            <osm version='0.5' generator='shp2osm.pl'>";
 
115
    }
 
116
 
 
117
    print OUT join "\n",@nodes;
 
118
    @nodes=();
 
119
 
 
120
    print OUT "  <way id='$id' visible='true'>\n";
 
121
    print OUT "    <nd ref='$_' />\n" for @$segs;
 
122
 
 
123
    tags_out $tags;
 
124
    print OUT join "\n",@tags;
 
125
    @tags=();
 
126
 
 
127
    print OUT "  </way>\n";
 
128
    $id;
 
129
}
 
130
 
 
131
sub polyline_out {
 
132
    my ( $pts, $tags, $connect_last_seg ) = @_;
 
133
 
 
134
    my ( $first_node, $last_node, @segs );
 
135
    for my $pt (@$pts) {
 
136
        my $node = node_out @$pt;
 
137
        push @segs, seg_out $last_node, $node;
 
138
        $last_node = $node;
 
139
        $first_node ||= $last_node;
 
140
    }
 
141
    push @segs, seg_out $last_node, $first_node
 
142
      if $first_node && $connect_last_seg;
 
143
    way_out \@segs, $tags;
 
144
}
 
145
 
 
146
sub proc_obj {
 
147
    my ( $shp, $dbf, $type,$default_tags ) = @_;
 
148
    my $tags = { %{$default_tags}, %$dbf };
 
149
#    warn Dumper($tags);
 
150
#    die;
 
151
    my $is_polygon = $type % 10 == 5;
 
152
    for ( 1 .. $shp->num_parts ) {
 
153
        polyline_out [ map( [ $_->X(), $_->Y() ], $shp->get_part($_) ) ], $tags,
 
154
          $is_polygon;
 
155
    }
 
156
 }
 
157
 
 
158
sub proc_shpf {
 
159
    my ($shpf,$default_tags) = @_;
 
160
    my $type = $shpf->shape_type;
 
161
    for ( 1 .. $shpf->shapes() ) {
 
162
        my $shp = $shpf->get_shp_record($_);
 
163
        my %dbf = $shpf->get_dbf_record($_);
 
164
        proc_obj $shp, \%dbf, $type,$default_tags;
 
165
    }
 
166
}
 
167
 
 
168
sub gk2geo {
 
169
 
 
170
  my $e  = $_[0];
 
171
  my $n = $_[1];
 
172
  my ($lat, $lon) = $proj->inverse($e, $n);
 
173
  return( $lon, $lat );
 
174
 
 
175
}
 
176
 
 
177
1;