#!/usr/bin/perl -w

# 2011-05-24 - Script created by Rob Wolfram
# This module creates a MySword bible file from an unencrypted
# e-Sword 9.x bible file. Call this script with the .bblx file
# as the only argument.

use strict;
use DBI;
use DBD::SQLite;

my $interlinear=1;

my %bibnum = ( 1 => "Gen", 2 => "Exo", 3 => "Lev", 4 => "Num", 5 => "Deu", 6 => "Jos", 
    7 => "Jdg", 8 => "Rth", 9 => "1Sa", 10 => "2Sa", 11 => "1Ki", 12 => "2Ki", 
    13 => "1Ch", 14 => "2Ch", 15 => "Ezr", 16 => "Neh", 17 => "Est", 18 => "Job", 
    19 => "Psa", 20 => "Pro", 21 => "Ecc", 22 => "Son", 23 => "Isa", 24 => "Jer", 
    25 => "Lam", 26 => "Eze", 27 => "Dan", 28 => "Hos", 29 => "Joe", 30 => "Amo", 
    31 => "Oba", 32 => "Jon", 33 => "Mic", 34 => "Nah", 35 => "Hab", 36 => "Zep", 
    37 => "Hag", 38 => "Zec", 39 => "Mal", 40 => "Mat", 41 => "Mar", 42 => "Luk", 
    43 => "Joh", 44 => "Act", 45 => "Rom", 46 => "1Co", 47 => "2Co", 48 => "Gal", 
    49 => "Eph", 50 => "Phi", 51 => "Col", 52 => "1Th", 53 => "2Th", 54 => "1Ti", 
    55 => "2Ti", 56 => "Tit", 57 => "Phm", 58 => "Heb", 59 => "Jam", 60 => "1Pe", 
    61 => "2Pe", 62 => "1Jo", 63 => "2Jo", 64 => "3Jo", 65 => "Jud", 66 => "Rev" );

my $db=$ARGV[0];
die "Cannot read e-Sword module\n" if (not -r $db);

my $dbh=DBI->connect("dbi:SQLite:dbname=$db","","");

# Check if this is a bible module
# If not it will barf before exiting
my $sth=$dbh->prepare("select * from Bible limit 1");
die "Not a bblx file\n" if (not defined $sth);

