frameset_alternative.pl

#!/usr/bin/perl -w

use strict;

use lib "./Module/"; # include folder to searching for Modules
use open ':utf8';

use Date::Parse;
use Date::Format;
use Date::Language;
use File::stat;
use File::Basename;
use HTML::Packer;

if(scalar(@ARGV) == 0) {
  die "usage: '$0 <filename>'\n\n";
}

# e.g. data/blabla.inc
my $replace_content_filename = $ARGV[0];

my $master_filename = "data/master.html";
my $mobile_master_filename = "data/m/master.html";
my $master_str = "";
my $mobile_str = "";
my $replace_content = "";
my $file_title = "";
my $title = "Elektronik-Lexikon";
my $cnt;
my $german = Date::Language->new("German");

my $outfile = $replace_content_filename;
$outfile =~ s|\bdata/|www/|g;
$outfile =~ s|\.inc$|.html|g;
# e.g. www/blabla.html

my $mobilefile = $replace_content_filename;
$mobilefile =~ s|\bdata/|www/m/|g;
$mobilefile =~ s|\.inc$|.html|g;
# e.g. www/m/blabla.html

my(undef, $outdir, undef) = fileparse($outfile);
my(undef, $mobileoutdir, undef) = fileparse($mobilefile);
if(!-e $outdir || !-e $mobileoutdir) {
  use File::Path;
  
  File::Path::make_path($outdir, {
    verbose => 1,
    mode => 0777
  });
  File::Path::make_path($mobileoutdir, {
    verbose => 1,
    mode => 0777
  });
}

my @pathparts = split('/', $outfile);
$pathparts[0] = 'Home'; # replace first element (www/)

my $filename = $outfile;
$filename =~ s|.*/||s;

# files are expected to be in data dir
my $dir_prefix = '';
if($outfile =~ m|www/(.*/)|) {
  # replace outpath with reverse path to be able to use relative paths
  # always points on base dir (www)
  # e.g. www/xxx/xxx.html -> $dir_prefix = '../'
  $dir_prefix = $1;
  $dir_prefix =~ s|[^/]+|..|g;
}

my $path = '';
if($outfile =~ m|www/(.*)$|) {
  $path = $1;
}

open FH_CONTENT, $replace_content_filename or die "unable to open '$replace_content_filename', $!";
while (<FH_CONTENT>) {
  $replace_content .= $_;
}
close FH_CONTENT;

my $lastmod = stat($replace_content_filename)->mtime;

open FH_MASTER, $master_filename or die "unable to open '$master_filename', $!";
while (<FH_MASTER>) {
  $master_str .= $_;
}
close FH_MASTER;

open FH_MASTER, $mobile_master_filename or die "unable to open '$master_filename', $!";
while (<FH_MASTER>) {
  $mobile_str .= $_;
}
close FH_MASTER;


if($replace_content =~ s|<!-- TITLE="(.*?)" -->||) {
  $file_title = $1;
  $title = $file_title . ' :: ' . $title;
}

my $keywords = "";
if($replace_content =~ s|<!-- KEYWORDS="(.*?)" -->||) {
  $keywords = $1 if($1 ne '');
}

my $desc_text = "Hier finden Hobby-Elektroniker alles, was sie interessieren könnte: Projekte und Schaltungen, Links, ein ausführliches Lexikon und vieles mehr.";
if($replace_content =~ s|<!-- DESCRIPTION="(.*?)" -->||) {
  $desc_text = $1 if($1 ne '');
}

pop(@pathparts); # remove last element

my @path_links = ();

for($cnt=0; $cnt<scalar(@pathparts); $cnt++) {
  my $href = '../' x (scalar(@pathparts) - $cnt - 1);
  
  push(@path_links, '<a href="' . $href . 'index.html">' . $pathparts[$cnt] . '</a>');
}
if($outfile =~ m|index\.html$|) {
  pop(@path_links);
}

my @path_links_mobile = @path_links;

push(@path_links, '<a href="' . $filename . '" class="current">' . $file_title . '</a>');
push(@path_links_mobile, ''); # to keep ending &rsaquo;

my $path_www = join(' &rsaquo; ', @path_links);
my $path_www_mobile = join(' &rsaquo; ', @path_links_mobile);

