-
-sub mk_urls_of_uris {
-#rebuild $uris_dbm.db fetching resource indexes from servers
- my (
- $server, $idxfile, $uri, $url, $comp, $line,
- @servers,
- %urls_of_uris
- );
-
- untie %map;
- if (stat $uris_dbm.".db") { # remove old db file
- unlink($uris_dbm.".db") or
- die "cannot unlink old db file: $uris_dbm.db\n";
- }
- tie(%urls_of_uris, 'DB_File', $uris_dbm.".db", O_RDWR|O_CREAT, 0664);
-
- open (SRVS, "< $servers_file") or
- die "cannot open servers file: $servers_file\n";
- @servers = <SRVS>;
- close (SRVS);
- while ($server = pop @servers) { #cicle on servers in reverse order
- print "processing server: $server ...\n";
- chomp $server;
- helm_wget($tmp_dir, $server."/".$indexname); #get index
- $idxfile = $tmp_dir."/".$indexname;
- open (INDEX, "< $idxfile") or
- die "cannot open temporary index file: $idxfile\n";
- while ($line = <INDEX>) { #parse index and add entry to urls_of_uris
- chomp $line;
- ($uri,$comp) = split /[ \t]+/, $line;
- # build url:
- if ($comp =~ /gz/) {
- $url = $uri . ".xml" . ".gz";
- } else {
- $url = $uri . ".xml";
- }
- $url =~ s/cic:/$server/;
- $url =~ s/theory:/$server/;
- $urls_of_uris{$uri} = $url;
- }
- close INDEX;
- die "cannot unlink temporary file: $idxfile\n"
- if (unlink $idxfile) != 1;
- }
-
- untie(%urls_of_uris);
- tie(%map, 'DB_File', $uris_dbm.".db", O_RDONLY, 0664);
-}
-