(:~
: <h1>CPAN-like app for search Perl POD.<h1>
: This version runs on xhtml from pod2html
: 
: <b>TODO</b>
: <ul>
: <li>Order name search results by left-most occurence</li>
: <li>Confirm XQDoc syntax</li>
: <li>Related articles</li>
: <li>Related books</li>
: <li></li>
: </ul>
:
: <b>Features</b>
: <ul>
: <li>Search by NAME POD section</li>
: <li>Smarter search ordering, alphabetical</li>
: <li>Link sub names on sub search</li>
: <li>Include current methods in module header</li>
: <li>Breadcrumb Package Name</li>
: <li>Related deli.cio.us tags</li>
: <li></li>
: @author Tony Stubblebine
: @version 0.1
:)

(: ******************************************************* :)
(: * SEARCH ACTIONS                                        :)
(: ******************************************************* :)

(:~
: Search and list modules based on the NAME section
: @param $term search term
: @return xhtml module listing
:)
define function name_search( $term as xs:string ) as element()
{
  for $i in input()
  where cts:contains($i/html//package, $term)
  order by ($i//package)[1]
    return
        module_listing($i, $term)
}

define function module_listing( $i as node(), $term as xs:string)
as element()
{
      let $package := $i//package 
      let $suffix  := substring-after(text {
($i/html//h1[cts:contains(./a, "NAME")]/following-sibling::p)[1]}, " ")
        return
          <p>
            <a href="?package={text {$package}}">{text {$package}}</a>
            {text {$suffix}}
          </p>
}

define function starts_with_search( $term as xs:string ) as element()
{
    for  $i in input()
    let $package := ($i//package)[1]
    where starts-with($package, concat($term, "::"))
          or $package = $term
          and not( contains(substring-after($package, concat($term, "::")), "::") )
    order by $package
        return module_listing($i, $term)
}


(:~
: Search and list modules based on definied subroutines. Inherited subroutines
: aren't included in the search.
: @params $term search term
: @return xhtml module listing
:)
define function subroutine_search( $term as xs:string ) as element()
{
  (: List all matching subroutines :)
  for $sub in input()/html//sub[cts:contains(., $term)]
  let $package := $sub/ancestor::html/head/package
  let $anchor  := lookup_sub_anchor($package, $sub)
  order by $package
  return 
    <p>
      <a href="?package={ text {$package} }">{ 
           text { $sub/ancestor::html/head/package } }</a> 
      - {
          if (string-length($anchor) > 1) then <a href="?package={ text {$package} }#{$anchor}">{ text {$sub} }</a>
          else <foo>{ text {$sub} }</foo>
        }()
    </p>
}

(: ******************************************************* :)
(: * DISPLAY COMPONENTS                                    :)
(: ******************************************************* :)

(:~
: Show a single package.
: @params $package
: @return xhtml
:)
define function show_package ($package as xs:string) as element()
{
    (: TODO: pick the most relevant :)
    for $p in (input()/html[@id = $package])[1]
        return $p
}

(:~
: Display a search form
: @return xhtml
:)
define function search_form () as element()
{
let $type := xdmp:get-request-field('type', 'name')
let $term := xdmp:get-request-field('term', '')
return
<form method='GET'>
<div align="center">
{
  if ($type = 'name') then "name"
  else <a href="?type=name&term={text{$term}}">NAME</a>
}
|
{
  if ($type = 'sub') then "subroutine"
  else <a href="?type=sub&term={text{$term}}">subroutine</a>
}
</div>

<input type='text' name='term' value='{text{$term}}' size='55'/>
<input type='submit' value='search'/>
</form>

}


(:~
: Create the HTML for the header of a module. Includes parent classes and
: modules.
: TODO: get rid of $x param.
: @params $x insertion point in the document. 
: @params $orig original document
:)
define function module_header ($x as element()?, $orig as node()) as element()
{
    if (exists($orig/html/head//package)) then 
        <div>
        <hr />
        {
          if (exists($orig//parent)) then
              <p> <h1>Method Summary</h1>
              {
                  method_list($orig/html/head//package)
              }
              {
                  base_list($orig/html/head//package)
              }
              </p>
          else ""
         }
         </div>
    else ""
}

(:~
: Display all the packages in the inheritance tree and all of the methods in
: those packages.
: TODO: Weed out overridden methods.
: @params $package starting package name.
: @return xhtml section.
:)
define function base_list ($package as xs:string) as element()
{
    for $p in input()/html[@id = $package]//parent
        where string-length($p) > 1
              and $p != $package
        return method_list($p),
    for $p in input()/html[@id = $package]//parent
        where string-length($p) > 1
              and $p != $package
        return base_list($p)
}

(:~
: Display a package and its methods.
: @params $package package name
: @return xhtml package/method section
:)
define function method_list ($package as xs:string) as element()
{
    <p>
        <h2><a href="?package={text {$package}}">{text {$package}}</a>:</h2>
        {subs_list(text {$package})}
    </p>
}

(:~
: List all public subroutines in a package with links to documentation if
: possible.
: @params $package name
: @return xhtml section
:)
define function subs_list ($package as xs:string)
{
   for $sub in input()/html[@id = $package]//sub
   where not (starts-with($sub, "_"))
   order by $sub
   return 
     let $anchor := lookup_sub_anchor($package, $sub) return
     if (string-length($anchor) > 1) then
     <i><a href="?package={text {$package}}#{text {$anchor}}">{text {$sub}}</a>()&nbsp; &nbsp;</i>
     else <i>{text {$sub}}()&nbsp; &nbsp;</i> 
}


(: ******************************************************* :)
(: * LOOKUP FUNCTIONS                                      :)
(: ******************************************************* :)


(:~
: Find the anchor tag name for a subroutine in a package.
: @params $package package name
: @params $sub_name subroutine name
: @return text anchor name
:)
define function lookup_sub_anchor ($package as xs:string, $sub_name as xs:string)
as xs:string 
{
    (: 
    TODO - replace contains with starts with sub_name or starts with
    item_subname 
    :)
    if (string-length((input()/html[@id = $package]//a[cts:contains(@name, $sub_name)])[1]) > 1)
    then
        (input()/html[@id = $package]//a[cts:contains(@name, $sub_name)]
        )[1]/@name cast as xs:string
    else "" 
}

(: ******************************************************* :)
(: * DISPATCH FUNCTIONS                                    :) 
(: ******************************************************* :)


(:~
: Process an A tag and passthru the contents
: @params $x current node (an A element)
: @params $orig current document
: @return xhtml
:)
define function pass_a ($x as node(), $orig as node()) as element()*
{
  if ( matches($x/@href, "^http") ) then
    <a>{$x/@*}{passthru($x, $orig)}</a>
  else if ( matches($x/@href, "^\w[\w\d:]+")) then 
    <a href="?package={text {$x/@href}}">{passthru($x, $orig)}</a>
  else 
    <a>{$x/@*}{passthru($x, $orig)}</a>
}


(:~
: Recursively process stored HTML for display. 
: @params $x current element
: @params $orig original document
: @returns xhtml
:)
define function passthru ($x as element()?, $orig as node()) as element()
{
  for $z in $x/node() return dispatch($z, $orig)
}


define function package_breadcrumb ($name as xs:string, $prefix as xs:string) 
as element()
{
    if (contains($name, "::")) then
        let $head := substring-before($name, "::")
        let $tail := substring-after($name, "::")
        let $new_pref := if (string-length($prefix) > 0) then 
                             concat($prefix, "::", $head)
                         else $head
        return
        <span><a href="?term={$new_pref}&type=starts-with">{$head}</a>::{package_breadcrumb($tail, $new_pref)}</span>
    else 
        let $base := if (string-length($prefix) > 0) then
                        concat($prefix, "::", $name)
                     else $name
        return
    <span><a href="?term={$base}&type=starts-with">{$name}</a></span>

}


define function pass_ul ($x as element()?, $orig as node()) as element()
{
    if ($x = ($orig//ul)[1]) then 
        <span> 
        <h1>{ package_breadcrumb($orig/html/head//package, "") }</h1>
        <ul>{passthru($x, $orig)}</ul> {module_header($x, $orig)} </span>
    else passthru($x, $orig)
}

(:~
: Dispatch individual elements for custom processing.
: @params $x current element
: @params $orig original document
: @returns xhtml
:)
define function dispatch ($x as node(), $orig as node()) as element()*
{
  if (empty($x)) then "" else
  typeswitch($x)
  case text() return text {$x} 
  case element (head) return ""
  case element (body) return passthru($x, $orig) (: module_header($x, $orig) :)
  case element (p) return <p>{passthru($x, $orig)}</p>
  case element (ul) return pass_ul($x, $orig) (: <ul>{passthru($x, $orig)}</ul>:)
  case element (li) return <li>{passthru($x, $orig)}</li>
  case element (hr) return <hr />
  case element (pre) return <pre>{passthru($x, $orig)}</pre>
  case element (h1) return <h1>{passthru($x, $orig)}</h1>
  case element (h2) return <h2>{passthru($x, $orig)}</h2>
  case element (h3) return <h3>{passthru($x, $orig)}</h3>
  case element (h4) return <h4>{passthru($x, $orig)}</h4>
  case element (b) return <b>{passthru($x, $orig)}</b>
  case element (i) return <i>{passthru($x, $orig)}</i>
  case element (strong) return <strong>{passthru($x, $orig)}</strong>
  case element (code) return <code>{passthru($x, $orig)}</code>
  case element (dt) return <dt>{passthru($x, $orig)}</dt>
  case element (dd) return <dd>{passthru($x, $orig)}</dd>
  case element (br) return <br />
  case element (a) return pass_a($x, $orig)
  case element (emphasis) return <b> {passthru($x, $orig)} </b>
  case element (package) return ""
  case element (subroutines) return ""
  case element (sub) return ""
  case element (source_file) return ""
  case element (parent) return ""
  default return passthru($x, $orig) 

}

define function process_request () as element()
{

    let $term := xdmp:get-request-field('term', '')
    let $type := xdmp:get-request-field('type', 'name')
    let $package := xdmp:get-request-field('package', '')
    return 
        <root>
        {
            if ($package) then show_package($package)
            else if ($type = "sub") then subroutine_search($term)
            else if ($type = "starts-with") then starts_with_search($term)
            else if (string-length($term) > 0) then name_search($term) 
            else get_intro()
        }
        </root>
}
define function get_intro() as element()
{
<div>
<h2>What is this?</h2>
<p>This is a prototype CPAN search built with XQuery on a MarkLogic XML repository. The XML is actually XHTML generated by running pod2html on all the modules that are installed on my server. That XML is decorated by grepping subroutine and parent classes out of the module. <a href="http://www.stubbleblog.com/cpan/podsearch.xqy.txt">The code.</a></p>

<h2>New Features</h2>
<ol>
<li>Method signature and inheritance structure - what methods are available to call on the module, what module the method is defined in (often a parent class), links to the method documented (if available).</li>
<li>Package breadcrumb - browse up the namespace by clicking on the package name</li>
<li>Related links - just dumb package name to deli.cio.us tag mapping right now</li>
<li>Alphabetical Search Results - it's not contextual but it's predictable.</li>
<li>Subroutine Search - Know the subroutine name but can't remember the module? This is for you.</li>
</ol>

<h2>In the Works</h2>
<ol>
<li>Related Books - list any books that mention the module that you're looking at.</li>
<li>All of CPAN - put all CPAN pod into the DB. This would be a good time to add download links.</li>
<li>Related Articles - list articles that mention the module you're looking at.</li>
<li>Different results order - thinking about ordering search results by left-most appearance in segments of a NAME block (segments being the pieces of the package name and the description that usually follows).</li>
<li>Used By - Count the number of modules that use the current module. A measure of popularity.</li>
<li>Polish - Cleaner HTML. A lot of PRE tags could be combined. Repeated method names in the method signature. Little things.</li>
<li>Versions - POD for each version</li>
</ol>
</div>
}

define function display_page( $body as node(), $sidebar as node() ) as element()
{
<html>
<head>
<title>POD Search</title>
<link rel="stylesheet" href="http://www.stubbleblog.com/cpan.css" type="text/css" />
</head>
<body>
<table border="0">
<tr>
<td width="70%" valign="top">
<div align="center">
<h1>POD Search</h1>
{ search_form() }
</div>
{ $body }
</td>
<td width="30%" valign="top">
{ $sidebar }
</td>
</tr>
</table>
</body>
</html>
}

define function delicious_box ($tag as xs:string) as element()
{
    let $url := input()/delicious[tag = lower-case($tag)]//url[@type = "tag"]
    return
    <p>
    <h2><a href="{text {$url}}">{text {$url}}</a></h2>
    {
    for $i in (input()/delicious[tag = lower-case($tag)]//item)[1 to 5]
    return 
    <li>
    <a href="{text {$i//link}}">{text {$i//title}}</a><br />
    </li>
    }
    </p>
}

define function get_delicious($package as xs:string) as element()
{
    if (contains($package, "::")) then
        let $head := substring-before($package, "::")
        let $tail := get_delicious(substring-after($package, "::"))
        return 
            <div>{delicious_box($head)}{$tail}</div>
    else <div>{delicious_box($package)}</div>
}

define function get_safari($package as xs:string) as element()
{

<div>
{
if (count(input()/safari[.//package = $package]//book) > 0) then
    <div>
    <h2>Safari Book Excerpts</h2>
    {
    for $b in (input()/safari[.//package = $package]//book)[1 to 5]
    return
        <div>
        <div><b>{text{($b//title)[1]}}</b></div>
        {
            for $s in $b//section
            return
            <div><a href="{text {($s//url)[1]}}">{text{($s//heading)[1]}} {text{($s//title)[1]}}</a></div>
        }
        <br />
        </div>
    }
    </div>
else 
<div></div>
}
</div>
}

define function get_sidebar ($result as element()) as element()
{
    let $term := xdmp:get-request-field('term', '')
    return 
    if (string-length(($result//package)[1]) > 1) then
        <div>
        {get_safari(($result//package)[1])}
        {get_delicious(($result//package)[1])}
        </div>
    else if (string-length($term) > 1) then 
        <div>
        {get_safari($term)}
        {get_delicious($term)}
        </div>
    else <div></div>
}

xdmp:set-response-content-type("text/html"),
let $result := process_request()
let $sidebar := get_sidebar($result)
let $body   := <div>{passthru($result, $result)}</div>
return display_page($body, $sidebar)