my $next = "";
my $prev = "";
if($replace_content =~ s|<a class="next" href="(.*?)">(.*?)</a>|<a class="next" href="$1"><span class="icon"></span>$2</a>|) {
  $next = "<link rel=\"next\" title=\"$2\" href=\"$1\" />";
}
if($replace_content =~ s|<a class="prev" href="(.*?)">(.*?)</a>|<a class="prev" href="$1"><span class="icon"></span>$2</a>|) {
  $prev = "<link rel=\"prev\" title=\"$2\" href=\"$1\" />";
}
$replace_content =~ s|(<a class="quer" href=".*?">)(.*?</a>)|$1<span class="icon"></span>Siehe auch $2|g;
$replace_content =~ s|(<p id="navigation">.*?)(</p>)|$1<br /><a href="index.html"><span class="icon"></span>Inhaltsverzeichnis</a>$2|sg;

$replace_content =~ s|/BRUCH/([^/]*)/([^/]*)/([^/]*)/|<table cellspacing="0" cellpadding="0" border="0" summary="Bruch" class="noborder">
  <tr><td rowspan="3" style="vertical-align:middle;">$1&nbsp;</td><td style="text-align:center;">&nbsp;$2&nbsp;</td></tr>
  <tr style="height:1px;"><td style="padding:0px;height:1px;"><hr /></td></tr>
  <tr><td style="text-align:center;">&nbsp;$3&nbsp;</td></tr>
</table>|g;
$replace_content =~ s#\|BRUCH\|([^|]*)\|([^|]*)\|([^|]*)\|#<table cellspacing="0" cellpadding="0" border="0" summary="Bruch" class="noborder">
  <tr><td rowspan="3" style="vertical-align:middle;">$1&nbsp;</td><td style="text-align:center;">&nbsp;$2&nbsp;</td></tr>
  <tr style="height:1px;"><td style="padding:0px;height:1px;"><hr /></td></tr>
  <tr><td style="text-align:center;">&nbsp;$3&nbsp;</td></tr>
</table>#g;
$replace_content =~ s|/DREIECK/(.*?)/(.*?)/(.*?)/|<table cellpadding="0" cellspacing="0" class="noborder dreieckimg" summary="Formel-Tipp-Wort">
  <tr>
    <td class="o1"> </td>
    <td class="o2">$1</td>
    <td class="o3"> </td>
  </tr>
  <tr>
    <td class="u1">$2</td>
    <td class="u2">&middot;</td>
    <td class="u3">$3</td>
  </tr>
</table>|g;
$replace_content =~ s|<div class="code"><p>|<div class="code"><b>Code:</b><p>|g;
$replace_content =~ s/\\I/<code>I<\/code>/sg;

$replace_content =~ s|<!\[CDATA\[|/*<![CDATA[ <!--*/|g;
$replace_content =~ s|]]>|//--> ]]>|g;

$replace_content =~ s|(<a .*? hreflang="de".*?>)|$1<img src="../src/deutsch.png" alt="deutsch" />&nbsp;|sg;
$replace_content =~ s|(<a .*? hreflang="en".*?>)|$1<img src="../src/english.png" alt="english" />&nbsp;|sg;

# MathML characters are not fully implemented in HTML
$replace_content =~ s|&sdot;|&#8901;|g;
$replace_content =~ s|&omega;|&#969;|g;
$replace_content =~ s|&epsiv;|&#949;|g;
$replace_content =~ s|&plus;|+|g;

if($replace_content =~ s|<!-- NO_TOPLINK -->||) {
  $master_str =~ s|<div id="addthis_bottom_toolbar">.*?<!--{/footer}-->||ms;
}

