view release on metacpan or  search on metacpan

examples/merge_probe.pl  view on Meta::CPAN

             $orig->{star_name}, $data->{star_name};
    $orig->{star_name} = $data->{star_name};
  }
  if (defined($data->{station})) {
    if (!defined($orig->{station})) {
      printf "Star %s has been claimed by Station: %s!\n",
              $data->{star_name}, $data->{station}->{name};
      %{$orig->{station}} = %{$data->{station}};
    }
    elsif ($data->{station}->{name} ne $orig->{station}->{name}) {
      printf "Star %s has been claimed by Station: %s from Station: %s!\n",
              $data->{star_name}, $data->{station}->{name},
              $orig->{station}->{name};
      %{$orig->{station}} = %{$data->{station}};
    }
  }
  if ($orig->{type} ne $data->{type} or  # We probably have a new space station or asteroid to account for
      $orig->{size} ne $data->{size} or  # Some size changes to account for
      $orig->{star_id} ne $data->{star_id} # A planet got moved.
     ) {
    printf "Changing type:size:star_id of %s from %s:%s:%d:%s to %s:%s:%d:%s\n",
             $data->{name}, $orig->{image}, $orig->{type}, $orig->{size}, $orig->{star_id},
             $data->{image}, $data->{type}, $data->{size}, $data->{star_id};
    $orig = copy_body($orig, $data);
  }
  return $orig;
}

sub cmp_emp {
  my ($orig, $data) = @_;

  my $str1 = join(":", $orig->{empire}->{alignment}, $orig->{empire}->{id},
                       $orig->{empire}->{is_isolationist}, $orig->{empire}->{name});
  my $str2 = join(":", $data->{empire}->{alignment}, $data->{empire}->{id},
                       $data->{empire}->{is_isolationist}, $data->{empire}->{name});

  if ($str1 eq $str2) {
    return 1;
  }
  return 0;
}

sub copy_body {
  my($orig, $data) = @_;
#Easier to swap info into new and return it.
  if (defined($orig->{empire})) {
    %{$data->{empire}} = %{$orig->{empire}};
  }
  if (defined($orig->{observatory})) {
    %{$data->{observatory}} = %{$orig->{observatory}};
  }
  return $data;
}

sub ownership_test {
  my ($elem, $ename) = @_;
  return join(":",$elem->{name}, $elem->{observatory}->{empire},
              $elem->{observatory}->{oid}, $elem->{observatory}->{pid}, $ename);
}

sub update_vacate {
  my ($curr_m, $updt_m, $curr_e, $updt_e) = @_;

  if ($updt_e ne '' and $curr_e ne $updt_e) {
      push @{$curr_m}, $updt_e;
  }
  push @{$curr_m}, @{$updt_m};
  my %thash;
  for (@{$curr_m}) {
    $thash{$_} = 1 if ($_ ne '' and $_ ne "nobody");
  }
  my @new_t = sort keys %thash;
  if (scalar @new_t == 0) {
    $new_t[0] = "nobody";
  }
#  print STDERR $curr_e, " - ", join(",", @new_t),"\n";
  return \@new_t;
}

sub check_sname {
  my ($elem, $stars) = @_;
  unless (defined($elem->{star_name})) {
    $elem->{star_name} = $stars->{$elem->{star_id}}->{name};
  }
  $elem->{star_name} =~ y/"'//d;
#  if ($elem->{star_name} ne $stars->{$elem->{star_id}}->{name}) {
#    $elem->{star_name} = $stars->{$elem->{star_id}}->{name};
#  }
}

sub get_stars {
  my ($sfile) = @_;

  my $fh;
  open ($fh, "<", "$sfile") or die;

  my $fline = <$fh>;
  my %star_hash;
  while(<$fh>) {
    chomp;
    my ($id, $name, $x, $y, $color, $zone) = split(/,/, $_, 6);
    $star_hash{$id} = {
      id    => $id,
      name  => $name,
      x     => $x,
      y     => $y,
      color => $color,
      zone  => $zone,
    }
  }
  return \%star_hash;
}

sub usage {
    diag(<<END);
Usage: $0 [options]

This program takes all data from two probe files and merges them.

Options: