view release on metacpan or  search on metacpan

lib/Geo/OGC/Service/WMTS.pm  view on Meta::CPAN

                         ['Title'],
                         [OnlineResource => {'xmlns:xlink' => "http://www.w3.org/1999/xlink",
                                             'xlink:href' => $config->{resource}}]]);
    $writer->open_element('Capability');
    $writer->element(Request => 
                     [[GetCapabilities => 
                       [[Format => 'application/vnd.ogc.wms_xml'],
                        [DCPType => 
                         [HTTP => 
                          [Get => 
                           [OnlineResource => 
                            {'xmlns:xlink' => "http://www.w3.org/1999/xlink",
                             'xlink:href' => $config->{resource}}]]]]]],
                      [GetMap => 
                       [[Format => 'image/png'],
                        [DCPType => 
                         [HTTP => 
                          [Get => 
                           [OnlineResource => 
                            {'xmlns:xlink' => "http://www.w3.org/1999/xlink",
                             'xlink:href' => $config->{resource}}]]]]]]
                     ]);
    $writer->element(Exception => [Format => 'text/plain']);
    
    for my $set (@{$config->{TileSets}}) {
        my($i0,$i1) = split /\.\./, $set->{Resolutions};

        #my @resolutions = @resolutions_3857[$i0..$i1]; # with this QGIS starts to ask higher resolution tiles
        my @resolutions;
        my $projection = $projections{$set->{SRS}};
        my $extent_width = $projection->{extent}{maxx} - $projection->{extent}{minx};
        for my $i (0..19) {
            $resolutions[$i] = $extent_width/(2**$i * $tile_width);
        }

        my $bb = $set->{BoundingBox}; # with this QGIS does not show tiles at correct locations
        $bb = $projection->{extent};

        $writer->element(VendorSpecificCapabilities => 
                         [TileSet => [[SRS => $set->{SRS}],
                                      [BoundingBox => $bb],
                                      [Resolutions => "@resolutions"],
                                      [Width => $set->{Width} // $tile_width],
                                      [Height => $set->{Height} // $tile_height],
                                      [Format => $set->{Format}],
                                      [Layers => $set->{Layers}],
                                      [Styles => undef]]]);
    }

    $writer->element(UserDefinedSymbolization => 
                     {SupportSLD => 0, UserLayer => 0, UserStyle => 0, RemoteWFS => 0});

    for my $set (@{$config->{TileSets}}) {

        my $projection = $projections{$set->{SRS}};

        my $bb = $set->{BoundingBox}; # with this QGIS does not show tiles at correct locations
        $bb = $projection->{extent};

        $writer->element(Layer => [[Title => 'TileCache Layers'],
                                   [Layer => {queryable => 0, opaque => 0, cascaded => 1}, 
                                    [[Name => $set->{Layers}],
                                     [Title => $set->{Layers}],
                                     [SRS => $set->{SRS}],
                                     [Format => $set->{Format}],
                                     [BoundingBox => $bb]
                                    ]]
                         ]);
    }

    $writer->close_element;
    $writer->close_element;
    $writer->stream($self->{responder});
}

=pod

=head3 GetMap

Serves the tile request if WMS is used.

Sends the requested tile based on parameters BBOX, LAYERS, and SRS.

The tiles should be in a tile map resource type of directory structure
(z/y/x.png). The value of the 'path' key in the TileSet config element
should point to the directory.

=cut

sub GetMap {
    my ($self) = @_;
    for my $param (qw/bbox layers srs/) {
        unless (defined $self->{parameters}{$param}) {
            $self->error({ exceptionCode => 'MissingParameterValue',
                           locator => uc($param) });
            return;
        }
    }
    my $set;
    for my $s (@{$self->{config}{TileSets}}) {
        if ($s->{Layers} eq $self->{parameters}{layers}) {
            $set = $s;
            last;
        }
    }
    unless ($set) {
        $self->error({ exceptionCode => 'InvalidParameterValue',
                       locator => 'LAYERS' });
        return;
    }

    my $projection = $projections{$self->{parameters}{srs}};

    unless ($projection) {
        my @supported = sort keys %projections;
        return $self->error({ exceptionCode => 'InvalidParameterValue',
                              locator => 'SRS',
                              ExceptionText => "$self->{parameters}{srs} is not currently supported." });
    }

    # the assumption is that bbox defines a tile and we need to find the tile