Rosetta Code/Find bare lang tags: Difference between revisions
→Tcl: Added implementation |
→{{header|Tcl}}: Full solution |
||
Line 84: | Line 84: | ||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
For all the extra credit (note, takes a substantial amount of time due to number of HTTP requests): |
|||
Doing one of the extra credit options… |
|||
{{tcllib|json}} |
|||
{{tcllib|textutil::split}} |
{{tcllib|textutil::split}} |
||
{{tcllib|uri}} |
|||
⚫ | |||
<lang tcl>package require Tcl 8.5 |
|||
package require http |
|||
package require json |
|||
⚫ | |||
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/api.php \ |
|||
title $task action raw] |
|||
set content [http::data $token] |
|||
http::cleanup $token |
|||
return $content |
|||
} |
|||
proc init {} { |
proc init {} { |
||
Line 96: | Line 157: | ||
proc findBareTags {pageName pageContent} { |
proc findBareTags {pageName pageContent} { |
||
global total count found |
global total count found |
||
set t {{ |
set t {{}} |
||
lappend t {*}[textutil::split::splitx $pageContent \ |
lappend t {*}[textutil::split::splitx $pageContent \ |
||
{==\s*\{\{\s*header\s*\|\s*([^{}]+?)\s*\}\}\s*==}] |
{==\s*\{\{\s*header\s*\|\s*([^{}]+?)\s*\}\}\s*==}] |
||
Line 112: | Line 173: | ||
if {$total} { |
if {$total} { |
||
puts "" |
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\ |
puts "$count($sectionName) in $sectionName\ |
||
(\[\[[join $found($sectionName) {]], [[}]\]\])" |
(\[\[[join $found($sectionName) {]], [[}]\]\])" |
||
Line 119: | Line 185: | ||
} |
} |
||
# Do the first level of extra credit. Note that filenames are interleaved with |
|||
# page titles as the page content doesn't (necessarily) contain the title. |
|||
init |
init |
||
set tasks [get_tasks Programming_Tasks] |
|||
foreach {filename title} $argv { |
|||
#puts stderr "querying over [llength $tasks] tasks..." |
|||
set f [open $filename] |
|||
foreach task [get_tasks Programming_Tasks] { |
|||
⚫ | |||
#puts stderr "$task..." |
|||
⚫ | |||
} |
} |
||
printResults</lang> |
printResults</lang> |
Revision as of 09:24, 23 September 2011
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>
Tcl
For all the extra credit (note, takes a substantial amount of time due to number of HTTP requests):
<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/api.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]
- puts stderr "querying over [llength $tasks] tasks..."
foreach task [get_tasks Programming_Tasks] {
#puts stderr "$task..." findBareTags $task [getTaskContent $task]
} printResults</lang>