#!/usr/bin/perl # Add -wT ? # # $Revision: 1.15 $ # # See the bottom of this file for the POD documentation. # Search for the string '=head'. # http://www.jurta.org/cgi-bin/regenerate.pl?/var/www/virtual/jurta.org/www # wget -nv -O - http://www.jurta.org/cgi-bin/regenerate.pl # TODO: generate images HEIGHT and WIDTH # TODO: make relative path in navbar index, e.g.: ../../emacs/index.en.html # TODO: navigation by up,next,prev buttons # TODO: board # TODO: flock use strict; use CGI qw(:standard); use File::Find; use Data::Dumper; $Data::Dumper::Indent = 1; undef $/; # enable slurp mode $| = 1; # enable autoflush use vars qw( $DEBUGGING_IP $root $charset ); BEGIN { if (defined($ENV{'DOCUMENT_ROOT'})) { $charset = "iso-8859-1"; # "koi8-r" print "Content-Type: text/html; charset=$charset\n\n"; # print "Content-Type: text/plain; charset=$charset\n\n"; sub html_show_error { my ($text) = shift; # TODO: if $ENV{'REMOTE_ADDR'} =~ $DEBUGGING_IP { } # if ($DEBUGGING_IP) { # $text = cleanup_input($text); # } else { # $text = ""; # } # my ( $pack, $file, $line, $sub ) = caller(0); # my ($id ) = $file =~ m%([^/]+)$%; # return undef if $file =~ /^\(eval/; print "\n"; print < 500 - Server error!

ERROR 500 - Server error!

The server encountered an internal error and was unable to complete your request.

$text

HERE die @_; }; $SIG{__DIE__} = \&html_show_error; delete @ENV{qw(ENV BASH_ENV IFS PATH)}; # my $query = new CGI; # print $query->header(); # print "

";
    # BAD:
    # $root = $ENV{'QUERY_STRING'};
    # $root =~ tr/+/ /;
    # $root =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
    # GOOD: when used under CGI root path should be hard-coded
    $root = "/home/jurta/jurta.org";
  } elsif (defined $ARGV[0]) {
    $root = $ARGV[0];
  }
  if (!($root && -d $root)) {
    die "ERROR: Please specify start-dir as program argument\n";
  } else {
    $root =~ s(/$)();
  }
}

# Tables

# Translations
my $trs = {
    'en' => {
        'sitemap' => 'Site Map',
        'contents' => 'Page Contents',
        'search' => 'Search this site:',
        'addcomment' => 'Add comment',
        'viewcomments' => 'View comments',
        'en' => 'english', # 'eng',
        'ru' => 'no-pyccku', # 'pycckuu', 'pyc', 'Русский'
        'uk' => 'ykpaihcbka', # 'ykp', 'Українська',
    },
    'ru' => {
        'sitemap' => 'Карта сайта',
        'contents' => 'Содержание страницы',
        'search' => 'Поиск по сайту:',
        'addcomment' => 'Добавить комментарий',
        'viewcomments' => 'Читать комментарии',
        'en' => 'english', # 'eng',
        'ru' => 'русский', # 'pyc',
        'uk' => 'украiнська', # 'укр',
    },
};

# Photo database

