#!/bin/perl

# osmmush - A not very playable "adventure game" based on openstreetmap.org

# TODO: come up w/ a better name for this (0thlife? nulllife?)

# Original code: kelly.terry.jones@gmail.com 26 Dec 2007
# Released under current GPL as of 26 Dec 2007
# This is version 20071226 (test code to inspire others, doesn\'t work well)

# GOAL: Turn the real world into a 2**32-room MOO/MUD/MUSH kind of thing

# TODO: for "gameplay", have a 2nd non-OSM server that just keeps
# track of where items are on the grid. Union the results w/ that grid

# TODO: allow things like "go [node/way]" if node/way is visible to
# you (especially useful when you're in the middle of nowhere and
# don't want to "hike")

# TODO: allow things like "e10" to move east 10 times at once or even
# "e1000ft" to allow large moves

# REQUIREMENTS:
#
# Perl (well, duh!) w/ Digest::SHA1 and POSIX modules
# curl (to query OSM GIS)
# /usr/local/etc/OSM should exist + be writeable by user running program
#  (location of tile cache)
# OPTIONAL: fly (to display debugging maps, not very pretty)

# NOTE: my definition of "quadtile" assumes latitude/longitude are
# purely linear; this is NOT a Mercator projection (and thus not
# directly compatible w/ Mapnik/Osmarender). Despite this, I use
# quadtile lettering that's similar to:
# http://wiki.openstreetmap.org/index.php/QuadTiles
# I use the same lettering scheme (A,B,C,D,AA,AB,...) etc, but my tiles don't
# match up to the maps on the page above

# TODO: if there's nothing in zoom 16 tile, should "reach out" until
# it finds closest node/way to your current location (in middle of
# ocean, this might be 100s of miles away!). This will at least tell
# you where to head to find land <G>

# BUG: If you cross a QuadTile boundary, you can lose nodes/ways you
# saw just a second ago.

# BUG: once you cache something, you sometimes see it even when you shouldn't?

# OTHER BUGS: many many many!

# constants and things to always do
$FIND = "/usr/bin/find"; # where you keep your 'find' command
use Digest::SHA1  qw(sha1 sha1_hex sha1_base64);
use POSIX;
parse_options();
findcmds();
$PI = 4*atan2(1,1);

# default parameters (can be changed by doing -width=320 [for example])
# TODO: except for lat/lon, changing parameters below probably doesn\'t work
# well (fix this)

# NOTE: tried ZOOM=17, and it\'s just too tight

# TODO: SPEED = how many degrees you move; incorrectly assumes 1
# degree latitude = 1 degree longitude everywhere. 2e-4 is about 75
# feet in latitude

defaults("WIDTH=800&HEIGHT=600&ZOOM=16&LAT=35.0846&LON=-106.6511&SPEED=2e-4");

# NOTE: the -neighbor parameter is highly experimental

# what quadtile is the lat/lon above in?
$quad = latlon2quad($LAT,$LON,$ZOOM);
debug("QUADTILE: $quad");

# get the data for this tile
@stuff = get_file_data(get_tile_file($quad));

# TODO: if there's not enough @stuff, get more data by querying
# neighboring tiles

# HACK: not sure why I need "if $NEIGHBOR" below, but I do
if ($NEIGHBOR) {
  for $i (neighbor_tiles($quad,$NEIGHBOR)) {
    push(@stuff,get_file_data(get_tile_file($i)));
  }
}

# let's describe the @stuff in this quadtile
for $i (@stuff) {
  %hash = %{$i};

  # ignore unnamed objects
  # TODO: is this wise? (probably not: we don't see coastlines, boundaries, etc)
  unless ($hash{name}) {next;}

  $count++; # count how many objects we\'re display

  # have we seen this object already? (we may\'ve queried multiple
  # adjacent tiles, and gotten back the same node/way more than once,
  # especially if we\'re using neighbor_tiles() stuff above)

  if ($VISITED{$hash{tag}}{$hash{id}}) {next;}
  $VISITED{$hash{tag}}{$hash{id}} = 1;

  # nodes
  if ($hash{_tag} eq "node") {
    # find distance and direction to this node
    $dist = gcdist($LAT,$LON,$hash{lat},$hash{lon});
    $dir = atan2($hash{lat}-$LAT,$hash{lon}-$LON)*180/$PI;
    # TODO: clean this up a lot -- give direction as "NE" not "52 degrees"
    # TODO: allow metric units option for non-US users
    push(@tell, nice_dist_dir("$hash{name} (node)", $dist, $dir));

    # "Fly" map (debugging)
    ($x,$y) = latlon2xy($hash{lat},$hash{lon},$LAT,$LON,$ZOOM,$HEIGHT,$WIDTH);
    if ($x>0) {
      push(@fly,"fcircle $x,$y,2,255,255,0");
      push(@fly,"string 255,255,255,$x,$y,tiny,$hash{name}");
    }
    next;
  }

  # ways
  push(@fly,map_way(\%hash,$LAT,$LON,$ZOOM,$HEIGHT,$WIDTH));
  ($dist,$angle,$x,$y) = way_dist_dir(\%hash,$LAT,$LON);
  push(@tell, nice_dist_dir("$hash{name} (way)", $dist, $angle));
}

