#
# Copyright (c) 2011-2013, 2018, 2025 LAAS/CNRS
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software for any purpose
# with or without   fee is hereby granted, provided   that the above  copyright
# notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
# REGARD TO THIS  SOFTWARE INCLUDING ALL  IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS. IN NO EVENT SHALL THE AUTHOR  BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR  ANY DAMAGES WHATSOEVER RESULTING  FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION,   ARISING OUT OF OR IN    CONNECTION WITH THE USE   OR
# PERFORMANCE OF THIS SOFTWARE.
#
#                                            Anthony Mallet on Sun Jul 24 2011
#


# --- db2html --------------------------------------------------------------
#
proc db2html { db title dest } {
  global tcldir

  set db [opendb $db]

  # clean
  foreach d [glob -no -dir $dest/. -types d *] {
    file delete -force $d
  }
  file delete $dest/table.js
  file delete $dest/sortable.gif
  file delete $dest/sorted_up.gif
  file delete $dest/sorted_down.gif
  gensubst html/rbulk.css $dest/rbulk.css
  file copy -force $tcldir/html/table.js $dest/.
  file copy -force $tcldir/html/sortable.gif $dest/.
  file copy -force $tcldir/html/sorted_up.gif $dest/.
  file copy -force $tcldir/html/sorted_down.gif $dest/.

  # session logs
  set sessions [list]
  $db eval {
    select tag, log, date, updates, running,
    count(distinct pkgname) as total,
    count(na) as na,
    count(broken) as broken,
    count((select 1 from breaks where breaks.breaks = pkg.id)) as brokenby
    from session natural join pkg natural join meta
    group by tag order by tag
  } {
    set item {<tr>}
    append item {<td>} $tag {</td>}
    append item {<td class=num>}
    append item "[expr {$total - $broken - $na}] "
    append item {</td>}
    append item {<td class=num>} $na {</td>}
    append item {<td class=num>}
    append item [expr {$broken - $brokenby}] " ($brokenby)" {</td>}
    append item {<td class=num>} $total {</td>}
    append item {<td class=num>}
    append item [clock format $date -format {%Y/%m/%e}]
    append item {</td>}
    append item {<td class=num>}
    append item [clock format $date -format {%H:%M:%S}]
    append item {</td>}
    if {!$updates} { set updates - }
    append item {<td class=num>} $updates {</td>}
    if {$running} {
      append item {<td class=running>Running</td>}
    } else {
      append item {<td class=idle>Idle</td>}
    }
    if {$log == ""} {
      append item "<td class=status>-</td>"
    } else {
      append item "<td class=status><a href=\"$tag.html\">View</a></td>"
      set logfile $tag
      set root .
      set back "index.html"
      set log [string map {< &lt; > &gt;} $log]
      gensubst html/log.html $dest/$tag.html
    }
    append item {</tr>}
    lappend sessions $item
  }
  set sessions [join $sessions "\n"]

  # summary by category
  set bycategory [list]
  set last {}
  $db eval {
    select category, tag,
    count(pkgbase) as total,
    count(na) as na,
    count(broken) as broken,
    count((select 1 from breaks where breaks.breaks = pkg.id)) as brokenby
    from pkg natural join meta natural join category
    group by category, tag order by category, tag
  } {
    if {$last != $category} {
      set item {<tr><th colspan=6>}
      append item "<a href=$category/index.html>$category</a>"
      append item {</th></tr>}
      lappend bycategory $item
      set last $category
    }
    set item {<tr><td></td>}
    append item {<td>} $tag {</td>}
    append item {<td class=num>} [expr {$total - $broken - $na}] {</td>}
    append item {<td class=num>} $na {</td>}
    append item {<td class=num>}
    append item [expr {$broken - $brokenby}] " ($brokenby)" {</td>}
    append item {<td class=num>} $total {</td>}
    append item {</tr>}
    lappend bycategory $item
  }
  set bycategory [join $bycategory "\n"]
  gensubst html/categories.html $dest/categories.html


  # all tags as a table header and sql filter
  set tags [lsort [$db eval { select distinct tag from pkg }]]

  set tagsheader {}
  foreach t $tags { append tagsheader "<th>[split $t -]</th>" }

  set sqltags [list]
  foreach t $tags {
    foreach key {na date_start date_stop broken warning sysdep} {
      lappend sqltags [subst {
        max(case when tag = '$t' then meta.$key end) as '$t.$key'
      }]
    }
  }
  if {[llength $sqltags]} {
    set sqltags [join $sqltags ,],
  }

  set sqlpkgs [subst {
    path, pkgbase, pkgname, $sqltags
    group_concat(distinct category) as categories
    from pkg natural join category natural join meta
    natural left outer join breaks
  }]

  # top ten broken
  set topten [list]
  $db eval [subst {
    select
    count(breaks) as breaks, count(broken) as broken, count(warning) as warning,
    group_concat(distinct
                 (select pkgname ||' ('||tag||')' from pkg where id = breaks))
    as blist,
    $sqlpkgs
    where exists (select 1 from pkg as p natural join meta as m
                  where p.pkgname = pkg.pkgname and
                  (m.broken is not null or m.warning is not null))
    group by pkgname
    order by breaks desc, broken desc, warning desc, pkgname limit 10
  }] v {
    lappend topten [sqlpkgstatus2html $db . $tags [array get v]]
  }
  set topten [join $topten "\n"]

  gensubst html/index.html $dest/index.html

  # broken
  set broken [list]
  $db eval [subst {
    select
    count(breaks) as breaks, count(broken) as broken, count(warning) as warning,
    group_concat(distinct
                 (select pkgname ||' ('||tag||')' from pkg where id = breaks))
    as blist,
    $sqlpkgs
    where exists (select 1 from pkg as p natural join meta as m
                  where p.pkgname = pkg.pkgname and
                  (m.broken is not null or m.warning is not null))
    group by pkgname order by date_start desc, pkgname
  }] v {
    lappend broken [sqlpkgstatus2html $db . $tags [array get v]]
  }
  set broken [join $broken "\n"]
  gensubst html/broken.html $dest/broken.html

  # not available
  set notavail [list]
  $db eval [subst {
    select
    count(breaks) as breaks, count(broken) as broken, count(warning) as warning,
    group_concat(distinct
                 (select pkgname ||' ('||tag||')' from pkg where id = breaks))
    as blist,
    $sqlpkgs
    where exists (select 1 from pkg as p natural join meta as m
                  where p.pkgname = pkg.pkgname and
                  m.na is not null)
    group by pkgname order by date_start desc, pkgname
  }] v {
    lappend notavail [sqlpkgstatus2html $db . $tags [array get v]]
  }
  set notavail [join $notavail "\n"]
  gensubst html/notavail.html $dest/notavail.html

  # all
  set all [list]
  $db eval [subst {
    select
    count(breaks) as breaks, count(broken) as broken, count(warning) as warning,
    group_concat(distinct
                 (select pkgname ||' ('||tag||')' from pkg where id = breaks))
    as blist,
    $sqlpkgs
    group by pkgname order by pkgname
  }] v {
    lappend all [sqlpkgstatus2html $db . $tags [array get v]]
  }
  set all [join $all "\n"]
  gensubst html/all.html $dest/all.html

  # status by category
  catch {unset allcategory}
  $db eval [subst {
    select
    count(breaks) as breaks, count(broken) as broken, count(warning) as warning,
    group_concat(distinct
                 (select pkgname ||' ('||tag||')' from pkg where id = breaks))
    as blist,
    $sqlpkgs
    group by pkgname order by pkgname
  }] v {
    set item [sqlpkgstatus2html $db .. $tags [array get v]]
    foreach c [split $v(categories) ,] {
      lappend allcategory($c) $item
    }
  }
  foreach category [array names allcategory] {
    set bycategory [join $allcategory($category) "\n"]
    gensubst html/category.html $dest/$category/index.html
  }

  # per-package logs
  $db eval [subst {select distinct path from meta}] bypkg {
    gensubst html/pkg-pre.html $dest/$bypkg(path)/index.html
  }

  $db eval [subst {
    select
    group_concat(distinct file) as flogs, $sqlpkgs
    left outer join log using (id)
    group by pkgname
  }] bypkg {
    set bypkg(flogs) [lsort [split $bypkg(flogs) ,]]
    set flogsheader {}
    foreach l $bypkg(flogs) { append flogsheader "<th>[file rootname $l]</th>" }
    set c [list]
    foreach category [lsort [split $bypkg(categories) ,]] {
      lappend c "<a href=../../$category/index.html>$category</a>"
    }
    set bypkg(categories) [join $c {, }]

    set pkgsummary [sqlpkg2html $db $dest $tags [array get bypkg]]
    gensubst html/pkg.html $dest/$bypkg(path)/index.html yes
  }

  $db eval [subst {select distinct path from meta}] bypkg {
    gensubst html/pkg-post.html $dest/$bypkg(path)/index.html yes
  }

  # no need to analyze/vaccum
  closedb $db off
}