my $phototext;
my %photos;
if (open(FIN, ";
  close(FIN);
  %photos = map {
    my ($f, $ft, $fw, $tite, $titr, $gps);
    $f    = $1 if (m(^File: (.*)$)m);
    $ft   = $1 if (m(^FileT: (.*)$)m);
    $fw   = $1 if (m(^FileW: (.*)$)m);
    $tite = $1 if (m(^Title\[en\]: (.*)$)m);
    $titr = $1 if (m(^Title\[ru\]: (.*)$)m);
    $gps  = $1 if (m(^GPS-URL: (.*)$)m);
    ($ft, [$f, $fw, $tite, $titr, $gps])
  } split(/\f/,$phototext)
}

# print Dumper(%photos);
# print Dumper($photos{'/home/juri/.thumbnails/normal/e84726eb0207c47df013c47220bd8565.png'});

# Global variables

my $file_level; # level of current file relative to the dir tree root
my $file_ups;   # a string like "../../.." to reach the dir tree root
my $file_lang;  # language of current file extracted from file name suffix

# 1. create sidebar index
# 1.1. extract information (filenames and HTML titles) from HTML files

my $ctree; # category tree
my %files;
my %boards;
my %lj_boards = (
    'index.en.html' => '641',
    'index.ru.html' => '484',
    'about.en.html' => '1117',
    'about.ru.html' => '983',
    'tanja/index.ru.html' => '1315',
);

find({ wanted => \&html_file_get_info, no_chdir => 1 }, $root);

sub html_file_get_info {
  if (m(\.html(?:\.en|\.ru)?$)i and !m(/(?:s?cgi-bin|errors|forum|stat)/)i) {
    my ($fileabs, $filerel, $filename) = ($File::Find::name) x 3;
    my ($fileabsdir, $filereldir) = ($File::Find::dir) x 2;
    my ($filelang);
    $filerel =~ s(^$root/)();
    $filename =~ s(^$fileabsdir/)();
    $filereldir =~ s(^$root)();
    $filelang = $1 if $filename =~ m(\.([a-z]{2,3})\.html$);

    my $text;
    if (open(FIN, "<$fileabs")) {
      $text = ;
      close(FIN);

      # $text =~ s()()g;

      # TODO: check for 
      if ($fileabs =~ m(/board/)i and
          $text =~ m(.*)i) {
        $boards{$1} = $filename;
        print "$1 = $filename
\n";
      }
      if ($text =~ m((.*?))i) {
        my ($title, $h1, $catpath) = ($1, "", $filerel);
        $title =~ s(( - ЮРТА)*)()g;
        $title =~ s(( - JURTA)*)()g;
        $catpath =~ s(/?index\.[^/]+$)();
        if ($text =~ m((.*?))i) { $h1 = $1; $h1 =~ s(<[^>]*>)()g; }

        $text =~ s((?<=).*(?=))()isg;
        $text =~ s((?<=).*(?=))()isg;
        my ($li,$links) = (0);
        while ($text =~ m(href="(\.\.?/)*([^"]+)")g) { $links->{$2} = $li++; } # " Hi,Emacs!

        $ctree->{$filelang} = file2ctree($catpath, $filerel, $filereldir, $title, $h1,
                                         $ctree->{$filelang},$links);
        $files{$filerel} = {'t' => $title};
      }
    }
  }
}

sub file2ctree {
  my ($catpath, $filerel, $filereldir, $title, $h1, $ctree, $links) = @_;
  if ($catpath eq '') {
    $ctree->{'d'} = $filereldir;
    $ctree->{'f'} = $filerel;
    $ctree->{'t'} = $title;
    $ctree->{'h'} = $h1;
    $ctree->{'links'} = $links if defined $links;
    return $ctree;
  }
  my ($cfirst, $crest) = ($catpath =~ m(^([^/]+)/?(.*)));
  $ctree->{'chash'}->{$cfirst} = file2ctree($crest, $filerel, $filereldir, $title, $h1,
                                            $ctree->{'chash'}->{$cfirst}, $links);
  $ctree
}

# 1.2. sort category tree

sub ctreesort {
  my ($ctree) = @_;
  my ($str) = "";
  return if !exists $ctree->{'chash'};
  my (@chashes) = map {
    $ctree->{'chash'}->{$_}->{'c'} = $_;
    $ctree->{'chash'}->{$_}
  } sort {

    # print "$ctree->{'f'},$a,$ctree->{'chash'}->{$a}->{'f'},$ctree->{'links'}->{$a}\n";
    # print "$ctree->{'f'},$b,$ctree->{'chash'}->{$b}->{'f'},$ctree->{'links'}->{$b}\n";

    exists($ctree->{'links'}->{$ctree->{'chash'}->{$a}->{'f'}}) &&
    exists($ctree->{'links'}->{$ctree->{'chash'}->{$b}->{'f'}}) &&
    $ctree->{'links'}->{$ctree->{'chash'}->{$a}->{'f'}} <=>
    $ctree->{'links'}->{$ctree->{'chash'}->{$b}->{'f'}} ||
    exists($ctree->{'links'}->{$ctree->{'chash'}->{$a}->{'f'}}) && -1 ||
    exists($ctree->{'links'}->{$ctree->{'chash'}->{$b}->{'f'}}) &&  1 ||
    !exists($ctree->{'chash'}->{$a}->{'t'}) &&  1 ||
    !exists($ctree->{'chash'}->{$b}->{'t'}) && -1 ||
    $ctree->{'chash'}->{$a}->{'d'} cmp $ctree->{'chash'}->{$b}->{'d'} ||
    $ctree->{'chash'}->{$a}->{'t'} cmp $ctree->{'chash'}->{$b}->{'t'}
  } keys %{$ctree->{'chash'}};
  $ctree->{'carray'} = \@chashes if @chashes;
  for (@chashes) { ctreesort($_) }
}

for my $lang (keys %$ctree) {
  ctreesort($ctree->{$lang});
}

# print Dumper($ctree);

sub ctree2str {
  my ($ctree, $level, $file_ups, $filerel, $catpath) = @_;
  my ($cfirst, $crest) = ($catpath =~ m(^([^/]+)/?(.*)));
  my ($class) = (($ctree->{'carray'} # || $ctree->{'chash'}
                 )
                 ? ($catpath eq '' ? 'ctclosed' : 'ctopen')
                 : 'ctbullet');
  my ($str) = "";

  $str .= "\n";
  $str .= ' ' x $level;
  $str .= ' '
       . ($filerel eq $ctree->{'f'}
          ? "$ctree->{'t'}"
          : "{'f'}\" title=\"$ctree->{'h'}\">$ctree->{'t'}")
       . '
';
  if (exists $ctree->{'carray'}) {
    for (@{$ctree->{'carray'}}) {
      $str .= ctree2str($_, $level+1, $file_ups, $filerel,
                        ($cfirst eq $_->{'c'} ? $crest : ""));
    }
  }
#   elsif (exists $ctree->{'chash'}) {
#     for (keys %{$ctree->{'chash'}}) {
#       $str .= ctree2str($ctree->{'chash'}->{$_}, $level+1, $file_ups, $filerel, $crest);
#     }
#   }
  $str .= '';
  $str
}

# 2. update HTML files
# 2.1. read every HTML file fully into string variable
# 2.2. add missing tags into this HTML string
# 2.3. add left and right sidebars
# 2.4. write result HTML string back into the same file

find({ wanted => \&html_file_update, no_chdir => 1 }, $root);

sub html_file_update {
  return unless -f;
  unless (m(\.html(?:\.en|\.ru)?$)i and !m(/(?:s?cgi-bin|errors|forum|stat)/)i) {
    print "NO: $_ - skipped
\n";
    return;
  }
  my ($fileabs, $filerel) = ($File::Find::name, $File::Find::name);
  $filerel =~ s(^$root/)();

  $file_level = scalar(() = $filerel =~ m(/)g);
  $file_ups = ($file_level > 0 ? ("../" x $file_level) : "./");
  $file_ups =~ s(/$)();

  if ($fileabs =~ m((?:\.ru\.html|\.html\.ru)$)) {
    $file_lang = 'ru';
  } elsif      ($fileabs =~ m((?:\.en\.html|\.html\.en)$)) {
    $file_lang = 'en';
  } else {
    $file_lang = 'en';
  }

  my ($text, $fcharset);
  unless (open(FIN, "<$fileabs")) {
    print "NO: $fileabs - can't open
\n";
    return;
  }
  $text = ;
  close(FIN);
  unless ($text =~ m((.*?))i) {
    print "NO: $fileabs - no title
\n";
    return;
  }
  for ($text) {
    #!m()i &&
    # s((?<=))(\n\nJURTA\n )i;
    # next rule is bad, because no title means don't add to category tree
    #!m()i &&
    #  s((?<=<head>))(\n<title>JURTA)i;
    $file_lang eq 'ru' &&
      m()i &&
      s(( - ЮРТА)*(?=))( - ЮРТА)i;
    $file_lang eq 'en' &&
      m()i &&
      s(( - JURTA)*(?=))( - JURTA)i;
    s(ЮРТА - ЮРТА(?=))(ЮРТА)i;
    s(JURTA - JURTA(?=))(JURTA)i;
    !m()i &&
      s((?<=))(\n)i &&
      s((?=))(\n)i;
    $file_lang eq 'ru' &&
      !m(\n)i;
    $file_lang eq 'ru' &&
      !m())(\n)i;
    $file_lang eq 'en' &&
      !m())(\n)i;
    $fcharset = $1 if (m())("\n")ie;
    # TODO: meta name="categories"
    !m())(\n)i;
    # !m())(\n)i;
    !m())(\n)i;
    !m())(\n)i;
    !m())(\n)i;
    !m())(\n)i;
    !m())(\n)i;
    !m(\n)i;

    s((^\n?)+)(create_gallery($&))iemsg;

# TODO: change  to 
# TODO: change  to 
    !m()i &&
      s((?<=))("\n".sidebar_left($filerel)."\n")ie
    ||s((?<=).*(?=))(sidebar_left($filerel))ies;
    !m()i &&
      s((?=\s*))("\n".sidebar_right($_,$filerel,$fcharset)."")ie
    ||s((?<=).*(?=))(sidebar_right($_,$filerel,$fcharset))ies;

    !m(google-analytics\.com/ga\.js) &&
     s((?=\s*))(

)i;
  }

  # untaint filename and then open it
  if ($fileabs =~ m|^($root/[-\w/.]+)$|) {
    if (open(FOUT, ">$1")) {
      print FOUT $text;
      print "OK: $fileabs($file_ups $filerel) $file_level
\n";
      close(FOUT);
    } else {
      print "NO: $fileabs - open failed $!
\n";
    }
  } else {
    print "NO: $fileabs - insecure filename
\n";
  }
}

sub create_gallery {
  my ($images) = @_;
  my $images2 = $images;

  $images =~ s(\n+)()g;
  $images =~ s(()()?()?()?)(\n$1\n$2\n$3\n$4\n\n)imsg;
  $images =~ s(())(create_image($&))iemsg; # " Hi,Emacs!

#   $images =~ s(^\n+)(); $images =~ s(\n+$)();
#   my @images = split('\n', $images);
#   my $rows = ($#images+1)/4;
#   print "{", $images, "}\n";
#   print "<", @images, ">\n";
#   print "<", join(":",@images), ">\n";
#   return $images2;

  return<
$images

GALLERY
}