$sth=$dbh->prepare("
    select * from Details
");

$sth->execute;
if ($sth->err) {
    $dbh->disconnect;
    die "Error parsing the module\n";
}
my $rowref=$sth->fetchrow_hashref('NAME_lc');
## A bblx file has a "Strong" bool
#die "Not a bblx file\n" if (not exists $rowref->{strong});

(my $newfile=$db) =~ s/(\.bblx)?$/\.bbl.mybible/;

open NEW, ">$newfile" or die "Could not create MySword file\n";
close NEW;

my $dbhw=DBI->connect("dbi:SQLite:dbname=$newfile","","");
my $sthw=$dbhw->prepare('
    CREATE TABLE "Bible" ("Book" INT,"Chapter" INT,"Verse" INT,"Scripture" TEXT);
');
$sthw->execute;
$sthw=$dbhw->prepare('
    CREATE TABLE "Details" ("Description" NVARCHAR(255),"Abbreviation" NVARCHAR(50),
        "Comments" TEXT,"Version" TEXT, "VersionDate" DATETIME, 
        "PublishDate" DATETIME, "RightToLeft" BOOL, "OT" BOOL, "NT" BOOL, "Strong" BOOL);
');
$sthw->execute;
$sthw=$dbhw->prepare('
    CREATE UNIQUE INDEX "bible_key" ON "Bible" ("Book" ASC, "Chapter" ASC, "Verse" ASC);
');
$sthw->execute;
# Mysword does not support apocryphal books yet
$sthw=$dbhw->prepare('
    insert into Details ("Description","Abbreviation","Comments","Version",
    "VersionDate","RightToLeft","OT","NT","Strong") values (?,?,?,?,?,?,?,?,?)
');
my $description="Nestle-Aland 26th/27th edition text with diacritics &amp; punctuation";
my $abbreviation="NA26";
my $comments="<strong>Nestle-Aland 26th/27th edition Greek New Testament</strong><br/><br/>\n";
$comments.="<strong>This Version Dated:</strong> 12/05/2003<br/><br/>\n";
$comments.="<DL>\n";
$comments.="<DT><strong>Latest Versions</strong>\n";
$comments.="<DD>Latest module will be available at <a href=\"http://www.pensivesheep.com/esword\">".
    "http://www.pensivesheep.com/esword</a><br/>\n";
$comments.="<DT><strong>Source Material</strong>\n";
$comments.="<DD>The source of the text is a Center for Computer Analysis of Texts (CCAT) database. The file I used can be found at ".
    "<a href=\"http://users.mstar2.net/broman/editions.html\">http://users.mstar2.net/broman/editions.html</a>, ".
    "from the line-per-word plaintext database corrected and amplified by James Tauber.<br/>\n";
$comments.="<DT><strong>About the Text</strong>\n";
$comments.="<DD>This BBL module contains the text with diacritcal marks and punctuation, but <strong>not</strong> ".
    "the critical apparatus. You may want to use this in conjunction with the GNT-V for basic textual criticism, ".
    "but I recommend you buy a hardcopy of the UBS4.<br/><br/>".
    "The Nestle-Aland text and the United Bible Society text were standardized. The NA26/27 &amp; ".
    "UBS4 use the same text with variations only in punctuation, such as how indirect discourse with ".
    "&#8005;&#964;&#953; is rendered. For more information on such differences, see the Preface to the UBS 4th Edition.<br/>\n";
$comments.="<DT><strong>Password Protection</strong>\n";
$comments.="<DD>Because this text is provided based on the work of others, this BBL module is password protected in keeping ".
    "with the requirement to control access to the supplied materials. The module is also password protected for the purpose ".
    "of quality control. Please feel free to contact me on any mistakes you may find.<br/>\n";
$comments.="<DT><strong>Modifications to the Text</strong>\n";
$comments.="<DD>I have not modified the text <strong>except</strong> in the way that \{ and \} are rendered in the text.<br>".
    "Because \{ and \} are used in RichText Format, I have either changed them to &quot;-&quot; or &quot;,&quot; or removed them or, ".
    "in a few cases, &quot;\(&quot; and &quot;\)&quot;.<br/>".
    "For text surrounded by a single bracket \[ \], I have rendered the text as <font color=\"gray\"><i>50% grey ".
    "and italics</i></font>.<br/>".
    "For text surrounded by double brackets \[\[ \]\], I have rendered the text as <font color=\"purple\">purple".
    "</font> (but not italics).<br/>\n";
$comments.="<DT><strong>User Agreement</strong>\n";
$comments.="<DL>\n";
$comments.="<DT>From the CCAT User Agreement:\n";
$comments.="<DD>With regard to the texts and software it distributes, CCAT has made all reasonable efforts to insure that ".
    "appropriate consent and permission has been obtained from copyright holders of published texts converted into ".
    "machine-readable form as well as from producers of the electronic form, and thus that fair and permitted use ".
    "of such materials does not constitute an infringement on copyright. Pertinent information is included in the ".
    "documentation supplied with the electronic materials.<br/><br/>".
    "In accepting the machine-readable materials and/or programs listed below, as distributed by CCAT, the recipient agrees ".
    "&quot;fair use&quot; provisions:\n";
$comments.="<OL>\n";
$comments.="<LI>Not to use or make available these materials for commercial purposes without first obtaining the written ".
    "consent of the owners/encoders;\n";
$comments.="<LI>To observe any special restrictions that may govern the use of particular texts or bodies of material as ".
    "stipulated in the aforementioned documentation;\n";
$comments.="<LI>To control access to the supplied materials and require any other party to whom the recipient supplies any portion ".
    "of this material to observe these conditions and to register a signed USER DECLARATION form with CCAT;\n";
$comments.="<LI>When making formal public reference to the materials, to acknowledge appropriately the holder of the copyright ".
    "to any published text that has been encoded as well as the encoder and the source from which the machine-readable ".
    "form has been obtained, to the extent that these details are supplied in the aforementioned documentation (unless ".
    "otherwise noted, CCAT is the legal owner of the software and documentation being distributed);\n";
$comments.="<LI>To report promptly to CCAT any errors discovered in these machine-readable materials or problems with the software.\n";
$comments.="</OL>\n";
$comments.="</DL>\n";
$comments.="</DL><br/><br/>\n";
$comments.="<strong>Comments on the MySword version</strong><br/>\n";
$comments.="The previous text is left as-is from the original module text. This module has been converted ".
    "from an e-Sword module, retrieved from <a ".
    "href=\"http://www.biblesupport.com/e-sword-downloads/file/2654-greek-nestle-aland-26th-27th-edition-text-with-diacritics-punctuationbblxexe/".
    "\">BibleSupport.com</a> which was not password protected. Also, the mentioned URLs no longer work.<br/><br/>".
    "The original file had two endings for Mark starting at verse 16:9, a short (one verse) version and a long (twelve ".
    "verse) version. Since MySword does not allow multiple database records with the same book/chapter/verse tuple, ".
    "the short version has been omitted in the MySword module.\n";
$sthw->execute($description,$abbreviation,
    $comments,"1.0","2011-05-01 00:00:00",0,
    0,1,0);
die "Error inserting Details\n" if ($sthw->err);

$sth=$dbh->prepare('
    select Book,Chapter,Verse,Scripture from Bible
    order by Book,Chapter,Verse;
');
$sth->execute;
$rowref=$sth->fetchall_arrayref;
my ($bk,$cp)=(0,0);

$sthw=$dbhw->prepare('
    insert into Bible (Book,Chapter,Verse,Scripture)
    values (?,?,?,?)
');

foreach my $ref2 (@$rowref) {
    if ($bk != $ref2->[0]) {
        $bk=$ref2->[0];
        my $nm=exists($bibnum{$bk})?$bibnum{$bk}:"UNK";
        print STDERR "\n$nm";
        $cp=0;
    }
    if ($cp != $ref2->[1]) {
        $cp=$ref2->[1];
        print STDERR " $cp";
    }
    my $scripture=&unrtf($bk,$cp,$ref2->[2],$ref2->[3]);
    next if ($scripture =~ /^\s*$/);
    $sthw->execute($ref2->[0],$ref2->[1],$ref2->[2],$scripture);
    die "Error inserting $ref2->[0]/$ref2->[1]/$ref2->[3]\n" if ($sthw->err);
}
print STDERR "\nFinished $newfile\n";
exit 0;

sub unrtf() {
    # Deep recursions may occur
    no warnings 'recursion';
    # Depends on booknumer in case a strong number misses H or G
    # or on b/c/v if a reference does not contain it
    my ($bk,$cp,$vs,$text)=@_;
    return "" if (not defined $text or $text eq "");
    # Skip "short" version of Mk 16:9
    return "" if ($text =~ /\s*\{\\CF6 \[The shorter ending of Mark\] \}.*/i);
    # Skip ending text in Mk 16:9
    if ($text =~ /\s*\{\\CF6 \[The longer ending of Mark\] \}(.*)/) {
        return &unrtf($bk,$cp,$vs,$1);
    }
    # Skip Greek denominator
    elsif ($text =~ /\s*\{\\f1 (.*)\}\s*$/i) {
        return &unrtf($bk,$cp,$vs,$1);
    }
    elsif ($text =~ /(.*?)\{\\cf15\\i(.*?)\}(.*)/i) {
        my ($head,$midd,$tail)=($1,$2,$3);
        return &unrtf($bk,$cp,$vs,$head."<font color=\"grey\"><i>".$midd."</i></font>".$tail);
    }
    elsif ($text =~ /(.*?)\{\\cf12(.*?)\}(.*)/i) {
        my ($head,$midd,$tail)=($1,$2,$3);
        return &unrtf($bk,$cp,$vs,$head."<font color=\"purple\">".$midd."</font>".$tail);
    }
    # Windows-1253 character
    elsif ($text =~ /(.*?)\\'([[:xdigit:]]+)(.*)/) {
        my ($head,$hex,$tail)=($1,$2,$3);
        return &unrtf($bk,$cp,$vs,$head)."&#".(720+hex("0x$hex")).";".
            &unrtf($bk,$cp,$vs,$tail);
    }
    # UTF character
    elsif ($text =~ /(.*?)\\u(\d+)\??(.*)/i) {
        my ($head,$utf,$tail)=($1,$2,$3);
        return &unrtf($bk,$cp,$vs,$head)."&#${utf};".
            &unrtf($bk,$cp,$vs,$tail);
    }
    else {
        return $text;
    }
}
