code: add Linker.pm (read comment in file)

- use linker in horas, - remove $lang from get ordinarium - getproprium return also source where item was found, do not use %winner2 etc. - add setcomment2 to replace setcomment in all cases - using linker: * monastic_major_responsory * lectio_brevis_prima * getpreces * invitatorium
FAJ-Munich · Oct 24, 2024 · d6a606e · d6a606e
1 parent 8e1e441
commit d6a606e
Show file tree

Hide file tree

Showing 8 changed files with 206 additions and 104 deletions.
diff --git a/web/cgi-bin/DivinumOfficium/Linker.pm b/web/cgi-bin/DivinumOfficium/Linker.pm
@@ -0,0 +1,64 @@
+package DivinumOfficium::Linker;
+# use strict;
+# use warnings;
+
+use DivinumOfficium::FileIO qw(do_read);
+
+BEGIN {
+  require Exporter;
+  our $VERSION = 1.00;
+  our @ISA = qw(Exporter);
+  our @EXPORT_OK = qw(linker);
+}
+
+
+#*** gettext($fname, $section)
+# gets text from $section in $fname
+# or just $fname content
+sub gettext {
+  my ($fname, $section) = split(/#/, shift, 2);
+  my $lang = shift;
+  if (!$section) {
+    my @a = do_read(main::checkfile($lang, $fname));
+    join("\n", @a);
+  } else {
+    $fname =~ s/\.txt$//;
+    my %h = %{main::setupstring($lang, "$fname.txt")};
+    $h{$section} =~ s/\n\n//r;
+  }
+}
+
+#*** linker($ref_to_specials_output, $lang)
+# digest output of specials() array of chunks
+# chunk cases                          replaced by
+# string @filename#section             section from filename
+# string @filename                     contents of filename
+# string other                         leave intact
+# array [string, func]                 'sources' ammended by 'func'
+#    string can contain multiple 
+#    'sources' divided by ";;" (in form 
+#    as two first cases but without @)
+#    'func' is called with 'sources' and lang
+sub linker {
+  my(@list) = @{$_[0]};
+  my($lang) = $_[1];
+
+  [ map {
+    if (ref($_) eq 'ARRAY') {
+      my @texts = map { gettext($_, $lang) } split(/;;/, $$_[0]);
+      if (exists($$_[1])) {
+        &{$$_[1]}(@texts, $lang);
+      } else {
+        $text
+      }
+    } else { # string
+      if (substr($_, 0, 1) eq '@') {
+        gettext(substr($_, 1), $lang)
+      } else {
+        $_
+      }
+    }
+  } @list ];
+}
+
+1;
diff --git a/web/cgi-bin/horas/horas.pl b/web/cgi-bin/horas/horas.pl
@@ -10,6 +10,7 @@
 use DivinumOfficium::LanguageTextTools
   qw(prayer rubric prex translate omit_regexp suppress_alleluia process_inline_alleluias alleluia_ant ensure_single_alleluia ensure_double_alleluia);
 use DivinumOfficium::Date qw(date_to_days days_to_date);
+use DivinumOfficium::Linker qw(linker);
 
 my $precesferiales;
 
@@ -39,19 +40,23 @@ sub horas {
     precedence();
   }
 
-  @script1 = getordinarium($lang1, $command);
-  @script1 = specials(\@script1, $lang1);
+  my (@ordinarium) = getordinarium($command);
+  @script1 = specials(\@ordinarium, $lang1);
+  @script1 = @{linker(\@script1, $lang1)};
   $column = 2;    # This prevents the duplications in the Building Script
 
   if ($Ck) {
     $version = $version2;
     load_languages_data($lang1, $lang2, $version, $missa);
     precedence();
+    @script2 = getordinarium($command);
+  } elsif (!$only) {
+    @script2 = @ordinarium;
   }
 
   if (!$only) {
-    @script2 = getordinarium($lang2, $command);
-    @script2 = specials(\@script2, $lang2);
+    @script2 = specials(\@script2, $lang2); # this line will be removed when %winner2 will be removed
+    @script2 = @{linker(\@script2, $lang2)};
   }
 
   print_content($lang1, \@script1, $lang2, \@script2, $version !~ /(1570|1955|196)/);
@@ -747,7 +752,6 @@ sub laudes {
 #*** getordinarium($lang, $command)
 # returns the ordinarium for the language and hora
 sub getordinarium {
-  my $lang = shift;
   my $command = shift;
 
   $command =~ s/Vesperae/Vespera/;

diff --git a/web/cgi-bin/horas/specials.pl b/web/cgi-bin/horas/specials.pl
@@ -138,12 +138,12 @@ sub specials {
       $skipflag = !preces($item);
       setcomment($label, 'Preces', $skipflag, $lang);
       setbuild1($item, $skipflag ? 'omit' : 'include');
-      push(@s, getpreces($hora, $lang, $item =~ /Dominicales/)) unless $skipflag;
+      push(@s, getpreces($hora, $item =~ /Dominicales/)) unless $skipflag;
       next;
     }
 
     if ($item =~ /invitatorium/i) {
-      invitatorium($lang);
+      push(@s, invitatorium($lang));
       next;
     }
 
@@ -189,7 +189,7 @@ sub specials {
     }
 
     if ($item =~ /Lectio brevis/i && $hora eq 'Prima') {
-      my ($b, $c) = lectio_brevis_prima($lang);
+      my ($b, $c) = lectio_brevis_prima();
       $label = '' if $label =~ /regula/i;
       setcomment($label, 'Source', $c, $lang);
 
@@ -201,7 +201,7 @@ sub specials {
         $regula =~ s/\.?\:\/\s*$/ $comment:\//;
         push(@s, $regula);
       }
-      push(@s, $b);
+      push(@s, @{$b});
       next;
     }
 
@@ -390,6 +390,39 @@ sub setcomment {
   push(@s, $label);
 }
 
+# final version return item for Linker
+sub setcomment2 {
+
+  my $label = shift;
+  my $comment = shift;
+  my $ind = shift;
+  my $prefix = shift;
+
+  if ($ind > -1) {
+    if ($comment =~ /Source/i && $votive && $votive !~ /hodie/i) { $ind = 7; }
+
+    [
+      "Psalterium/Common/Translate#$label;;Psalterium/Comment#Source" . ($prefix ? ";;Psalterium/Common/Translate#$prefix" : ''),
+      sub {
+        my($label, $comments, $prefix, $lang) = @_;
+
+        my @c = split(/\n/, $comments);
+        $comment = $c[$ind];
+        $comment = "$prefix $comment" if $prefix;
+
+        if ($label =~ /\}\s*/) {
+          $label =~ s/\}\s*$/ $comment}/;
+        } else {
+          $label .= " {$comment}";
+        }
+
+        $label
+      }
+    ]
+  } else {
+    []
+  }
+}
 #*** getproprium($name, $lang, $flag, $buidflag)
 # returns $name item from tempora or sancti file
 # if $flag and no item in the proprium checks commune