sub create_image {
  my ($image) = @_;
  my $image_file = $1 if $image =~ m(src="(.*)");
  my $photo = $photos{$image_file};
  my ($f, $fw, $tite, $titr, $gps, $gpsurl) = ("", "", "", "", "");

#   print Dumper($image);
#   print Dumper($image_file);
#   print Dumper($photo);

  if (defined $photo) {
    $fw   = $photo->[1] if defined $photo->[1];
    $tite = $photo->[2] if defined $photo->[2];
    $titr = $photo->[3] if defined $photo->[3];
    $gpsurl = $photo->[4] if defined $photo->[4];
    if (defined $gpsurl) {
      if ($gpsurl =~ m(ll=([0-9]+\.[0-9]{1,2})[0-9]*,([0-9]+\.[0-9]{1,2})[0-9]*)) {
        $gps = "[[4].""."\">$1,$2]";
      } else {
        $gps = "[[4].""."\">GPS]";
      }
    }

    my ($reldir, $fname, $fext) = ($1, $2, $3)
      if ($fw =~ m((.*)/([^/]+)\.([^/]+)$));
    my $thumb = "$reldir/$fname.t.$fext";
    if ($reldir and $fname and $fext) {
      $image =~ s(())()i;
    } else {
      $image =~ s(())()i;
    }
  }

  $tite =~ s(\.?$)(
) if $tite;
  $titr =~ s(\.?$)(
) if $titr;

#   print Dumper($titr);
#   $titr\[2304x1728\]$gps
  return<
   $image
   $titr\[+\]$gps
  
IMAGE
}

# template for header and left sidebar
sub sidebar_left {
  my ($filerel) = @_;
  my $index2 = ctree2str($ctree->{$file_lang}, 0, $file_ups, $filerel, $filerel);

  # TODO: make a separate function and use it to generate:
  # 
  my $lang_switch = "";
  my $basefile = $filerel;
  $basefile =~ s((?:\.$file_lang\.html)$)();
  $basefile =~ s((?:\.html\.$file_lang)$)();
  my @translations = sort {
    $a->[0] cmp $b->[0]
  } grep {
    $_
  } map {
    m(^$basefile\.([a-z]{2,3})\.html$)
    ? [$1, $_]
    : (m(^$basefile\.html\.([a-z]{2,3})$)
    ? [$1, $_]
    : 0);
  } keys %files;
  if ($#translations > 0) {
    # $lang_switch .= "Language:";
    for (@translations) {
      if ($_->[0] eq $file_lang) {
        $lang_switch .= ' ['
                     . ($trs->{$file_lang}->{$_->[0]} || $_->[0])
                     . ']
';
      } else {
        $lang_switch .= " [[1]\">"
                     . ($trs->{$file_lang}->{$_->[0]} || $_->[0])
                     . ']
';
      }
    }
  }

  return<
   
    
     
      
     
    
     
    
      
    
     
    

A
A
A

$lang_switch
    
   
   
    
$trs->{$file_lang}->{'sitemap'}:

$index2

    
     
    
SIDEBAR_LEFT
}

