Created
January 10, 2010 15:10
-
-
Save JeffreyZhao/273556 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#light | |
module CnBlogsMonitoring.PostMonitor | |
open System | |
open System.Net | |
open System.IO | |
open System.Text.RegularExpressions | |
open System.IO.Compression | |
type WebClient with | |
member c.GetDataAsync(url) = | |
async { | |
do c.DownloadDataAsync(new Uri(url)) | |
let! args = Async.AwaitEvent(c.DownloadDataCompleted) | |
return args.Result | |
} | |
let getPostUrlsAsync alias (beginMonth: DateTime) (endMonth: DateTime) = | |
if (beginMonth > endMonth) then | |
failwith "beginMonth must smaller then or equals to endMonth" | |
let getPostUrlsAsync' alias (m: DateTime) = | |
async { | |
let webClient = new WebClient(); | |
webClient.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip") | |
let url = sprintf "http://%s.cnblogs.com/archive/%i/%i.html" alias m.Year m.Month | |
let! data = webClient.GetDataAsync(url) | |
let rawStream = new MemoryStream(data) | |
let gzipStream = new GZipStream(rawStream, CompressionMode.Decompress) | |
let reader = new StreamReader(gzipStream) | |
let html = reader.ReadToEnd() | |
let regex = @"<a\s[^>]*href=[""|'](http://www.cnblogs.com/\w+/archive/\d{4}/\d{2}/\d{2}/[^.]*\.html)[""|'][^>]*>\s*阅读全文\s*</a>" | |
return [ for m in Regex.Matches(html, regex) -> m.Groups.Item(1).Value ] | |
} | |
let executeAsync tasks = | |
let rec executeAsync' (tasks: (_ * Async<_>) list) acc = | |
async { | |
match tasks with | |
| [] -> return acc |> List.rev | |
| (pre, task) :: ts -> | |
let! result = task | |
return! executeAsync' ts ((pre, result) :: acc) | |
} | |
executeAsync' tasks List.empty | |
Seq.initInfinite (fun i -> endMonth.AddMonths(-i)) | |
|> Seq.takeWhile (fun m -> m >= beginMonth) | |
|> Seq.map (fun m -> (m, getPostUrlsAsync' alias m)) | |
|> Seq.toList | |
|> executeAsync |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<%@ Page Language="C#" AutoEventWireup="true" CodeBehind="PostsOfMonths.aspx.cs" Inherits="CometServer.PostsOfMonths" %> | |
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> | |
<html xmlns="http://www.w3.org/1999/xhtml"> | |
<head runat="server"> | |
<title></title> | |
</head> | |
<body> | |
<h1><%= this.Title %></h1> | |
<asp:Repeater runat="server" ID="rptPostsOfMonths"> | |
<ItemTemplate> | |
<h2><%# Eval("Item1", "{0:yyyy/MM}") %> - <%# Eval("Item2.Length") %> post(s)</h2> | |
<asp:Repeater runat="server" DataSource='<%# Eval("Item2") %>'> | |
<HeaderTemplate><ul></HeaderTemplate> | |
<ItemTemplate> | |
<li> | |
<a href="<%# Container.DataItem %>"><%# Container.DataItem %></a> | |
</li> | |
</ItemTemplate> | |
<FooterTemplate></ul></FooterTemplate> | |
</asp:Repeater> | |
</ItemTemplate> | |
</asp:Repeater> | |
</body> | |
</html> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
using System; | |
using System.Collections.Generic; | |
using System.Linq; | |
using System.Web; | |
using System.Web.UI; | |
using System.Web.UI.WebControls; | |
namespace CometServer | |
{ | |
public partial class PostsOfMonths : System.Web.UI.Page | |
{ | |
protected void Page_Load(object sender, EventArgs e) | |
{ | |
this.Title = this.Context.Items["Title"].ToString(); | |
this.rptPostsOfMonths.DataSource = this.Context.Items["PostsOfMonths"]; | |
this.rptPostsOfMonths.DataBind(); | |
} | |
} | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#light | |
namespace CnBlogsMonitoring | |
open System | |
open System.Web | |
type PostsOfMonthsHandler() = | |
let mutable m_context = null | |
let mutable m_endWork = null | |
interface IHttpAsyncHandler with | |
member h.IsReusable = false | |
member h.ProcessRequest(context) = failwith "not supported" | |
member h.BeginProcessRequest(c, cb, state) = | |
m_context <- c | |
let alias = c.Request.QueryString.Item("alias").Trim() | |
let bm = DateTime.ParseExact(c.Request.QueryString.Item("begin"), "yyyy/MM", null) | |
let em = DateTime.ParseExact(c.Request.QueryString.Item("end"), "yyyy/MM", null) | |
let monthDiff = (em.Month - bm.Month) + (em.Year - bm.Year) * 12 | |
if monthDiff > 12 then failwith "Please pick a range no larger than 12 months." | |
let title = sprintf "%s: %i/%i ~ %i/%i" alias bm.Year bm.Month em.Year em.Month | |
m_context.Items.Item("Title") <- title | |
let work = PostMonitor.getPostUrlsAsync alias bm em | |
let beginWork, endWork, _ = Async.AsBeginEnd work | |
m_endWork <- new Func<_, _>(endWork) | |
beginWork (cb, state) | |
member h.EndProcessRequest(ar) = | |
m_context.Items.Item("PostsOfMonths") <- m_endWork.Invoke ar | |
m_context.Server.Transfer("PostsOfMonths.aspx") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment