Skip to content

Instantly share code, notes, and snippets.

@JeffreyZhao
Created January 10, 2010 15:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save JeffreyZhao/273556 to your computer and use it in GitHub Desktop.
Save JeffreyZhao/273556 to your computer and use it in GitHub Desktop.
#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
<%@ 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>
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();
}
}
}
#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