@@ -402,22 +435,19 @@ sub getproprium {
   my $buildflag = shift;
   my $w = '';
   my $c = 0;
-  my $prefix = 0;
-  my %w = columnsel($lang) ? %winner : %winner2;
+  my $s;  # file name where item was found
 
-  if (exists($w{$name})) {
-    $name = tryoldhymn(\%w, $name) if $name =~ /^Hymnus/;
-    $w = $w{$name};
-    $c = $winner =~ /Sancti/ ? 3 : 2;
-  }
+  our ($winner, %winner, $commune, %commune, $communetype);
 
-  if ($w) {
-    if ($buildflag) { setbuild($winner, $name, 'subst'); }
-    return ($w, $c);
+  if (exists($winner{$name})) {
+    $name = tryoldhymn(\%winner, $name) if $name =~ /^Hymnus/;
+    $w = $winner{$name};
+    $c = $winner =~ /Sancti/ ? 3 : 2;
+    $s = $winner;
+    setbuild($winner, $name, 'subst');
   }
 
   if (!$w && $communetype && ($communetype =~ /^ex/i || $flag)) {
-    my %com = columnsel($lang) ? %commune : %commune2;
     my $cn = $commune;
     my $substitute =
         $name eq 'Nocturn 1 Versum' ? 'Versum 1'
@@ -431,18 +461,18 @@ sub getproprium {
     while (!$w && $loopcounter < 5) {
       $loopcounter++;
 
-      if (exists($com{$name})) {
+      if (exists($commune{$name})) {
 
         # if element exists in referenced Commune, go for it
-        $name = tryoldhymn(\%com, $name) if $name =~ /^Hymnus/;
-        $w = $com{$name};
+        $name = tryoldhymn(\%commune, $name) if $name =~ /^Hymnus/;
+        $w = $commune{$name};
         $c = 4;
         last;
-      } elsif ($cn =~ /^C/i && $substitute && exists($com{$substitute})) {
+      } elsif ($cn =~ /^C/i && $substitute && exists($commune{$substitute})) {
 
         # for 1st Nocturn default to [Versum 1] for Commune files
         # for Versicle ad Nonam default to [Versum 2] for Commune files
-        $w = $com{$substitute};
+        $w = $commune{$substitute};
         $c = 4;
         $name .= " ex $substitute";
         last;
@@ -463,13 +493,15 @@ sub getproprium {
     }
 
     if ($w) {
+      $s = $cn;
       $w = replaceNdot($w, $lang);
-      my $n = $com{Name};
+      my $n = $commune{Name};
       $n =~ s/\n//g;
-      if ($buildflag) { setbuild($n, $name, 'subst'); }
+      setbuild($n, $name, 'subst');
     }
   }
-  return ($w, $c);
+
+  ($w, $c, "$s#$name");
 }
 
 #*** tryoldhymn(\%source, $name)

diff --git a/web/cgi-bin/horas/specials/capitulis.pl b/web/cgi-bin/horas/specials/capitulis.pl
@@ -49,31 +49,36 @@ sub monastic_major_responsory {
   # special case only 4 times
   $key .= ' 1' if ($winner =~ /(?:12-25|Quadp[123]-0)/ && $vespera == 1);
 
-  my ($resp, $c) = getproprium($key, $lang, $seasonalflag, 1);
+  my ($resp, $c, $src) = getproprium($key, $lang, $seasonalflag, 1);
 
   # Monastic Responsories at Major Hours are usually identical to Roman at Tertia and Sexta
   if (!$resp) {
     $key =~ s/Vespera/Breve Sexta/;
     $key =~ s/Laudes/Breve Tertia/;
-    ($resp, $c) = getproprium($key, $lang, $seasonalflag, 1);
+    ($resp, $c, $src) = getproprium($key, $lang, $seasonalflag, 1);
+    $src =~ s+M/+/+; # if so use Roman non Monastic source
   }
 
   # For backwards compatability, look for the legacy "R.br & Versicle" if necessary
   if (!$resp) {
     $key =~ s/Breve //;
-    ($resp, $c) = getproprium($key, $lang, $seasonalflag, 1);
+    ($resp, $c, $src) = getproprium($key, $lang, $seasonalflag, 1);
   }
 
-  # For backwards compatibility, remove any attached versicle
-  $resp =~ s/\n?_.*//s;
+  [ $src,
+    sub {
+      my($resp, $lang) = @_;
 
-  if ($resp) {
-    my @resp = split("\n", $resp);
-    postprocess_short_resp(@resp, $lang);
-    $resp = join("\n", @resp);
-  }
+      # For backwards compatibility, remove any attached versicle
+      $resp =~ s/\n?_.*//s;
 
-  $resp;
+      if ($resp) {
+        my @resp = split("\n", $resp);
+        postprocess_short_resp(@resp, $lang);
+        $resp = join("\n", @resp);
+      }
+    }
+  ];
 }
 
 sub capitulum_minor {

diff --git a/web/cgi-bin/horas/specials/preces.pl b/web/cgi-bin/horas/specials/preces.pl
@@ -72,7 +72,6 @@ sub preces {
 
 sub getpreces {
   my $hora = shift;
-  my $lang = shift;
   my $flag = shift;    # 1 for 'Dominicales'
 
   use v5.10;
@@ -97,8 +96,7 @@ sub getpreces {
     $key = 'feriales Prima';
   }
 
-  my %brevis = %{setupstring($lang, "Psalterium/Special/$src Special.txt")};
-  $brevis{"Preces $key"};
+  "\@Psalterium/Special/$src Special#Preces $key";
 }
 
 1;
diff --git a/web/cgi-bin/horas/specials/specprima.pl b/web/cgi-bin/horas/specials/specprima.pl
@@ -4,38 +4,33 @@
 
 sub lectio_brevis_prima {
 
-  my $lang = shift;
-
-  our ($version, %winner, %winner2, %commune, %commune2, $winner, $commune);
+  our ($version, $winner, $commune);
 
-  my %brevis = %{setupstring($lang, 'Psalterium/Special/Prima Special.txt')};
-  my $name = gettempora("Lectio brevis Prima");
-  my $brevis = $brevis{$name};
+  my $src = 'Psalterium/Special/Prima Special';
+  my $name = gettempora('Lectio brevis Prima');
   my $comment = $name =~ /per annum/i ? 5 : 1;
 
   setbuild('Psalterium/Special/Prima Special', $name, 'Lectio brevis ord');
 
   #look for [Lectio Prima]
   if ($version !~ /1955|196/) {
-    my $b;
-
     if (exists($winner{'Lectio Prima'})) {
-      $b = columnsel($lang) ? $winner{'Lectio Prima'} : $winner2{'Lectio Prima'};
-      setbuild2("Subst Lectio Prima $winner");
+      $src = $winner;
+      $name = 'Lectio Prima';
       $comment = 3;
+      setbuild2("Subst Lectio Prima $winner");
     } elsif (exists($commune{'Lectio Prima'})) {
-      $b = columnsel($lang) ? $commune{'Lectio Prima'} : $commune2{'Lectio Prima'};
-      setbuild2("Subst Lectio Prima $commune");
+      $src = $commune;
+      $name = 'Lectio Prima';
       $comment = 4;
+      setbuild2("Subst Lectio Prima $commune");
     }
-
-    $brevis = $b || $brevis;
   }
 
-  $brevis = prayer('benedictio Prima', $lang) . "\n$brevis" unless $version =~ /^Monastic/;
-  $brevis .= "\n\$Tu autem";
+  my @brevis = ("\@${src}#${name}", '$Tu autem');
+  unshift @brevis, '@Psalterium/Common/Prayers#benedictio Prima'  unless $version =~ /^Monastic/;
 
-  ($brevis, $comment);
+  (\@brevis, $comment);
 }
 
 sub capitulum_prima {