if(index($replace_content, "{news_") > -1) {
  open INFILE, "data/news.txt" or die "unable to open 'data/news.txt', $!";
  my @news;
  while (<INFILE>) {
    chomp($_);
    push(@news, $_);
  }
  close INFILE;
  @news = reverse(@news);
  while($replace_content =~ /\{news_latest(\d+)\}|\{news_(all)\}/) {
    my $max = $1;
    my $str = "";
    my $archive = 0;
    
    if(!defined $max || int($max) == 0) {
      $max = scalar(@news);
      $archive = 1;
    }
    
    for(0 .. int($max)-1) {
      my $i = $_;
      if(!defined $news[$i]) {
        last;
      }
      my @infos = split(/ == /, $news[$i]);

      my $news_id = getNewsId($infos[0], $infos[1]);
      my $title = $infos[1];
            
      if($infos[3] ne "-") {
        $infos[2] .= ' <a href="' . $infos[3] . '">mehr &raquo;</a>';
      }
      if($archive) {
        $infos[2] =~ s|<a href=["'](.*?)["']|'<a href="' . formatNewsLink($1) . '"'|ge;
      }
      $str .= '<div class="recentchanges" id="' . $news_id . '"><h3>'
        . '<a href="' . ($archive ? "" : "Diverses/news.html") . '#' . $news_id . '" class="date">' . formatDate($infos[0], $archive ? "html" : "%d.%m.%Y") . '</a> '
        . $title . '</h3><p>' . $infos[2] . '</p></div>';
    }
    $replace_content =~ s/\{news_latest\d+\}|\{news_all\}/$str/;
  }
  while($replace_content =~ /\{news_id(\d+)\}/) {
    my @infos = split(/ == /, $news[$1]);
    my $news_id = getNewsId($infos[0], $infos[1]);
    $replace_content =~ s/\{news_id\d+\}/$news_id/;
  }
}

while($replace_content =~ /\{get_file_contents\:(.+?)\}/) {
  my $file = $1;
  my $str = "";
  
  open FH, $file or die "unable to open '$file', $!";
  while (<FH>) {
    if($_ =~ /\#NOINCLUDE\#/) {
      next;
    }
    $_ =~ s/^\#INCLUDE\#\s*//;
    $_ =~ s/&/&amp;/g;
    $str .= $_;
  }
  close FH;
  
  # a bug in Syntax::Highlight::Engine::Kate...
  $str =~ s/<\/div>/<\/divx>/g;
  
  $replace_content =~ s/\{get_file_contents\:.+?\}/$str/;
}

# syntax highlighting
while(index($replace_content, '<div class="code-') > -1) {
  use Syntax::Highlight::Engine::Kate;

  my $type = "undef";
  my $code = "undef";
  if($replace_content =~ s|<div class="code-([\w\s]+?)"(.*?)>(.*?)</div>|\{_code\}|ms) {
    $type = $1;
    $code = $3;
    
    my $attrs = $2;
    my $type_class = lc($type);
    $type_class =~ s/[^\w]/-/g;
    $replace_content =~ s|\{_code\}|<div class="code code-$type_class"$attrs>\{_code\}</div>|;
  }
  else {
    $replace_content =~ s|<div class="code-|<div class="code code-|;
    next;
  }

  my $hl = new Syntax::Highlight::Engine::Kate(
    language => $type,
    substitutions => {
      "<" => '&lt;',
      ">" => '&gt;',
      " " => '<span class="space">&nbsp;</span>',
      "\t" => "<span class=\"tab\">\t</span>",
      "\n" => '<br />',
    },
    format_table => {
      Alert => '<span class="alert">%%</span>',
      BaseN => '<span class="basen">%%</span>',
      BString => '<span class="bstring">%%</span>',
      Char => '<span class="char">%%</span>',
      Comment => '<span class="comment">%%</span>',
      DataType => '<span class="datatype">%%</span>',
      DecVal => '<span class="decval">%%</span>',
      Error => '<span class="error">%%</span>',
      Float => '<span class="float">%%</span>',
      Function => '<span class="function">%%</span>',
      IString => '<span class="istring">%%</span>',
      Keyword => '<span class="keyword">%%</span>',
      Normal => '<span class="normal">%%</span>',
      Module => '<a class="function external no_bg" href="https://metacpan.org/module/%%">%%</a>',
      Operator => '<span class="operator">%%</span>',
      Others => '<span class="others">%%</span>',
      RegionMarker => '<span class="regionmarker">%%</span>',
      Reserved => '<span class="reserved">%%</span>',
      String => '<span class="string">%%</span>',
      Variable => '<span class="variable">%%</span>',
      Warning => '<span class="warning">%%</span>'
    }
  );
  my $highlightedCode = "";
  my @lines = split("\n", $code);
  foreach(@lines) {
    $highlightedCode .= $hl->highlightText($_ . "\n");
  }
  my $hint = ($type eq "AVR Assembler") ? ' <span class="small">(Klicke auf Befehle, um mehr über sie zu erfahren)</span>' : '';
  $replace_content =~ s|\{_code\}|<b>$type-Code:</b>$hint<br /><pre>$highlightedCode</pre>|;
}

# a bug in Syntax::Highlight::Engine::Kate...
$replace_content =~ s/<\/divx>/<\/div>/g;
$replace_content =~ s/&lt;\/divx&gt;/&lt;\/div&gt;/g;

$replace_content =~ s|<a href="http(s?://[^>]*?)"((?: [^>]+)?) class="([\w\s]+)"((?: [^>]+)?)>|<a class="external $3" href="http$1"$2$4>|sg;
$replace_content =~ s|<a href="http(s?://[^>]*?)"((?: [^>]+)?)>|<a class="external" href="http$1"$2>|sg;

$replace_content =~ s/<blockquote>\["\]/<blockquote><span><span class="bqstart">&bdquo;<\/span>/g;
$replace_content =~ s/<blockquote>(.*?)\["\]/<blockquote>$1<span class="bqend">&rdquo;<\/span><\/span>/g;

$replace_content =~ s/\["\](.*?)\["\]/&bdquo;$1&rdquo;/g;
$replace_content =~ s/ -- / &mdash; /g;
$replace_content =~ s/\[["']\]/&quot;/g;

$replace_content =~ s/\xE4|ä/&auml;/g;
$replace_content =~ s/\xF6|ö/&ouml;/g;
$replace_content =~ s/\xFC|ü/&uuml;/g;
$replace_content =~ s/\xC4|Ä/&Auml;/g;
$replace_content =~ s/\xD6|Ö/&Ouml;/g;
$replace_content =~ s/\xDC|Ü/&Uuml;/g;
$replace_content =~ s/\xDF|ß/&szlig;/g;

$master_str =~ s|\{breadcrumb_nav\}|$path_www|s;
$mobile_str =~ s|\{breadcrumb_nav\}|$path_www_mobile|s;

$replace_content =~ s/<!--(?:\[\s+|\{).*?(?:\s+\]|\})-->//gms;

$master_str =~ s|\{content\}|$replace_content|sm;

#$replace_content =~ s|<h1>.*?</h1>||;
$mobile_str =~ s|\{content\}|$replace_content|sm;

$master_str =~ s|\{meta_link_next\}|$next|;
$mobile_str =~ s|\{meta_link_next\}|$next|;
$master_str =~ s|\{meta_link_prev\}|$prev|;
$mobile_str =~ s|\{meta_link_prev\}|$prev|;

$master_str =~ s|\{page_title\}|$title|;
$mobile_str =~ s|\{page_title\}|$title|g;
$master_str =~ s|\{page_keywords\}|$keywords|g;
$mobile_str =~ s|\{page_keywords\}|$keywords|g;
$master_str =~ s|\{page_description\}|$desc_text|g;
$mobile_str =~ s|\{page_description\}|$desc_text|g;
$master_str =~ s|\{page_path\}|$path|gs;
$mobile_str =~ s|\{page_path\}|$path|gs;

$master_str =~ s|\{page_lastmod\}|$german->time2str("%A, %d.%m.%Y", $lastmod)|eg;
$mobile_str =~ s|\{page_lastmod\}|$german->time2str("%A, %d.%m.%Y", $lastmod)|eg;
$master_str =~ s|\{page_lastmod_iso\}|$german->time2str("%Y-%m-%d", $lastmod)|eg;
$mobile_str =~ s|\{page_lastmod_iso\}|$german->time2str("%Y-%m-%d", $lastmod)|eg;

$master_str =~ s|\{year\}|$german->time2str("%Y", time)|eg;
$mobile_str =~ s|\{year\}|$german->time2str("%Y", time)|eg;
if(index($master_str, '15') > -1 || index($mobile_str, '15') > -1) {
  use Time::Local;
  
  my $geburtstag = 25;
  my $geburtsmonat = 8;
  my $geburtsjahr = 1996;

  my ($nyear) = (localtime(time))[5];
  my $agesec = timelocal(1,1,0,$geburtstag,$geburtsmonat-1,$nyear+1900);
  my $alter = ($agesec>time ? $nyear+1899-$geburtsjahr : $nyear+1900-$geburtsjahr);

  $master_str =~ s|\{author_age\}|$alter|g;
  $mobile_str =~ s|\{author_age\}|$alter|g;
}

$mobile_str =~ s|../|../$dir_prefix|g;
$mobile_str =~ s|mobile_prefix/|$dir_prefix|g;

# no mobile content modification from here on

$mobile_str =~ s/<!--(?:\[\s+|\{).*?(?:\s+\]|\})-->//gms;
my $packer = HTML::Packer->init();
$packer->minify(\$mobile_str, {
  'remove_newlines' => 1
});

open FH_OUT, ">" . $mobilefile or die "unable to open mobile '$mobilefile' for write, $!";
print FH_OUT $mobile_str;
close FH_OUT;

print "generated mobile '$mobilefile'\n";

###

@pathparts = split('/', $outfile);

for($cnt=1; $cnt<scalar(@pathparts); $cnt++) {
  my $i = 1;
  my $test_sub_path = '';
  while($i <= $cnt) {
    $test_sub_path .= '/' . $pathparts[$i];
    $i++;
  }
  $master_str =~ s|<a class="aufklapp" href="prefix_master_layout$test_sub_path(/?)">|<a class="aufklapp current" href="prefix_master_layout$test_sub_path$1">|ms;
  $master_str =~ s|<a href="prefix_master_layout$test_sub_path(/?)">|<a class="current" href="prefix_master_layout$test_sub_path$1">|gms;
}

$master_str =~ s|</h1>|</h1><div id="addthis_top_toolbar"><div class="addthis_toolbox addthis_default_style">
  <span class="addthis_separator">Weitersagen: </span>
  <a class="addthis_button_preferred_1"></a>
  <a class="addthis_button_preferred_2"></a>
  <a class="addthis_button_preferred_3"></a>
  <a class="addthis_button_preferred_4"></a>
  <a class="addthis_button_compact"></a>
  <a class="addthis_counter addthis_bubble_style"></a>
</div></div>|;

$master_str =~ s|../|$dir_prefix|g;

$master_str =~ s/<!--(?:\[\s+|\{).*?(?:\s+\]|\})-->//gms;
$packer->minify(\$master_str, {
  'remove_newlines' => 1
});

open FH_OUT, ">" . $outfile or die "unable to open '$outfile' for write, $!";
print FH_OUT $master_str;
close FH_OUT;

print "generated '$outfile'\n\n";



sub getNewsId {
  my $date = shift;
  my $title = shift;
  
  my $news_id = lc("news_" . $date . "_" . $title);
  $news_id =~ s/\xE4|ä/ae/g;
  $news_id =~ s/\xF6|ö/oe/g;
  $news_id =~ s/\xFC|ü/ue/g;
  $news_id =~ s/\xDF|ß/ss/g;
  $news_id =~ s/[^a-zA-Z0-9_\-]/-/g;
  
  return $news_id;
}
sub formatNewsLink {
  my $url = shift;
  
  if($url !~ m[^(?:https?://|ftp://|mailto:|javascript:|#)]) {
    $url = "../" . $url;
  }
  return $url;
}
sub formatDate {
  my $date = shift;
  my $format = shift;
  my $language = shift;
  
  if(lc($format) eq "iso-8601") {
    $format = "%Y-%m-%d %H:%M";
    $language = "English";
  }
  elsif(lc($format) eq "rfc-822") {
    $format = "%a, %d %h %Y %H:%M:%S %Z";
    $language = "English";
  }
  elsif(lc($format) eq "html") {
    $format = "%d.%m.%Y <span class=\"time\">%H:%M</span>";
    $language = "German";
  }
  
  if(!defined $language) {
    $language = "German";
  }
  
  my $lang = Date::Language->new($language);
  return $lang->time2str($format, $german->str2time($date));
}