#!/opt/perl/bin/perl
use strict;
use GPS::NetSites;
use File::Basename;
use Pod::Text::Termcap;
use Getopt::Long;
my $progname = basename $0;
my ($proj,$nets,$sites,$snet,$show,$u,$help);
my $args = @ARGV;
my $relax=0;
GetOptions( 'proj:s' => \$proj,
            'snet:s' => \$snet,
            'nets' => \$nets,
            'sites' => \$sites,
            'relax' => \$relax,
            'show' => \$show,
            'u'  => \$u, #unique
            'help' => \$help,
          ) or die "Error in options\n";

if ( !$args || $help ) {
  usage();
  exit 1;
}

my $ns = GPS::NetSites->new( proj => $proj );
if ( ! $ns ) {
   exit 1;
}
my @nets = ();
my %sites = ();
my @stas = ();
if ( $nets ) {
  print map { "$_\n" } $ns->nets;
}
elsif ( $sites ) {
  print map { "$_\n" } $ns->sites;
}
elsif ( $show ) {
   my %net_sites=$ns->net_sites;
   foreach ( $ns->nets ) {
      print join (' ', ($_,  @{$net_sites{$_}} )),"\n";
   }
}
elsif ( $snet ) {
  my %n = $ns->net_sites;
  foreach my $in ( split(/,/,uc $snet) ) 
  {
    my $subn = $relax ? $in : '^'.$in.'$';
    my @sn = grep{ /$subn/ } keys %n ;
    push @nets,@sn  if @sn;
  }
  if ( @nets ) {
     foreach my $nn ( @nets ) {
        #@sites{ @{$n{$nn}} } = @{$n{$nn}};
        push @stas,@{$n{$nn}};
     }
     #print map { "$_\n" } sort keys %sites;
     if ( @nets == 1 ) {
       print map { "$_\n" } @stas;
     }
     else {
       my %seen =();
       print map { "$_\n" } sort grep { ! $seen{$_}++ } @stas;
     }
  }
  else {
    die "No $snet sub-network in proj $proj\n";
  }
}

sub usage {
  my $pod=Pod::Text::Termcap->new();
  $pod->parse_from_filehandle(man_page());
}

sub man_page {
my $man =qq(
=head1 NAME

$progname

script_template

=head1 OPTIONS

=over 3

=item -proj project name

=item -snet sub-network name

=item -nets network names

=item -sites site names

=item -relax Who knows

=item -show Who knows

=item -u Display unique names only

=item -help This message

=back

=head1 EXAMPLES

=over 3

=item $progname options 


=back

=head1 AUTHOR

Victor Marcelo Santillan <marcelo\@geology.cwu.edu>

=head1 COPYRIGHT

Copyright \(c\) 2007 

Central Washington University

=cut
);
open(my $fh,"<",\$man ) or die "$!\n";
return $fh
}