# tell user where they are and what's around them
# TODO: clean up "where you are" info below
# TODO: there's no indication re what city/state/country you\'re in
# TODO: add live weather (maybe) + position of moon/sun/planets(?)
# TODO: add timezone data (it is XX:XX here)
print "\nYou are in QuadTile $quad ($LAT,$LON).\n";

for $i (sort @tell) {
  $i=~s/^\d+\s*//;
  print "$i.\n";
  # TODO: cut off after 50 nearest nodes/ways perhaps?
}

# create fly map (only display if -fly given)

($whalf,$hhalf) = ($WIDTH/2,$HEIGHT/2);

open(A,">/tmp/osmmush.fly");
print A << "MARK"
new
size $WIDTH,$HEIGHT
name /tmp/osmmush.gif
setpixel 0,0,0,0,0
fcircle $whalf,$hhalf,5,255,128,128
MARK
;

print A join("\n",@fly);

close(A);

if ($FLY) {
  system("$CMD2{fly} -q -i /tmp/osmmush.fly");
  system("$CMD2{xv} /tmp/osmmush.gif&");
}

# TODO: give user many more options
print "\nn,ne,e,se,s,sw,w,nw,[no]fly,[no]debug,more or:\npos 'lat,lon' or speed 'x'> ";
$stdin = <>;
chomp($stdin);

# TODO: probably a better way to do below (and not juse 'case' statement)
# TODO: should we say "you have moved north" or similar?
if ($stdin eq "n") {$LAT+=$SPEED;}
if ($stdin eq "s") {$LAT-=$SPEED;}
if ($stdin eq "e") {$LON+=$SPEED;}
if ($stdin eq "w") {$LON-=$SPEED;}
if ($stdin eq "nw") {$LAT+=$SPEED; $LON-=$SPEED;}
if ($stdin eq "ne") {$LAT+=$SPEED; $LON+=$SPEED;}
if ($stdin eq "se") {$LAT-=$SPEED; $LON+=$SPEED;}
if ($stdin eq "sw") {$LAT-=$SPEED; $LON-=$SPEED;}

if ($stdin=~/speed\s+([\.\d]+)/) {
  $factor = $1;
  $SPEED*=$factor;
  print "You are now moving at $factor times your previous speed.\n";
  # TODO: give new speed in more useful units
  print "New speed: $SPEED degrees/move.\n";
}

if ($stdin=~/pos\s+([\-\.\d]+)[,\s]([\-\.\d]+)/) {
  ($LAT,$LON) = ($1,$2);
  # TODO: pretty this up
  print "You teleport to latitude $LAT, longitude $LON.\n";
}

if ($stdin eq "fly") {$FLY=1;}
if ($stdin eq "nofly") {$FLY=0;}
if ($stdin eq "debug") {$DEBUG=1;}
if ($stdin eq "nodebug") {$DEBUG=0;}

# the 'more' command doesn't "stick" -- if you don't use it, $NEIGHBOR
# gets set back to 0

if ($stdin eq "more") {
  $NEIGHBOR++;
  print "You expand your view to $NEIGHBOR tiles in each direction.\n";
} else {
  $NEIGHBOR=0;
}

# TODO: re-executing the script to move is grossly inefficient
system("$0 -debug=$DEBUG -fly=$FLY -lat=$LAT -lon=$LON -speed=$SPEED -neighbor=$NEIGHBOR");

=item latlon2quad($lat,$lon,$n=16)

Determine the QuadTile that contains $lat,$lon and is $n characters long.

=cut

