ShadowMap/kml.pl

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;

use XML::LibXML;
use URI::Escape;

my $filename = 'webroot/ours.kml';
my $dom = XML::LibXML->load_xml(location => $filename, no_blanks => 1);
my $xpc = XML::LibXML::XPathContext->new($dom);
$xpc->registerNs('k', "http://earth.google.com/kml/2.2");

my $mode = shift;
unless(defined($mode))
{
    USAGE();
}

if ($mode eq 'add')
{
    my ($name, $coordinates) = @ARGV;
    unless (defined($name) && defined($coordinates))
    {
        say "Not enough args for add operation";
        USAGE(1);
    }
    my $name_id = to_id($name);
    my ($placemark) = $xpc->findnodes("//k:Placemark[\@id=\"$name_id\"]");
    if(defined($placemark))
    {
        say "$name already exists in $filename";
        exit(1);
    }
    append_placemark($name, $coordinates, uri_escape($name));
    print $dom->toString(1);
}

elsif ($mode eq 'remove')
{
    my ($name) = @ARGV;
    unless (defined($name))
    {
        say "No place name provided to delete operation";
        USAGE(1);
    }
    $name = to_id($name);
    my ($placemark) = $xpc->findnodes("//k:Placemark[\@id=\"$name\"]");
    if(defined($placemark))
    {
        $placemark->unbindNode();
        print $dom->toString(1);
    }
    else
    {
        say "$name was not found in $filename";
        exit(1);
    }
}

elsif ($mode eq 'set')
{
    my ($name, $coordinates) = @ARGV;
    unless (defined($name) && defined($coordinates))
    {
        say "Not enough args for set operation";
        USAGE(1);
    }
    $name = to_id($name);
    my ($placemark) = $xpc->findnodes("//k:Placemark[\@id=\"$name\"]");
    if(defined($placemark))
    {
        my ($coordinates_node) = $xpc->findnodes("./k:Point/k:coordinates", $placemark);
        my ($description_node) = $xpc->findnodes("./k:description", $placemark);
        $coordinates_node->firstChild()->setData($coordinates);
        $description_node->firstChild()->setData($coordinates);
        print $dom->toString(1);
    }
    else
    {
        say "$name was not found in $filename";
        exit(1);
    }
}

else
{
    say "Invalid operation";
    USAGE(1);
}

sub USAGE
{
    my $code = shift;
    say "USAGE: ";
    say "";
    say "kml.pl add <name> <coordinates>";
    say "";
    say "  Adds a new placemark to ours.kml for <name> at <coordinates>.";
    say "  The name will automatically link to <name> page on https://jackpoint.obscuritus.ca/";
    say "";
    say "";
    say "kml.pl set <name> <coordinates>";
    say "";
    say "  Sets the coordinates of the <name> placemark to <coordinates>.";
    say "";
    say "";
    say "kml.pl remove <name>";
    say "";
    say "  Removes the <name> placemark";
    exit($code || 0);
}
sub add_empty_child
{
    my $node = shift;
    my $element_name = shift;
    my $child_node = $dom->createElement($element_name);
    $node->appendChild($child_node);
    return $child_node;
}

sub append_placemark
{
    my $name = shift;
    my $coordinates = shift;
    my $article_name = shift;
    my $placemark = add_empty_child($dom->documentElement, 'Placemark');
    $placemark->{id} = to_id($name);

    my $name_node = add_empty_child($placemark, 'name');
    my $name_content;
    if(defined($article_name))
    {
        $name_content = "<a href=\"https://jackpoint.obscuritus.ca/index.php?title=$article_name\">$name</a>";
    }
    else
    {
        $name_content = $name;
    }

    my $name_cdata = $dom->createCDATASection($name_content);
    $name_node->appendChild($name_cdata);

    my $description_node = add_empty_child($placemark, 'description');
    my $description_content = $coordinates;
    my $description_cdata = $dom->createCDATASection($description_content);
    $description_node->appendChild($description_cdata);

    my $style_node = add_empty_child($placemark, 'styleUrl');
    $style_node->appendText('#jackpoint-logo');

    my $point_node = add_empty_child($placemark, 'Point');
    my $coordinates_node = add_empty_child($point_node, 'coordinates');
    $coordinates_node->appendText($coordinates);
}
sub to_id
{
    my $string = shift;
    $string =~ s/ /_/g;
    $string =~ s/\W//g;
    return lc($string);
}