ad_general_link_check db link_idWhat it does:
checks a link and steals meta tagsDefined in: /web/philip/tcl/ad-general-links.tcl
Source code:
set url [database_to_tcl_string $db "select url from general_links where link_id = $link_id"]
ns_db dml $db "begin transaction"
ns_db dml $db "update general_links set last_checked_date=sysdate where link_id = $link_id"
# strip off any trailing #foo section directives to browsers
set complete_url $url
regexp {^(.*/?[^/]+)\#[^/]+$} $complete_url match complete_url
if [catch { set response [get_http_status $complete_url 0] } errmsg ] {
# we got an error (probably a dead server)
ns_db dml $db "end transaction"
return $errmsg
} elseif {$response == 404 || $response == 405 || $response == 500 } {
# we should try again with a full GET
# because a lot of program-backed servers return 404 for HEAD
# when a GET works fine
if [catch { set response [get_http_status $complete_url 1] } errmsg] {
# probably the foreign server isn't responding
ns_db dml $db "end transaction"
return "server not responding"
}
}
if { $response != 200 && $response != 302 } {
ns_db dml $db "end transaction"
return "error in reaching server"
} else {
if {![catch {ns_httpget $complete_url 3 1} url_content]} {
set meta_description ""
set meta_keywords ""
regexp -nocase {<meta name="description" content="([^"]*)">} $url_content match meta_description
regexp -nocase {<meta name="keywords" content="([^"]*)">} $url_content match meta_keywords
# process and truncate outrageously long meta tags
set QQmeta_description [DoubleApos $meta_description]
set QQmeta_keywords [DoubleApos $meta_keywords]
if {[string length $QQmeta_keywords]>4000} {
set QQmeta_keywords "[string range $QQmeta_keywords 0 3996]..."
}
if {[string length $QQmeta_description]>4000} {
set QQmeta_description "[string range $QQmeta_description 0 3996]..."
}
} else {
return $url_content
}
}
ns_db dml $db "update general_links
set meta_description = '$QQmeta_description',
meta_keywords = '$QQmeta_keywords',
last_live_date = sysdate
where link_id = $link_id
"
ns_db dml $db "end transaction"
return 1