package UWP;
{
   my ( %name, 
        %loc, 
        %uwp, 
        %base, 
        %codes, 
        %zone, 
        %pbg, 
        %alleg, 
        %stars, 
        %xboat );

   sub new { bless {}, shift; }
   
   # read-write methods
   
   sub name       : lvalue {$name      {+shift}}
   sub loc        : lvalue {$loc       {+shift}}
   sub uwp        : lvalue {$uwp       {+shift}}
   sub base       : lvalue {$base      {+shift}}
   sub codes      : lvalue {$codes     {+shift}}
   sub zone       : lvalue {$zone      {+shift}}
   sub pbg        : lvalue {$pbg       {+shift}}
   sub alleg      : lvalue {$alleg     {+shift}}
   sub stars      : lvalue {$stars     {+shift}}
   sub xboat      : lvalue {$xboat     {+shift}}
   
   # read-only methods
   
   sub col      { $loc{+shift} =~ /^(..)/;     }
   sub row      { $loc{+shift} =~ /(..)$/;     }
   
   sub starport { $uwp{+shift} =~ /^(.)/;      }
   sub size     { $uwp{+shift} =~ /^.(.)/;     }
   sub atm      { $uwp{+shift} =~ /^..(.)/;    }
   sub hyd      { $uwp{+shift} =~ /^...(.)/;   }
   sub pop      { $uwp{+shift} =~ /^....(.)/;  }
   sub gov      { $uwp{+shift} =~ /(.).-.$/;   }
   sub law      { $uwp{+shift} =~ /(.)-.$/;    }
   sub tl       { $uwp{+shift} =~ /(.)$/;      }
   
   sub pm       { $pbg{+shift} =~ /^(.)/;      }
   sub belts    { $pbg{+shift} =~ /^.(.)/;     }
   sub ggs      { $pbg{+shift} =~ /(.)$/;      }
   
   sub primary  { $stars{+shift}->[0];         }
   
   sub DESTROY 
   {
       my $self = shift;
       delete $name  {$self},
              $hex   {$self},
              $uwp   {$self},
              $base  {$self},
              $codes {$self},
              $zone  {$self},
              $pbg   {$self},
              $alleg {$self},
              $stars {$self},
              $xboat {$self};
   }
   
   sub create
   {
      my $line = shift;
   
      # Convert really really old format into new format.
      $line = sprintf( "%-49s 001 ?? ??", $1) 
         if $line =~ /^(.{29,50}\s*)G\s*$/;
      $line = sprintf( "%-49s 000 ?? ??", $1) 
         if $line =~ /^(.{29,50})\s*$/;
   
      unless 
      ( $line =~  
#
#  name  hex    uwp                        - base  codes  zone     pbg
+   allg. stellar    xboat
#
 /^(.*)(\d{4}) (\w)(\w)(\w)(\w)(\w)(\w)(\w).(\w) \s?(.) (.{15}) (.) \s
+?(\d)(\d)(\d) (..) ([^:]*)?\s*(:.*)?$/ 
      )
      {
         #croak "Cannot decode UWP format: $line";
         return 0;
      }

      my $self = new UWP;
   
      $self->uwp     = $3.$4.$5.$6.$7.$8.$9.'-'.$10;         
   
      $self->name    = $1;
      $self->loc     = $2;
      $self->base    = $11;
      $self->codes   = $12;
      $self->zone    = $13;
   
      $self->pbg     = $14.$15.$16;   
      $self->alleg   = $17;

      $self->stars   = getStars( $18 );
      $self->xboat   = $19 || '';
      $self->xboat   =~ s/://;
   
      return $self;
   }   

   #
   #   There's going to be 1, 2, or 3 stars, I think.  
   #   But maybe 4.
   #
   sub getStars
   {
      my $stars  = shift;
      chomp $stars;
      
      return [ "$1 $2", "$3 $4", "$5 $6", "$7 $8" ]
         if ( $stars =~ 
      /(\w\d) (\w+) (\w\d) (\w+) (\w\d) (\w+) (\w\d) (\w+)/ );
         
      return [ "$1 $2", "$3 $4", "$5 $6" ]
         if ( $stars =~ 
      /(\w\d) (\w+) (\w\d) (\w+) (\w\d) (\w+)/ );
   
      return [ "$1 $2", "$3 $4" ]
         if ( $stars =~ 
      /(\w\d) (\w+) (\w\d) (\w+)/ );
   
      return [ $stars ];
   }

}
1;
[download]