sub latlon2quad {
  my($lat,$lon,$n) = @_;
  my(@res);
  unless ($n) {$n=16;}

  # this should probably be static; map high bit values of $lat $lon to letters
  my(%MAP) = ("1,0" => "A", "1,1" => "B", "0,0" => "C", "0,1" => "D");
  
  # normalize to 0,1
  $lat = ($lat+90)/180;
  $lon = ($lon+180)/360;

  # TODO: clever use of 'pack' could eliminate this for loop
  for $i (1..$n) {
    $lat*=2;
    $lon*=2;
    push(@res,$MAP{int($lat).",".int($lon)});
    $lat=~s/^\d\.?/./isg;
    $lon=~s/^\d\.?/./isg;
  }

  return join("",@res);

}

=item quad2bbox($quad)

Determine the bounding box for a given QuadTile.

=cut

sub quad2bbox {
  my($quad) = @_;

  my($minx,$miny,$maxx,$maxy) = (-180,-90,180,90); # start with whole world

  # TODO: clever use of 'unpack' could eliminate this for loop
  for $i (split(//,$quad)) {
    my($avgx) = ($minx+$maxx)/2;
    my($avgy) = ($miny+$maxy)/2;

    if ($i eq "A") {
      ($maxx,$miny) = ($avgx,$avgy);
    } elsif ($i eq "B") {
      ($minx,$miny) = ($avgx,$avgy);
    } elsif ($i eq "C") {
      ($maxx,$maxy) = ($avgx,$avgy);
    } elsif ($i eq "D") {
      ($minx,$maxy) = ($avgx,$avgy);
    }
  }

  return ($minx,$miny,$maxx,$maxy);

}

=item get_tile_file($quad)

Return a file name containing the "raw data" for a given
QuadTile. Retrieve QuadTile data from OSM GIS and cache (return cached
result if possible).

NOTE: may return data for a larger tile

=cut

sub get_tile_file {
  my($quad) = @_;
  my($file);
  my($cachedir) = "/usr/local/etc/OSM";

  if (blank($quad)) {die "Reached top level and found nothing, sorry";}
  debug("GETTING DATA FOR: $quad");

  # TODO: expire cached tiles at some point
  # look in cache first (must be at least 5K to count)
  for $i (1..length($quad)) {
    $file = substr($quad,0,$i).".dat";
    if (-s "$cachedir/$file" > 5000) {return "$cachedir/$file";}
  }

  # not found in cache, so we need to get it from OSM server
  my($bbox) = join(",",quad2bbox($quad));
  my($url) = "http://www.openstreetmap.org/api/0.5/map?bbox=$bbox";
  debug("URL: $url");

  # NOTE: this could be a debug statement, but user should probably know
  # we\'re getting data, even if debugging is turned off
  print "Getting additional data from $url.\n";

  # NOTE: pointless use of caching command output below; was helpful
  # when I was debugging (stopped me from hitting OSM GIS constantly
  # before the correct kind of caching [above] was working)
  my($res) = cache_command_hash("$CMD2{curl} -s '$url'",.01);

  # if big enough, copy to cache and return
  if ((-s $res) > 5000) {
    system("$CMD2{cp} $res $cachedir/$quad.dat");
    return "$cachedir/$file";
  }

  # TODO: sometimes the server returns a 1-byte reply which doesn't
  # make sense (even if there\'s no data, I shouldn't get this)
  if (-s $res == 1) {die "Horrible 1-byte error thing I don't understand has occurred";}

  # all other cases: return data for parent tile
  $quad=~s/.$//;
  return get_tile_file($quad);
}

=item get_file_data($file)

Returns the list of nodes and ways in a given file.

=cut

sub get_file_data {
  my($file) = @_;
  my(%curhash,%lat,%lon);
  my(@items);
  local(*A);

  open(A,$file);

  while (<A>) {

    my(%res) = parse_xml_tag($_);

    # if this ends a node/way, push the hash for the node/way on to @items
    if (m%</node>|</way>%) {
      my(%copyhash) = %curhash;
      push(@items,\%copyhash);
    }

    # HACK: record lat/lon of node so we can use it in paths
    if ($res{_tag} eq "node") {
      ($lat{$res{id}},$lon{$res{id}}) = ($res{lat},$res{lon});
    }

    # if tag is self-closing node, push it right away
    if ($res{_close} && $res{_tag} eq "node") {
      push(@items,\%res);
    }

    # if we're inside a relation, ignore everything
    if ($res{_tag} eq "relation" || $res{_tag} eq "member") {next;}

    # this starts a new 'way' or 'node'
    if ($res{_tag} eq "way" || $res{_tag} eq "node") {
      %curhash = %res; # copy the data from this line
      next;
    }

    # tagging the item we're currently inside
    # TODO: allow user to use 'look' or 'examine' command to see all tags
    # on a node/way. Currently, only 'name' is displayed
    if ($res{_tag} eq "tag") {
      $curhash{$res{k}} = $res{v};
      next;
    }

    # node inside a way
    if ($res{_tag} eq "nd") {
      push(@{$curhash{path}}, $lat{$res{ref}}, $lon{$res{ref}});
      next;
    }
  }

  close(A);
  return @items;
}

=item parse_xml_tag($tag)

Inaccurate and incomplete XML tag parsing that nonetheless works for
our purposes.

=cut

sub parse_xml_tag {
  my($tag) = @_;
  my(%res); # the hash to return

  # tag name
  $tag=~s/<\s*(.*?)\s+//;
  $res{_tag} = $1;

  # is tag self-closing? (if not, get rid of ending angle bracket anyway)
  if ($tag=~s%\s*/\s*>%%) {
    $res{_close} = 1;
  } else {
    $tag=~s%\s*>%%;
  }

  # find all key/value pairs
  while ($tag=~s/\s*(.*?)=\"(.*?)\"\s*//) {
    $res{$1} = $2;
  }

  return %res;
}

=item neighbor_tiles($quad,$l=1,$n=16)

Returns the names of the tiles neighboring $quad out to $l levels,
where each tile is 2^-$n of the world in each direction.

=cut

sub neighbor_tiles {
  my($quad,$l,$n) = @_;
  unless ($n) {$n=16;}
  unless ($l) {$l=1;}
  my(@bbox) = quad2bbox($quad);
  my($lon,$lat) = (($bbox[0]+$bbox[2])/2, ($bbox[1]+$bbox[3])/2);
  my($newlon,$newlat);
  my(@res);

  for $i (-$l..$l) {
    for $j (-$l..$l) {
      $newlon = $lon+$j*360/2**$n;
      if ($newlon<-180) {$newlon+=180;}
      if ($newlon>180) {$newlon-=180;}
      $newlat = $lat+$i*180/2**$n;
      my($res) = latlon2quad($newlat,$newlon,$n);
      debug("$newlat,$newlon -> $res");
      push(@res,$res);
    }
  }
  return @res;
}

=item latlon2xy($lat,$lon,$clat,$clon,$z,$height,$width)

Determine the image coordinates of a $lat,$lon, where $clat,$clon is
at the center of the image, the zoom level is $z, and the image is
$width x $height.

Assumes linearity. This is NOT a Mercator projection.

Returns -1,-1 if image coordinate is not on screen

=cut

sub latlon2xy {
  my($lat,$lon,$clat,$clon,$z,$height,$width) = @_;

  my($x) = (.5+($lon-$clon)/(360/2**$z))*$width;
  my($y) = (.5+($clat-$lat)/(180/2**$z))*$height;

  if ($x>0 && $x<$width && $y>0 && $y<$height) {return ($x,$y);}

  # TODO: not sure if returning -1,-1 is best here-- it might be nice
  # to draw lines that extend off the image

  return (-1,-1);
}

=item map_way(\%way,$clat,$clon,$z,$height,$width)

Return the fly commands to map a way. The non-$way parameters are
passed directly to latlon2xy().

=cut

sub map_way {
  my($way,$clat,$clon,$z,$height,$width) = @_;
  my(%hash) = %{$way};
  my(@path) = @{$hash{path}};
  my(@fly,@x,@y);
  my($NAMED)=0;

  # points on path
  for ($j=0; $j<=$#path; $j+=2) {
    my($x,$y) = latlon2xy($path[$j],$path[$j+1],$clat,$clon,$z,$height,$width);
    if ($x>0) {
      push(@fly,"fcircle $x,$y,2,255,0,0");

      # TODO: showing way name on EVERY node is excessive?
      push(@fly,"string 255,255,255,$x,$y,tiny,$hash{name}");

      # only show string on first node
      # TODO: improve this to show at closest point
      unless ($NAMED) {
	# commented code below just prints name on first node of way
#	push(@fly,"string 255,255,255,$x,$y,tiny,$hash{name}");
	# commented code below shows string printed vertically
#	push(@fly,"stringup 255,255,255,$x,$y,tiny,$hash{name}");
	$NAMED=1;
      }
      push(@x,$x);
      push(@y,$y);
    }
  }

  # joining them up
  for $i (1..$#x) {
    push(@fly,"line $x[$i-1],$y[$i-1],$x[$i],$y[$i],0,0,255");
  }

  return @fly;
}

=item segment_dist_dir($x,$y,$x1,$y1,$x2,$y2)

Determines the shortest distance and direction from point $x,$y to
line segment $x1,$y1,$x2,$y2, plus returns the point on the segment
that\'s closest.

TODO: this is fairly inaccurate because it uses linear geometry to
find the closest point and angle. That\'s maybe OK for high zoom
levels near the equator (low spherical distortion), but probably bad
in general.

=cut

sub segment_dist_dir {
  my($x,$y,$x1,$y1,$x2,$y2) = @_;
  my($xhit,$yhit);

  # value of parametric $t that makes distance to LINE (not segment) minimal
  # I used calculus and Mathematica to get this, not that anyone cares <G>
  my($t) = ($x1**2-$x1*$x2+$x*($x2-$x1)-($y-$y1)*($y1-$y2))/(($x1-$x2)**2+($y1-$y2)**2);

  # if $t is between 0 and 1, the perpendicular hits the segment
  # otherwise, $t<0 -> point 1 is closest, and $t>1 -> point 2 is closest
  if ($t>=0 && $t<=1) {
    ($xhit,$yhit) = ($t*($x2-$x1)+$x1,$t*($y2-$y1)+$y1);
  } elsif ($t<0) {
    ($xhit,$yhit) = ($x1,$y1);
  } else {
    ($xhit,$yhit) = ($x2,$y2);
  }

  # find angle, distance, and return (+ what point is closest)
  my($dist) = gcdist($y,$x,$yhit,$xhit);
  my($angle) = atan2($yhit-$y,$xhit-$x)*180/$PI;
  return ($dist,$angle,$xhit,$yhit);
}

=item way_dist_dir(\%way, $clat, $clon)

Find the shortest distance and direction to a given way, plus return the
point on the way (not necessarily a node) that\'s closest.

TODO: would be nice to say which direction the way is winding (eg,
"Central Ave SE runs north-south here")

=cut

sub way_dist_dir {
  my($way,$clat,$clon)=@_;
  my(%hash) = %{$way};
  my(@path) = @{$hash{path}};
  my($bestdist,$bestangle,$bestx,$besty)=(1e+9); # HACK: use of flag value

  for ($i=2; $i<=$#path; $i+=2) {
    my($dist,$angle,$xhit,$yhit) = segment_dist_dir($clon,$clat,$path[$i-1],$path[$i-2],$path[$i+1],$path[$i]);
    if ($dist<$bestdist) {
      ($bestdist,$bestangle,$bestx,$besty)=($dist,$angle,$xhit,$yhit);
    }
  }

  return ($bestdist,$bestangle,$bestx,$besty);
}


=item nice_dist_dir($name,$dist,$dir)

Given the name of node/way, its distance from the user (in miles) and
its direction from the user (0=east, -90=south, +90=north,
+-180=west), return a string that nicely describes location relative
to user.

TODO: this is a first cut that can be improved significantly

TODO: if user is very close to a node/way, perhaps say "you are standing on.."

=cut

sub nice_dist_dir {
  my($name,$dist,$dir,$units) = @_;

  # the distance for sorting (not sure Perl can sort strings "numerically")
  my($sortdist) = sprintf("%020d",$dist*5280);

  # will usually be less than 2 miles, in which case we say 'feet'
  if ($dist<2) {
    $dist=int($dist*5280+.5);
    $units = "feet";
  } else {
    $dist=sprintf("%0.1f",$dist);
    $units = "miles";
  }

  # TODO: include things like NNE?
  # NOTE: duplication of 'east' below is intentional
  my(@dirs)=("east","northeast","north","northwest","west","southwest","south","southeast","east");
  $dir = $dirs[int(fmod($dir+360,360)/45+.5)];

  # TODO: returning distance as part of the answer is for sorting
  # purposes; the caller is expected to strip the first word from the
  # result (KLUDGE: this is ugly- much better ways of doing this)
  return "$sortdist $name is $dist $units to your $dir";
}

# BELOW THIS LINE: generic functions not specific to osmmush

sub blank {return($_[0]=~/^\s*$/);}

=item debug(@list)

Print list of messages to the standard error, separated by
newlines. If -randdebug is set, only print some of the time

=cut

sub debug {
  if($DEBUG) {
    if (!$RANDDEBUG || (rand() < $RANDDEBUG)) {
      print STDERR join("\n",@_),"\n";
    }
  }
}

=item cache_command_hash($command, $age)

Runs the command $command, and stores the results in a temporary file
whose name is determined (hashwise) from $command, and return the name
of the temporary file. If the temporary file exists and is less than
$age days old, just return the name of the temporary
file. Effectively caches the output of a given command. If $NOCACHE is
set, always run $command, regardless of value of $age

=cut

sub cache_command_hash {
    my($command,$age)=@_;
    my($file) = "/tmp/cache-".sha1_hex($command);
    if (-f $file && (-M $file < $age) && !$NOCACHE) {return $file;}
    my($res) = system("$command > $file");
    if ($res!=0) {warnlocal("$command returned non-0 status: $res");}
    return $file;
}

#parse_options(): Parses command line options by setting flags

sub parse_options {
  my(@a);
  my(@x)=grep(/^[\-\+][a-z]/i,@ARGV);
  @ARGV=grep(!/^[\-\+][a-z]/i,@ARGV);
  for(@x){
    s/^.//;
    unless(/=/){
      $_="$_=1";
    }
    /(.*?)\=(.*)/;
    my($key,$val)=(uc($1),$2);
    $val=~s/\@/\\\@/isg;

    my($evalstring)="\$$key=\"$val\"";
    push(@a,$evalstring);
    eval($evalstring);
    debug("-- $_");
  }
}

# warnlocal(errmsg): warn that an error has occurred but dont
# print to stderr if -nowarn given

sub warnlocal {
  push(@ERRORS,@_);
  unless ($NOWARN) {warn(join("\n",@_));}
}

# define a global hash that guesses where you keep various commands

sub findcmds {
  for $i (`$FIND /sw/bin/ /usr/local/bin/ /bin/ /usr/bin/ /usr/X11R6/bin/ -type l -perm +o+x 2> /dev/null`, `$FIND /sw/bin/ /usr/local/bin/ /bin/ /usr/bin/ /usr/X11R6/bin/ -type f -perm +o+x 2> /dev/null`) {
    chomp($i);
    $j = $i;
    $j=~s%^.*/%%isg;
    $CMD2{$j} = $i;
  }
}

# gcdist(x,y,u,v): (great circle) distance between x,y and u,v lat/lon

sub gcdist {
  my($EARTH_RADIUS)=6371/1.609344; # miles
  my(@x)=@_;
  my($x,$y,$u,$v)=map {$_*=$PI/180} @x;
  return ($EARTH_RADIUS*acos(cos($x)*cos($y)*cos($u)*cos($v)+cos($x)*sin($y)*cos($u)*sin($v)+sin($x)*sin($u)));
}

=item defaults($x)

given a string like "FOO=1&X=BLAH", sets $FOO and
$X in global namespace, unless they're already set (allows a
program to set default options where user hasn't already set options)

=cut

sub defaults {
  my(%hash) = str2hash($_[0]);
  extract(\%hash);
  # calls parse_options again to do any special processing
  parse_options();
}

# given a string like x=1&y=2&z=3, etc, return the hash mapping x -> 1, etc

sub str2hash {
  my($str) = @_;
  my(%ret) = split(/[\&\=]/,$str);
  return %ret;
}

=item extract(\%hash, $overwrite)

Extracts a hash into the global namespace (does what PHP extract()
does), but cleans up keys if they have non-alpha characters; if
$overwrite is set, overwrite existing global variables

=cut

sub extract {
  my($hashref, $overwrite) = @_;
  my(%hash) = %{$hashref};
  my($safe);
  for $i (keys %hash) {
    if ($overwrite || (!(defined $$i))) {
      $safe = $i; # keep safe copy of $i
      $i=~s/[^a-z_]//isg; # get rid of nonalpha characters in key
      unless ($i=~/^[a-z_]+$/i) {next;} # if key is now empty, ignore it

      # if condition below is kludge: should really work for hashes too
      if (ref($hash{$i}) eq "ARRAY") {
	eval("\@$i = \@{\$hash{'$safe'}}");
      } else {
	eval("\$$i = \$hash{'$safe'}");
      }
    }
  }
}