# template for right sidebar and footer
sub sidebar_right {
  my ($text, $filerel, $fcharset) = @_;
  my ($index2, $discussion) = ("", "");

  while ($text =~ m(]*>(.*))ig) {
    my ($level, $header, $href) = ($1, $2);
    ($header =~ m((?:name|id)="([^"]+)")) && ($href = $1);
    $header =~ s(<[^>]+>)()g;
    $index2 .= " "x$level."- ".($href?"$header":"$header")."
\n";
  }

  if ($index2 ne "") { $index2 = "$trs->{$file_lang}->{'contents'}:
\n" . $index2; }

  if ($boards{$filerel}) {
    $discussion = "[ Discuss this page ]";
  } elsif ($lj_boards{$filerel}) {
    $discussion = "("
    . ""
    . " "
    . ""
    . "$trs->{$file_lang}->{'viewcomments'} | "
    . ""
    . "$trs->{$file_lang}->{'addcomment'})

";
  }

  if ($filerel =~ m(^board/)i) {
    $index2 .= "\n\n";
  }

#  TODO: Copyright © 2003-2005 Juri Linkov <juri\@jurta.org>
# 
# 

  my $current_year = (((localtime)[5])+1900);
  return<
     
    
$index2
    
   
   
     
     
    $discussion
     
     
   
   
    


  
  
  
  



    
    

Copyright © 2002-$current_year Juri Linkov <juri\@jurta.org>

    
    
     

      
         
    
   
  
SIDEBAR_RIGHT
}

# TODO: use linguistic module for Russian inflections
# TODO: make separate module from next function
sub collect_keywords {
  return ""; # not implemented
  my $text = shift;
  my (%fr);
  $text =~ s///sig;
  $text =~ s/<[^>]+>//ig;
  $text =~ s/&\w+;//ig;
  $text =~ tr/a-zA-Z0-9\200-\377/ /cs;
  $text =~ tr/A-Z/a-z/;
  for (split(/ /, $text)) { $fr{$_}++; }
  join ", ", (map {
    $_->[0]
  } sort {
    $b->[1] <=> $a->[1]
  } map {
    [$_, $fr{$_}]
  } keys %fr);#[0..3];
}

1;

__END__

=head1 NAME

regenerate - update HTML files with data collected from HTML tree

=head1 SYNOPSIS

    regenerate start-dir
    http://host/cgi-bin/regenerate.pl
    http://host/cgi-bin/regenerate.pl?host-start-dir (NOW DISABLED)

=head1 DESCRIPTION

B updates all HTML files from subdirectories under the
given start directory.  It updates HTML files by adding missing parts
(navbars, sidebars, indexes) with data collected from the same HTML
tree under the given start directory.  This program iterates HTML tree
in two passes.  At first step it collects needed information from HTML
tree by looking for HTML titles from every HTML file.  From this
information it builds the sidebar index string.  At second step this
program updates each HTML files under the start directory: it reads
every HTML file into string variable, adds missing tags into this HTML
string, adds left and right sidebars and writes result HTML string back
into the same file.

=head2 OPTIONS

    start-dir : the name of a directory under which all HTML files
                should be updated. If this script is executed under CGI,
                then start-dir can be the value of 'DOCUMENT_ROOT'.
                But to avoid undesirable results start-dir
                should be specified explicitely.

=head1 NOTES

B can be run stand-alone or from CGI.
When B is used under CGI, it outputs a content-type header.
B detects the fact that it is called under CGI by inspecting
the presense of the value of the 'DOCUMENT_ROOT' environment variable,
but it don't use this value.

=head1 SEE ALSO

B

=head1 AUTHOR

Juri Linkov Ejuri@jurta.org>

=head1 COPYRIGHT

Copyright (C) 2002-2006 Juri Linkov.  All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself or GPL.

;;; Local Variables:
;;; coding: koi8-r
;;; End:

=cut