# --- sqlpkgstatus2html ---------------------------------------------------
#
proc sqlpkgstatus2html { db root tags sqlres } {
  set dformat {%Y/%m/%e}
  set tformat {%H:%M:%S}
  array set v $sqlres

  set pkgref [subst {
    t { return "<a title=$v(pkgname) href=$root/$v(path)/index.html#$v(pkgname)>\$t</a>" }
  }]

  set item {<tr>}
  append item {<td class=cat>}
  set l [list]
  foreach category [lsort [split $v(categories) ,]] {
    lappend l "<a href=$root/$category/index.html>$category</a>"
  }
  append item [join $l]
  append item {</td>}
  append item {<td class=pkg>} [apply $pkgref $v(pkgname)] {</td>}
  set date +inf
  foreach tag $tags {
    if {[string is integer -strict $v($tag.date_start)]} {
      if {$v($tag.date_start) < $date} {
        set date $v($tag.date_start)
        set date.tag $tag
      }
    }
  }
  if {$date != +inf} {
    append item {<td class="num" title="} ${date.tag} {">}
    append item [clock format $date -format $dformat]
    append item {</td>}
  } else {
    append item {<td class="num">-</td>}
  }

  set time 0
  foreach tag $tags {
    if {[string is integer -strict $v($tag.date_start)] &&
        [string is integer -strict $v($tag.date_stop)]} {
      set d [expr {$v($tag.date_stop) - $v($tag.date_start)}]
      if {$d > $time} {
        set time $d
        set time.tag $tag
      }
    }
  }
  if {$time != 0} {
    append item {<td class="num" title="} ${time.tag} {">}
    append item [clock format $time -gmt on -format $tformat]
    append item {</td>}
  } else {
    append item {<td class="num">-</td>}
  }

  append item {<td class=num title="} [join [split $v(blist) ,] {&#10;}] {">}
  append item $v(breaks)
  append item {</td>}

  foreach tag $tags {
    if {[string is integer -strict $v($tag.sysdep)]} {
      append item {<td class="status ssysdep">} [apply $pkgref Sysdep] {</td>}
    } elseif {[string is integer -strict $v($tag.broken)]} {
      append item {<td class="status sbroken">} [apply $pkgref Broken] {</td>}
    } elseif {[string is integer -strict $v($tag.warning)]} {
      append item {<td class="status swarn">} [apply $pkgref Warnings] {</td>}
    } elseif {[string is integer -strict $v($tag.na)]} {
      append item {<td class="status sna">} [apply $pkgref N/A] {</td>}
    } elseif {[string is integer -strict $v($tag.date_start)]} {
      append item {<td class="status sok">OK</td>}
    } else {
      append item {<td class="status sunk">?</td>}
    }
  }
  append item {</tr>}
  return $item
}


