Perl программа для создания sitemap файлов

Если кто-то ещё не знаком с тем, что такое sitemap файл, то это просто текстовый файл со списком всех файлов вашего веб-узла, которые предназначены для индексации Гуглом:
htp://www.cronc.com/
htp://www.cronc.com/ru.shtml
htp://www.cronc.com/ru/
htp://www.cronc.com/ru/perlbugs.shtml
htp://www.cronc.com/ru/substitute-n.shtml
htp://www.cronc.com/ru/interpolate.shtml
...
Он кладётся в корень сайта и предназначен для того, чтобы роботы Google лучше индексировали ваш сайт. Когда вы добавляете страницы на свой сайт, то также добавляете новые URL в sitemap файл и отправляете его Google из вашей панели инструментов https://www.google.com/webmasters/tools/home?hl=ru.

В Сети существуют сайты, которые в онлайне делают сайтмэпы, обходя ссылки по указанному адресу корневой страницы. Я раз попробовал подобный сервис, но созданный список оказался, мягко говоря, неполным. Тогда я написал свою программку на Perl, которая даёт также такие удобства:

• работает как на WEB-сервере, так и на локальном компьютере;
• можно задать имена каталогов и файлов, которые не должны включаться в список, в виде регулярных выражений Perl;
• задаются имена индексных файлов, которые вырежутся из путей, в виде регулярных выражений Perl;
• на выходе получается готовый sitemap файл, как будто вы его бережно набирали вручную на клавиатуре.

По поводу настройки данной Perl программы смотрите комментарии к ней. Свои отзывы и замечания отправляйте на мой e-mail. Ниже приведён текст этой программы на Perl.

#!/usr/bin/perl -w
use strict;
use integer;
use bytes;

# Программа для создания sitemap-файла. Автор Сергей Мельников (www.cronc.com/ru.shtml)
# Для создания sitemap.txt1, начиная с текущего каталога. Работает как на сервере, так и на локальном компьютере
# Вместо включения путей с файлами /^index\.[a-z]+$/ включаются пути после удаления имён этих файлов.
# Имя создаваемого sitemap-файла
my $sitemapname='sitemap.txt1';
# Имя хоста, добавляется впереди всех путей в sitemap-файле
my $hostname='http://www.mysite.com';
# Каталоги с этими именами исключаются
my $exclfolders=qr/^(?:cgi-bin|img|js|swf|WORK)$/;
# Исключение путей с этими файлами (хотя у них расширения подходят под $incltails).
my $exclfiles=qr/^(?:headerl|footer|tos|privacy)\./;
# Рассматриваем только эти файлы (и строки с / в конце, из которых удалили index.*)
my $incltails=qr/(?:php|shtml|\/)$/;
# Вырезаем из путей эти индексные файлы.
my $indexfiles=qr/^index\.[a-z]+$/;
# Абсолютный или относительный от этого скрипта путь к корню сайта. '.', если скрипт в корне сайта
my $rootsitepath='.';

$_= '.' unless $_=$rootsitepath;
# Меняем обратные слэши в пути на прямые (в случае Windows)
tr#\\#/#;
# Отрезаем конечный слэш
chop if rindex($_,'/') == length($_)-1;

open F,">$sitemapname" or die "Can not create $sitemapname\n";
binmode F;
 recurse_dir($_);
close F;

# Рекурсия каталогов, начиная с данного в параметре. Параметр не должен кончаться на /.
sub recurse_dir($)
{ my $path=$_[0];
  my $indexpassed=0;

  my @files= readFiles($path);
  # Обработка файлов
  foreach(@files)
   { if (substr($_,-1) ne '|')
      { my $path1=$path;
        # Удаляем . и / в начале пути
        $path1 =~ s/^\.//;
        $path1 =~ s#^/##;
        # Если path1 пуст, то слэш между $path1 и $path2 лишний
        my $slash=$path1 ? '/' : '';
        my $path2=$_;
        # Отрезаем индексные файлы
        if ($path2 =~ /$indexfiles/)
         { # На следующий повтор цикла, если путь без индексного файла уже записали
           next if $indexpassed;
           $path2='';
           $indexpassed=1;
         }
        print F "$hostname/$path1$slash$path2\n" ;
      }
   }

  # Обработка каталогов
  foreach(@files)
   { if (substr($_,-1) eq '|')
      { chop;
         recurse_dir("$path/$_");
      }
   }
}

# Получение списка файлов и каталогов. К каталогам добавляется символ |, чтобы отличать их от имён файлов.
# Параметр: путь в папку, где искать.
sub readFiles($)
{ my $path=$_[0];
  my @res;
  opendir DIR,$path or die "Can not open folder $path\n";
  foreach (readdir DIR)
   { if (-f "$path/$_") { push @res,$_ if /$incltails/    !/$exclfiles/ } else
      { push @res,"$_|" if -d "$path/$_"    $_ ne '.'    $_ ne '..'    !/$exclfolders/  }
   }
  closedir DIR;
  return @res;
}