view release on metacpan or  search on metacpan

Map.pm  view on Meta::CPAN

            # parse environment
            @check=(); while ($v=~/\$(\w+|\$)/g) { push (@check, $1) }
            for (@check) {
               if ( defined $ENV{$_} ) {
                   # User environment has ranges before registry and magics.
                   $v =~ s/\$$_/$ENV{$_}/g
               } elsif ( $_ eq '$' ) {
                   # Magic value $$
                   $v =~ s/\$\$/$MAP_Path/;
               } elsif ( defined $var{$_} ) {
                   # Apply registry variables
                   $v =~ s/\$$_/$var{$_}/g
               } else {
                   # Error, undefined value!  
                   warn ("Error in file REGISTRY: Variable '$_' not defined!");
                   return 0;
               }
            }
            # parse home tilde
            if (($v eq '~') || ($v=~/^~\//)) { 
               $v =~ s/^~/_getHomeDir()/e;
            }
         }
      }
      $var{$k} = $v;
   }
   my ($name, $map, $src, $srcURL, $style, @alias, $info);
   my %arg_s = (
      "name"=>\$name, "map"=>\$map, "src"=>\$src, "srcurl"=>\$srcURL,
      "style"=>\$style, "info"=>\$info
   );
   my %arg_a = ("alias"=>\@alias);
   $name=""; $map=""; $src=""; $srcURL=""; $style=""; @alias=(); $info="";
   while ( @file ) {
      $_ = shift ( @file );
      s/#.*//; s/^\s+//; s/\s+$//;
      if (!$_) {
         $S->_add_registry_entry (
            $name, $src, $map, $srcURL, $style, \@alias, $info
         ) if $name;
         $name=""; $map=""; $src=""; $srcURL=""; $style=""; @alias=();
         $info=""; next;
      }
      ($k, $v) = split /\s*[: ]\s*/,$_,2;
      for (keys %var) {
         $v =~ s/\$$_/$var{$_}/g;
      }
      $k = lc($k);
      if ($arg_s{$k}) {
         ${$arg_s{$k}} = $v;
      } elsif ($arg_a{$k}) {
         push (@{$arg_a{$k}}, $v);
      }
   }
   $S->_msg_fin("done") if $S->_noise>2;
   $registry_loaded=1;
1}

sub _getHomeDir {
    $ENV{HOME}
    || eval ( '(getpwuid($<))[7]' ) # for systems not supporting getpwuid
    || "/";
}

sub _add_registry_entry {
   my ($S, $name, $src, $map, $srcURL, $style, $aliasL, $info) = @_;
   $registry{$name} = {
      "ALIAS"   => $aliasL ? [@$aliasL] : [],
      "MAP"   => $map     || "",
      "INFO"   => $info    || "",
      "SRC"   => $src     || "",
      "SRCURL"  => $srcURL  || "",
      "STYLE"   => $style   || "",
   };
}

sub _dump_registry {
   my ($k, $v);
   print "\nDumping registry definition:\n";
   while (($k, $v) = each %registry) {
      print "Name: $k\n";
      printf "   src:     %s\n", $v->{"SRC"};
      printf "   srcURL:  %s\n", $v->{"SRC"};
      printf "   style:   %s\n", $v->{"STYLE"};
      printf "   map:     %s\n", $v->{"MAP"};
      printf "   info:    %s\n", $v->{"INFO"};
      print  "   alias: " . join (", ", @{$v->{"ALIAS"}}) . "\n";
      print  "\n";
   }
   print "done.\n";
}

##
## --- misc ---------------------------------------------------------------
##

sub _get_path {
   my ($S, $path) = @_;
   return $S->_error("Cannot find mapfile base directory!") if !$MAP_Path;
   $path =~ s/^\/+//;
   return "$MAP_Path/$path";
}

sub _list_to_intervals {
   my ($listR, $start, $end) = @_;
   my @split = ();
   my ($begin, $i, $partend);
   $i=$start;
   while ($i<=$end) {
      $begin = $i;
      $partend = $begin+254;
      while (
         ($i<$end) && 
         ($i<$partend) &&
         ($listR->[$i+1]==($listR->[$i]+1))
      ) { 
         $i++ 
      }
      push (@split, ($begin, $i));
      $i++;
   }