Rosetta Code/Find bare lang tags

Rosetta Code/Find bare lang tags is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Find all <lang> tags without a language specified in the text of a page. Display counts by language section:

Description

<lang>Pseudocode</lang>

=={{header|C}}==
<lang C>printf("Hello world!\n");</lang>

=={{header|Perl}}==
<lang>print "Hello world!\n"</lang>

should display something like

2 bare language tags.

1 in perl
1 in no language

For extra credit, allow multiple files to be read. Summarize all results by language:

5 bare language tags.

2 in c ([[Foo]], [[Bar]])
1 in perl ([[Foo]])
2 in no language ([[Baz]])

For more extra credit, use the Media Wiki API to test actual RC tasks.

AutoHotkey

This code has no syntax highlighting, because Rosetta Code's highlighter fails with code that contains literal </lang> tags.

Stole RegEx Needle from Perl

task =
(
Description

<lang>Pseudocode</lang>

=={{header|C}}==
<lang C>printf("Hello world!\n");</lang>

=={{header|Perl}}==
<lang>print "Hello world!\n"</lang>
)
lang := "no lanugage", out := Object(lang, 0), total := 0
Loop Parse, task, `r`n
	If RegExMatch(A_LoopField, "==\s*{{\s*header\s*\|\s*([^\s\}]+)\s*}}\s*==", $)
		lang := $1, out[lang] := 0
	else if InStr(A_LoopField, "<lang>")
		out[lang]++
For lang, num in Out
	If num
		total++, str .= "`n" num " in " lang
MsgBox % clipboard := total " bare lang tags.`n" . str

Output:

2 bare lang tags.

1 in no lanugage
1 in Perl

Perl

This is a simple implementation that does not attempt either extra credit. <lang perl>my $lang = 'no language'; my $total = 0; my %blanks = (); while (<>) {

 if (m/<lang>/) {
   if (exists $blanks{lc $lang}) {
     $blanks{lc $lang}++
   } else {
     $blanks{lc $lang} = 1
   }
   $total++
 } elsif (m/==\s*Template:\s*header\s*\\s*==/) {
   $lang = lc $1
 }

}

if ($total) { print "$total bare language tag" . ($total > 1 ? 's' : ) . ".\n\n"; while ( my ($k, $v) = each(%blanks) ) { print "$k in $v\n" } }</lang>

Racket

Note that this follows the task, but the output is completely bogus since the actual <lang> tags that it finds are in <pre> and in code...

<lang racket>

1. lang racket

(require net/url net/uri-codec json)

(define (get-text page)

 (define ((get k) x) (hash-ref x k))
 ((compose1 (get '*) car (get 'revisions) cdar hash->list (get 'pages)
            (get 'query) read-json get-pure-port string->url format)
  "http://rosettacode.org/mw/api.php?~a"
  (alist->form-urlencoded
   `([titles . ,page] [prop . "revisions"] [rvprop . "content"]
     [format . "json"] [action . "query"]))))

(define (find-bare-tags page)

 (define in (open-input-string (get-text page)))
 (define rx
   ((compose1 pregexp string-append)
    "<\\s*lang\\s*>|"
    "==\\s*\\{\\{\\s*header\\s*\\|\\s*([^{}]*?)\\s*\\}\\}\\s*=="))
 (let loop ([lang "no language"] [bare '()])
   (match (regexp-match rx in)
     [(list _ #f) (loop lang (dict-update bare lang add1 0))]
     [(list _ lang) (loop lang bare)]
     [#f (printf "~a bare language tags\n" (apply + (map cdr bare)))
         (for ([b bare]) (printf "  ~a in ~a\n" (cdr b) (car b)))])))

(find-bare-tags "Rosetta Code/Find bare lang tags") </lang>

Output:

8 bare language tags
  2 in no language
  4 in Perl
  1 in AutoHotkey
  1 in Tcl

Tcl

For all the extra credit (note, takes a substantial amount of time due to number of HTTP requests):

Library: Tcllib (Package: json)

Library: Tcllib (Package: textutil::split)

Library: Tcllib (Package: uri)

<lang tcl>package require Tcl 8.5 package require http package require json package require textutil::split package require uri

proc getUrlWithRedirect {base args} {

   set url $base?[http::formatQuery {*}$args]
   while 1 {

set t [http::geturl $url] if {[http::status $t] ne "ok"} { error "Oops: url=$url\nstatus=$s\nhttp code=[http::code $token]" } if {[string match 2?? [http::ncode $t]]} { return $t } # OK, but not 200? Must be a redirect... set url [uri::resolve $url [dict get [http::meta $t] Location]] http::cleanup $t

   }

}

proc get_tasks {category} {

   global cache
   if {[info exists cache($category)]} {

return $cache($category)

   }
   set query [dict create cmtitle Category:$category]
   set tasks [list]

   while {1} {

set response [getUrlWithRedirect http://rosettacode.org/mw/api.php \ action query list categorymembers format json cmlimit 500 {*}$query]

# Get the data out of the message

       set data [json::json2dict [http::data $response]]
       http::cleanup $response

       # add tasks to list
       foreach task [dict get $data query categorymembers] {
           lappend tasks [dict get [dict create {*}$task] title]
       }

       if {[catch {

dict get $data query-continue categorymembers cmcontinue } continue_task]} then {

           # no more continuations, we're done
           break
       }
       dict set query cmcontinue $continue_task
   }
   return [set cache($category) $tasks]

} proc getTaskContent task {

   set token [getUrlWithRedirect http://rosettacode.org/mw/index.php \

title $task action raw]

   set content [http::data $token]
   http::cleanup $token
   return $content

}

proc init {} {

   global total count found
   set total 0
   array set count {}
   array set found {}

} proc findBareTags {pageName pageContent} {

   global total count found
   set t {{}}
   lappend t {*}[textutil::split::splitx $pageContent \

{==\s*\{\{\s*header\s*\|\s*([^{}]+?)\s*\}\}\s*==}]

   foreach {sectionName sectionText} $t {

set n [regexp -all {<lang>} $sectionText] if {!$n} continue incr count($sectionName) $n lappend found($sectionName) $pageName incr total $n

   }

} proc printResults {} {

   global total count found
   puts "$total bare language tags."
   if {$total} {

puts "" if {[info exists found()]} { puts "$count() in task descriptions\ (\[\[[join $found() {]], [[}]\]\])" unset found() } foreach sectionName [lsort -dictionary [array names found]] { puts "$count($sectionName) in $sectionName\ (\[\[[join $found($sectionName) {]], [[}]\]\])" }

   }

}

init set tasks [get_tasks Programming_Tasks]

1. puts stderr "querying over [llength $tasks] tasks..."

foreach task [get_tasks Programming_Tasks] {

   #puts stderr "$task..."
   findBareTags $task [getTaskContent $task]

} printResults</lang>