svnarcst.fsx

// Copyright (c) 2014 Atif Aziz. All rights reserved.
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//    http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#r "System.Xml.Linq.dll"

open System
open System.Diagnostics
open System.Globalization
open System.Net
open System.Net.Mime
open System.Text
open System.Text.RegularExpressions
open System.Xml.Linq

let inline formatByteSize formatProvider size =
    let kiloByte = 1024.0
    let megaByte = kiloByte * 1024.0
    let gigaByte = megaByte * 1024.0
    let size = float size
    let (size, suffix, precision) = 
        if      (size > gigaByte) then (size / gigaByte, "GB"    , "N2")
        else if (size > megaByte) then (size / megaByte, "MB"    , "N2")
        else if (size > kiloByte) then (size / kiloByte, "KB"    , "N2")
        else if (size = 1.0     ) then (size           , " byte" , "N0")
        else                           (size           , " bytes", "N0")
    size.ToString(precision, formatProvider) + suffix

let opt x = if x = null then None else Some(x)

type WebClient() =
    inherit System.Net.WebClient()

    let mutable mthd = null

    member private this.Decode bytes = 
        let encoding = 
            this.ResponseHeaders.["Content-Type"] |> opt 
            |> Option.map (fun h -> ContentType(h)) 
            |> Option.map (fun ct -> ct.CharSet) 
            |> function
            | None -> this.Encoding
            | Some(charset) -> Encoding.GetEncoding(charset)
        encoding.GetString(bytes)

    member this.Method
        with get() = mthd
        and  set value = mthd <- value

    override this.GetWebRequest(address) = 
        let req = base.GetWebRequest(address)
        if not (mthd = null) then 
            req.Method <- mthd
            mthd <- null
        req

    member this.DownloadString(address : Uri) =
        base.DownloadData(address) |> this.Decode

    member this.UploadString(address : Uri, data : string) =
        base.UploadData(address, base.Encoding.GetBytes(data)) |> this.Decode

module Xmlns =
    let svn = XNamespace.Get("svn:")
    let dav = XNamespace.Get("DAV:")

type NodeKind =
| Added
| Modified

let svnstats http filter (root : Uri) (path : string) =

    let (headers, _) = 
        XElement.Parse("<D:options xmlns:D='DAV:'><D:activity-collection-set/></D:options>") 
        |> string 
        |> http "OPTIONS" (Uri(root, path)) Seq.empty
    
    let svnRevRootStub = headers("SVN-Rev-Root-Stub")
    let youngestRev = Int32.Parse(headers("SVN-Youngest-Rev"), CultureInfo.InvariantCulture)
    
    let rec page rev =

        let url = Uri(root, sprintf "%s/%d/" svnRevRootStub (rev))
        let (_, rsp) = 
            XElement(Xmlns.svn + "log-report",
                XElement(Xmlns.svn + "start-revision", rev),
                XElement(Xmlns.svn + "end-revision"),
                XElement(Xmlns.svn + "limit", 500),
                XElement(Xmlns.svn + "discover-changed-paths"),
                XElement(Xmlns.svn + "revprop", "svn:author"),
                XElement(Xmlns.svn + "revprop", "svn:date"),
                XElement(Xmlns.svn + "revprop", "svn:log"),
                XElement(Xmlns.svn + "path")) 
                |> string 
                |> http "REPORT" url Seq.empty

        let items = XDocument.Parse(rsp)
                             .Elements(Xmlns.svn + "log-report")
                             .Elements(Xmlns.svn + "log-item")
    
        // TODO? let inline (!>) (b : ^b) : ^a = (^a : (static member op_Explicit : ^b -> ^a) (b))

        let xastr a = XAttribute.op_Explicit(a) : string
        let xstr  x = XElement.op_Explicit(x)   : string
        let xdate x = XElement.op_Explicit(x)   : DateTimeOffset

        let items = seq { 
            for item in items ->
                let rev      = item.Element(Xmlns.dav + "version-name")        |> int
                let author   = item.Element(Xmlns.dav + "creator-displayname") |> xstr
                let date     = item.Element(Xmlns.svn + "date")                |> xdate
                let comment  = item.Element(Xmlns.dav + "comment")             |> xstr
                let files = seq { 
                    for changes in [ ("modified-path", Modified); ("added-path", Added) ] do
                        for p in item.Elements(Xmlns.svn + (fst changes)) do
                            let path = p |> xstr
                            let kind = p.Attribute(XName.Get("node-kind")) |> xastr
                            if kind = "file" then yield (path, snd changes) 
                }
                (rev, author, date, comment, files |> Seq.toList)
        }
        match items |> Seq.toList with
        | [] -> Seq.empty
        | _ as items -> seq {
            for (rev, author, date, comment, files) in items do
                for (path, status) in files do 
                
                    let url = Uri(root, sprintf "%s/%d%s" svnRevRootStub rev path)
                    let (_, rsp) = 
                        XElement(Xmlns.dav + "propfind", 
                            XElement(Xmlns.dav + "prop", 
                                XElement(Xmlns.dav + "version-name"),
                                XElement(Xmlns.dav + "creationdate"),
                                XElement(Xmlns.dav + "getcontentlength")))
                        |> string 
                        |> http "PROPFIND" url ["Connection", "TE"; "TE", "trailers"; "depth", "0"]

                    let rsps = XDocument.Parse(rsp)
                                        .Elements(Xmlns.dav + "multistatus")
                                        .Elements(Xmlns.dav + "response")
                
                    let props = seq { // '/*/D:response[D:href]/D:propstat[D:status/text()="HTTP/1.1 200 OK"]/D:prop/D:*'
                        for rsp in rsps do
                            let href = rsp.Element(Xmlns.dav + "href") |> xstr
                            if filter href then
                                let propstat = rsp.Element(Xmlns.dav + "propstat")
                                let status = propstat.Element(Xmlns.dav + "status") |> xstr
                                if (status.Equals("HTTP/1.1 200 OK", StringComparison.OrdinalIgnoreCase)) then
                                    for prop in propstat.Element(Xmlns.dav + "prop").Elements() do
                                        if prop.Name.Namespace = Xmlns.dav then
                                            yield (prop.Name.LocalName, prop)
                    }
                    let props = props |> Map.ofSeq 
                    let len  = props.TryFind "getcontentlength" |> Option.map int64
                    let date = props.TryFind "creationdate"     
                               |> Option.map xstr 
                               |> Option.map (fun s -> DateTimeOffset.Parse(s, CultureInfo.InvariantCulture))
                    if len.IsSome && date.IsSome then yield (rev, path, len.Value, date.Value)
            
            yield! items |> Seq.map (fun (rev, _, _, _, _) -> rev - 1) 
                         |> Seq.min 
                         |> page
        }

    page youngestRev
        

let http mthd (url : Uri) headers req =
    use wc = new WebClient()
    wc.Method <- mthd
    for (k : string), v in headers do wc.Headers.[k] <- v
    let rsp = if req = null then wc.DownloadString(url) else wc.UploadString(url, req)
    let headers = wc.ResponseHeaders
    (fun (k : string) -> headers.[k]), rsp

let cnst x _ = x

let main args =

    let root, path, pp = 
        match args |> Seq.toList with
        | [root]              -> root, "/",  true |> cnst
        | [root; path]        -> root, path, true |> cnst
        | [root; path; pp; _] -> let re = Regex(pp)
                                 root, path, re.IsMatch
        | _ -> failwith "Missing SVN repository root URL."

    let root, path = Uri(root), Uri(path, UriKind.Relative)
    let files = svnstats http pp root path.OriginalString
    let seed = (0, String.Empty, 0L, DateTimeOffset.MinValue, 0L, 0L)
    let scanner (_, _, _, _, cnt, sum) (rev, path, len, date) = (rev, path, len, date, cnt + 1L, sum + len)
    let stats = files |> Seq.scan scanner seed |> Seq.skip 1
   
    let formatByteSize = formatByteSize CultureInfo.CurrentCulture
    for (rev, path, len, date, cnt, sum) in stats do 
        let len  = formatByteSize len 
        let date = date.ToString("yyyy-MM-dd HH':'mm")
        let cnt  = cnt.ToString("N0")
        let sum  = formatByteSize sum
        printfn "%10d %10s %10s %10s %s %s" rev sum cnt len date path

try
    fsi.CommandLineArgs |> Seq.skip(1) |> main 
    0
with
| e -> 
    e.GetBaseException().Message |> eprintfn "%s"
    Trace.TraceError(e.ToString())    
    1