# --- sqlpkg2html ----------------------------------------------------------
#
proc sqlpkg2html { db dest tags sqlres } {
  set dformat {%Y/%m/%e}
  set tformat {%H:%M:%S}
  array set v $sqlres

  set item {}
  foreach tag $tags {
    append item {<tr>}

    append item {<td>} $tag {</td>}

    if {[string is integer -strict $v($tag.sysdep)]} {
      append item {<td class="status ssysdep">Sysdep</td>}
    } elseif {[string is integer -strict $v($tag.broken)]} {
      append item {<td class="status sbroken">Broken</td>}
    } elseif {[string is integer -strict $v($tag.warning)]} {
      append item {<td class="status swarn">Warnings</td>}
    } elseif {[string is integer -strict $v($tag.na)]} {
      append item {<td class="status sna">N/A</td>}
    } elseif {[string is integer -strict $v($tag.date_start)]} {
      append item {<td class="status sok">OK</td>}
    } else {
      append item {<td class="status sunk">?</td>}
    }

    if {[string is integer -strict $v($tag.date_start)]} {
      append item {<td class="num">}
      append item [clock format $v($tag.date_start) -format $dformat]
      append item {</td>}
    } else {
      append item {<td class="num">-</td>}
    }

    if {[string is integer -strict $v($tag.date_start)]} {
      append item {<td class="num">}
      append item [clock format $v($tag.date_start) -format $tformat]
      append item {</td>}
    } else {
      append item {<td class="num">-</td>}
    }
    if {[string is integer -strict $v($tag.date_start)] &&
        [string is integer -strict $v($tag.date_stop)]} {
      set d [expr {$v($tag.date_stop) - $v($tag.date_start)}]
      append item {<td class="num">}
      append item [clock format $d -gmt on -format $tformat]
      append item {</td>}
    } else {
      append item {<td class="num">-</td>}
    }

    foreach f $v(flogs) {
      append item {<td class=status>}
      $db eval {
        select data as log from pkg natural join meta natural join log
        where pkgname = $v(pkgname) and tag = $tag and file = $f
      } {
        set log [string map {< &lt; > &gt;} $log]
        switch -glob $f {
          {broken.log} {
            append item "<div class=inlog>$log</div>"
          }
          {*by.log} {
            append item {<div class=inlog>}
            set l [list]
            foreach b [lsort -unique [split $log "\n"]] {
              if {$b == ""} continue
              set h "<span class=ssysdep>$b</span>"
              $db eval {
                select path,pkgname from pkg natural join meta
                where pkgname = $b and tag = $tag
              } {
                set h "<a href=\"../../$path/index.html#$pkgname\">$b</a>"
              }
              lappend l $h
            }
            append item [join $l {<br>}]
            append item {</div>}
          }
          default {
            append item \
                "<a href=\"$v(pkgname)/$tag/[file rootname $f].html\">View</a>"
            set logfile "$v(pkgname) on $tag: $f"
            set root ../../../..
            set back "../../index.html#$v(pkgname)"
            set title "robotpkg/$v(path)"
            gensubst html/log.html \
                $dest/$v(path)/$v(pkgname)/$tag/[file rootname $f].html
          }
        }
      }
      append item {</td>}
    }

    append item {</tr>}
  }
  return $item
}


# --- gensubst -------------------------------------------------------------
#
proc gensubst { src dst {append no}} {
  global tcldir

  set f [open $tcldir/$src]; set h [read $f]; close $f
  set h [uplevel subst "{$h}"]

  file mkdir [file dirname $dst]
  set f [open $dst [expr {$append?"a":"w"}]]; puts $f $h; close $f
}
package provide rbulk-report 20260610
