Tuesday, December 23, 2008

Simple Video Hosting with F# and Silverlight 2

I use to hate household maintenance projects such as replacing a leaky faucet or fixing a clogged water pipe.  I typically get frustrated because I would run into problems disassembling the plumbing components or find out that I don’t have the right tools to reassemble the plumbing components.  Lately, however, I have had much more success with my household plumbing projects.  When my kitchen faucet broke, I had a relatively painless experience in replacing the hardware.  I attribute this painless experience to the fact that I followed a video tutorial instead of printed material and come to appreciate the power and benefits of a video tutorial.

And similarly, I find myself looking for videos tutorials when it comes learning about complex technologies.  Lately, I have looked at SharePoint video tutorials and found them immensely helpful.  This got me interested in how finding out easy it is to host video content in Silverlight 2.  The answer is that it’s extremely easy and here’s a simple F# implementation of a video player in Silverlight 2.


#light
namespace SilverLightFSharp
open System
open System.Windows
open System.Windows.Controls
open System.Windows.Controls.Primitives
open System.Windows.Data
open System.Windows.Media
open List

// Simple Video Player Example in Silverlight 2 with F#
type MyPage = class
inherit UserControl

new () as this = {} then

this.Width <- 400.0
this.Height <- 400.0

let textbox = new TextBox(TextAlignment =TextAlignment.Center,
VerticalAlignment=VerticalAlignment.Top,
Text="Silverlight Video Example")

let media = new MediaElement(VerticalAlignment=VerticalAlignment.Center,
HorizontalAlignment=HorizontalAlignment.Center,
Width=400.0,Height=300.0)



let playButton = new Button(Content="Play")
let pauseButton = new Button(Content="Pause")
let stopButton = new Button(Content="Stop")

playButton.Click.Add(fun _ -> media.Play())
pauseButton.Click.Add(fun _ -> media.Pause())
stopButton.Click.Add(fun _ -> media.Stop())

let createGrid numrows numcols =
let grid = new Grid()
[1..numrows] |> iter (fun _ ->
new RowDefinition(Height=GridLength.Auto) |> grid.RowDefinitions.Add)
[1..numcols] |> iter (fun _ ->
new ColumnDefinition(Width=GridLength.Auto) |> grid.ColumnDefinitions.Add)
grid


let addTo (grid:Grid) item row column =
grid.Children.Add(item)
Grid.SetRow(item,row)
Grid.SetColumn(item,column)

let grid = createGrid 1 3

addTo grid playButton 0 0
addTo grid pauseButton 0 1
addTo grid stopButton 0 2

media.Source <- new Uri("test.wmv",UriKind.Relative)

media.DownloadProgressChanged.Add(fun e ->
let percentage = media.DownloadProgress*100.0
let status = (Printf.sprintf "%3.2f percent done" percentage)
textbox.Text <-status)

let stack = new StackPanel(Background=new SolidColorBrush(Colors.White))


textbox |> stack.Children.Add
media |> stack.Children.Add
grid |> stack.Children.Add

this.Content <- stack
end

type MyApp = class
inherit Application

new () as this = {} then
this.Startup.Add(fun _ -> this.RootVisual <- new MyPage())

end

In order to get this to work, I had to add system.dll and System.Core.dll to the .xap file. Make sure you grab these dll files from the Silverlight 2 SDK and not from the .Net Framework.

I had a request to post the .xap file and here are they are. The zip files contain both the source file along with the .xap and testpage.html file that is deployed on the server.  The deployment items are in the webdeploy folder of the zip file. The file simplebutton.zip is the source and deployment content for the previous post the file simplevideo.zip is the source and deployment content for this post.

simplebutton.zip

simplevideo.zip

Thursday, November 20, 2008

F# and Silverlight 2.0

One of the appeal of learning WPF is that now I can leverage what I learned in WPF and apply them to building web applications via Silverlight 2.0. This blog talks about setting up a very simple Silverlight 2.0 web application with F#.

Since my laptop is running Windows XP, I needed to build an environment with which I can host my Silverlight application. I decided to build a Virtual PC environment running Windows Server 2008. I'm using F# version 1.9.6.2 to build this sample Silverlight application.

Below is the simple Silverlight application with only a single clickable button:


#light
namespace SilverLightFSharp
open System
open System.Windows
open System.Windows.Controls

type MyPage = class
inherit UserControl

new () as this = {} then
// Add button and do something with it...
let btn = new Button(HorizontalAlignment = HorizontalAlignment.Center,
VerticalAlignment = VerticalAlignment.Center)
btn.Content <- "Click me"
btn.Click.Add(fun _ ->
btn.Content <- "The button has been clicked!")
this.Content <- btn

end

type MyApp = class
inherit Application

new () as this = {} then
this.Startup.Add(fun _ -> this.RootVisual <- new MyPage())
//base.Exit.Add( fun _ -> ()) //this.Application_Exit)
//this.InitializeComponent()

end

I also needed some scaffolding in order to get this Silverlight application to run. One of the scaffolding pieces I need is the AppManifest.xaml file. Below is the content of that AppManifest.xml file with the EntryPointAssembly and EntryPointType attributes set to my F# code.


<Deployment xmlns="http://schemas.microsoft.com/client/2007/deployment"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
EntryPointAssembly="SilverLightFSharp"
EntryPointType="SilverLightFSharp.MyApp" RuntimeVersion="2.0.31005.0">
<Deployment.Parts>
<AssemblyPart x:Name="SilverLightFSharp" Source="SilverLightFSharp.dll" />
<AssemblyPart x:Name="FSharp.Core" Source="FSharp.Core.dll" />
<AssemblyPart x:Name="System.Windows.Controls" Source="System.Windows.Controls.dll" />
</Deployment.Parts>
</Deployment>

I'll also need a test html page to host my silverlight application. I created a TestPage.html to host my Silverlight application. Please note that for the Silverlight control host has the source referencing the file simplebutton.xap. Not to worry, simplebutton.xap is merely a zip file that contains the following files:

  • AppManifest.xaml
  • FSharp.Core.dll
  • System.Windows.Control.dll
  • SilverlightFsharp.dll

Here's the TestPage.html code:


<!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" >
<!-- saved from url=(0014)about:internet -->
<head>
<title>SilverlightFSharp</title>

<style type="text/css">
html, body {
height: 100%;
overflow: auto;
}
body {
padding: 0;
margin: 0;
}
#silverlightControlHost {
height: 100%;
}
</style>

<script type="text/javascript">
function onSilverlightError(sender, args) {

var appSource = "";
if (sender != null && sender != 0) {
appSource = sender.getHost().Source;
}
var errorType = args.ErrorType;
var iErrorCode = args.ErrorCode;

var errMsg = "Unhandled Error in Silverlight 2 Application " + appSource + "\n" ;

errMsg += "Code: "+ iErrorCode + " \n";
errMsg += "Category: " + errorType + " \n";
errMsg += "Message: " + args.ErrorMessage + " \n";

if (errorType == "ParserError")
{
errMsg += "File: " + args.xamlFile + " \n";
errMsg += "Line: " + args.lineNumber + " \n";
errMsg += "Position: " + args.charPosition + " \n";
}
else if (errorType == "RuntimeError")
{
if (args.lineNumber != 0)
{
errMsg += "Line: " + args.lineNumber + " \n";
errMsg += "Position: " + args.charPosition + " \n";
}
errMsg += "MethodName: " + args.methodName + " \n";
}

throw new Error(errMsg);
}
</script>
</head>

<body>
<!-- Runtime errors from Silverlight will be displayed here.
This will contain debugging information and should be removed or hidden when debugging is completed -->
<div id='errorLocation' style="font-size: small;color: Gray;"></div>

<div id="silverlightControlHost">
<object data="data:application/x-silverlight," type="application/x-silverlight-2" width="100%" height="100%">
<param name="source" value="simplebutton.xap"/>
<param name="onerror" value="onSilverlightError" />
<param name="background" value="white" />
<param name="minRuntimeVersion" value="2.0.31005.0" />
<param name="autoUpgrade" value="true" />
<a href="http://go.microsoft.com/fwlink/?LinkID=124807" style="text-decoration: none;">
<img src="http://go.microsoft.com/fwlink/?LinkId=108181" alt="Get Microsoft Silverlight" style="border-style: none"/>
</a>
</object>
<iframe style='visibility:hidden;height:0;width:0;border:0px'></iframe>
</div>
</body>
</html>

After I copy simplebutton.xap and TestPage.html to my IIS webserver, I am rewarded with the following results:

Tuesday, October 28, 2008

Create SharePoint BDC connector for AdventureWorks database with F# Script

I have been exploring how to create Business Data Catalog in the SharePoint environment. It seems the best way to create BDC application definition file is via a tool called BDC Meta Man, which provides a graphical environment to create the definition file. For my own understanding, I tried to script the creation of the BDC application definition file. In the F# script below, I created the BDC to the HR data in the sample AdventureWorks SQL Server database. This script loosely follows Chapter 4 of Patrick Tisseghem's book Inside Microsoft Office SharePoint Server 2007.



#light
#I @"C:\Program Files\Common Files\Microsoft Shared\web server extensions\12\ISAPI"
#r @"Microsoft.SharePoint.dll"
#r @"Microsoft.SharePoint.Portal.dll"
#r @"Microsoft.Office.Server.dll"

open Microsoft.Office.Server.ApplicationRegistry.Administration
open Microsoft.Office.Server.ApplicationRegistry.Infrastructure
open Microsoft.Office.Server.ApplicationRegistry.SystemSpecific.Db
open List
open System.Data

SqlSessionProvider.Instance().SetSharedResourceProviderToUse("SharedServices1")

// Create LOB System
let lobsystem =
("Adventure Works Human Resources Data",
false,
"Microsoft.Office.Server.ApplicationRegistry.SystemSpecific.Db.DbSystemUtility",
"Microsoft.Office.Server.ApplicationRegistry.SystemSpecific.Db.DbConnectionManager",
"Microsoft.Office.Server.ApplicationRegistry.SystemSpecific.Db.DbEntityInstance")
|> ApplicationRegistry.Instance.LobSystems.Create


// Add property defining the character % will be replacing the * wildcar entered by users
("WildcardCharacter","%") |> lobsystem.Properties.Add
lobsystem.Update()


// Create LOB System instance
let sysInstance = lobsystem.LobSystemInstances.Create("HR data",true)

("AuthenticationMode",DbAuthenticationMode.RevertToSelf) |> sysInstance.Properties.Add
("DatabaseAccessProvider", DbAccessProvider.SqlServer) |> sysInstance.Properties.Add

[("RdbConnection Data Source", "MOSS");
("RdbConnection Initial Catalog","AdventureWorks");
("RdbConnection Integrated Security", "SSPI")]
|> iter (fun (k,v) -> sysInstance.Properties.Add (k,v))

sysInstance.Update()

// Create Employee Entity
let entity = lobsystem.Entities.Create("Employee",true)
let identifier = entity.Identifiers.Create("[EmployeeID]",true,"System.Int32")
let mthd = entity.Methods.Create("GetEmployees",true,true)

("RdbCommandText",
@"Select [EmployeeID],[Title],[FirstName],[MiddleName],[LastName],[Suffix],[JobTitle],[Phone],[EmailAddress],[EmailPromotion],[AddressLine1],[AddressLine2],[City],[StateProvinceName],[PostalCode],[CountryRegionName],[AdditionalContactInfo] From HumanResources.[vEmployee]"
) |> mthd.Properties.Add

("RdbCommandType",CommandType.Text) |> mthd.Properties.Add



let createParameter (thismethod:Method) name direction =
(name,true,direction,
"Microsoft.Office.Server.ApplicationRegistry.Infrastructure.DotNetTypeReflector")
|> thismethod.Parameters.Create


let parEmployees = createParameter mthd "Employees" Microsoft.Office.Server.ApplicationRegistry.MetadataModel.DirectionType.Return

let tdEmployees =
let root =
("EmployeeDataReader",true,
"System.Data.IDataReader, System.Data, Version=2.0.3600.0,Culture=neutral, PublicKeyToken=b77a5c561934e089",
null,null,true)
|> parEmployees.CreateRootTypeDescriptor
let node =
("EmployeeDataRecord",true,
"System.Data.IDataRecord, System.Data, Version=2.0.3600.0,Culture=neutral, PublicKeyToken=b77a5c561934e089",
null,null,false)
|> root.ChildTypeDescriptors.Create

(("EmployeeID", true, "System.Int32", identifier, null, false)
|> node.ChildTypeDescriptors.Create).LocalizedDisplayName <- "Employee ID"

let firstname =
("FirstName", true, "System.String", null, null, false)
|> node.ChildTypeDescriptors.Create
firstname.LocalizedDisplayName <- "First Name"
firstname.Update()

let lastname =
("LastName", true, "System.String", null, null, false)
|> node.ChildTypeDescriptors.Create
lastname.LocalizedDisplayName <- "Last Name"
lastname.Update()

[("JobTitle","System.String","Job Title");
("Phone","System.String","Phone");
("EmailAddress","System.String","Email");
("AddressLine1","System.String","Address");
("City","System.String","City");
("StateProvinceName","System.String","State");
("PostalCode","System.String","Zip");
] |> iter (fun (label,typename,display) ->
((label, true, typename, null, null, false)
|> node.ChildTypeDescriptors.Create).LocalizedDisplayName <- display)
root


// Create method instances
let getEmployees =
("EmployeeFinderInstance",true,tdEmployees,Microsoft.Office.Server.ApplicationRegistry.MetadataModel.MethodInstanceType.Finder)
|> mthd.MethodInstances.Create










Monday, October 13, 2008

Add Web Part to SharePoint with F# Script

In building deployment scripts for SharePoint, there are times when I want to automate the deployment of webparts by building a script to automatically add web parts to specific web pages. I found a book that talked about writing these types of scripts in Mark Gerow's SharePoint 2007 Development Recipes, which had many other useful examples of scripting SharePoint 2007. He's already written a C# version of this script that I've decided to implement in F# for contrast.

Here's the F# version of the code:


#light
#I @"C:\Program Files\Common Files\Microsoft Shared\web server extensions\12\ISAPI"
#r @"Microsoft.SharePoint.dll"

open Microsoft.SharePoint
open Microsoft.SharePoint.WebPartPages
open System.Web.UI.WebControls.WebParts
open System.Xml

let addWebPart page wp zone order pscope (web:SPWeb) =
let webparts = (page, pscope) |> web.GetLimitedWebPartManager
(wp,zone,order) |> webparts.AddWebPart
wp |> webparts.SaveChanges

let disableCheckout (splist:SPList) spOperation =
let oldvalue = splist.ForceCheckout
splist.ForceCheckout <- false
splist.Update()

spOperation

splist.ForceCheckout <- oldvalue
splist.Update()

let spUnsafeUpdate spOperation (siteurl:string) (webname:string) doclib =
let site = new SPSite(siteurl)
let web = site.OpenWeb(webname)
web.AllowUnsafeUpdates <- true

// Disable versioning when updating Document Library
match doclib with
| "" ->
spOperation web
| _ ->
disableCheckout
<| web.Lists.Item(doclib)
<| spOperation web

web.Update()
web.Dispose()
site.Dispose()


let siteurl = "http://localhost/"
let webname = "recipes"
let doclibName=""

// Add page viewer web part
let viewer = new PageViewerWebPart(SourceType=PathPattern.URL,
ContentLink="http://msdn.microsoft.com/en-us/fsharp/default.aspx")

// Add webpart using unsafe updates...
// Experimenting with ranges of expression with F#'s pipeline operators.
// Traditional format for the following code would be
// spUnsafeUpdate siteurl webname doclibName (addWebPart "Default.aspx" editor "Right" 0 Personalization.Shared)
//
addWebPart
<| "Default.aspx"
<| viewer
<| "Left"
<| 0
<| PersonalizationScope.Shared
|> spUnsafeUpdate
<| siteurl
<| webname
<| doclibName


// Add content editor web part
let xmlDoc = new XmlDocument()
let xmlElem = xmlDoc.CreateElement("xmlElem")
xmlElem.InnerText <- "Test content editor web part"
let editor = new ContentEditorWebPart(Content=xmlElem)

addWebPart
<| "Default.aspx"
<| editor
<| "Right"
<| 0
<| PersonalizationScope.Shared
|> spUnsafeUpdate
<| siteurl
<| webname
<| doclibName


Wednesday, October 01, 2008

More SharePoint scripting with F#

F# Interactive mode in Visual Studio is a great way to interactively script SharePoint objects. I'd almost compare this to using sql query editor against a database. I can write the SharePoint code in Visual Studio and have all the code completion and type checking features. I can select the portion of the source code and execute it by pressing Alt+Enter. It's pretty sweet. Combine this with queries built with CAML statements, I can basically do ad hoc queries against SharePoint objects. I don't know any other tool in the SharePoint tool suite that can do this. I can easily imagine a SharePoint management studio tool built with customized Visual Studio plugins that provide a way to explore the SharePoint objects graphically similar to what SQL Server Management Studio does for SQL Server database and uses F# to manipulate SharePoint similar to how SQL manipulates the database.

Here are some example scripts adapted from the book Inside Microsoft Windows SharePoint Services 3.0 by Ted Pattison and Daniel Larson


#light
#I @"C:\Program Files\Common Files\Microsoft Shared\web server extensions\12\ISAPI"
#r @"Microsoft.SharePoint.dll"

open System
open Microsoft.SharePoint

// Utility functions to convert SPxCollection to seq<SPx>
let SPListToSeq (splist:SPListCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

let SPFieldToSeq (splist:SPFieldCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

let SPListItemToSeq (splist:SPListItemCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

let SPContentTypeToSeq (splist:SPContentTypeCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

let site = new SPSite("http://localhost/")
let web = site.OpenWeb()

// Add new SharePoint List called "F# SharePoint News
let id = ("F# SharePoint News",
"List for news on F# and SharePoint items.",
SPListTemplateType.Announcements)
|> web.Lists.Add
let list = web.Lists.[id]
list.OnQuickLaunch <- true
list.Update()

// Add news item to the newly created SharePoint List
let newItem = list.Items.Add()
newItem.["Title"] <-"Check for expired items today!"
newItem.["Body"] <- "We're are expiring this today and see if our query works!"
newItem.["Expires"] <- DateTime.Now
newItem.Update()


// Checking all items in "F# SharePoint News" list that expires today
let queryClause =
@"<Where>
<Eq>
<FieldRef Name='Expires' />
<Value Type='DateTime'><Today /></Value>
</Eq>
</Where>"

let query = new SPQuery(ViewFields = @"<FieldRef Name='Title'/><FieldRef Name='Expires'/>",
Query=queryClause)

let mylist = web.Lists.["F# Sharepoint News"]
SPListItemToSeq (mylist.GetItems(query))
|> Seq.iter (fun x -> printf "%s\n" x.Title)

// Checking available content types
SPContentTypeToSeq web.AvailableContentTypes
|> Seq.iter (fun x -> printf "%s\n\tDescription = %s\n\tID=%s\n" x.Name x.Description (x.Id.ToString()))

web.Close()
site.Close()

Tuesday, September 23, 2008

A more complicated SharePoint web part examples in F# with RSS Viewer and Feed List

I still up to my old tricks with learning new Microsoft Technologies by using F# as the implementation language. I find that by using a different programming language than the one in the book forces me to think through the author's implementation while I transliterate the code into F#. Other bonuses include learning to program in F# and in the process, I often trigger errors while learning the new technology that serendipitously provide me opportunites to explore the technologies in depth.

Lately, I've been exploring SharePoint by going through the book Inside Microsoft Windows SharePoint Services 3.0 by Ted Pattison and Daniel Larson and working through the code examples in Chapter 4 of the book, specifically the RSS Viewer Web Part and the Feed List Web Part example.

In the previous blog, I mentioned that I had to write a SPListCollectionAdapter in C# to wrap SPListCollection so I can use it like standard sequences in F#. I figured out a F# workaround for it so that I don't have to switch back and forth to resolve the problem. In the implementation of the F# solution, I found myself getting really annoyed by the SharePoint libray designers in not implementing the IEnumerable interface in SPBaseCollection so that I don't need to write the adapter in the first place. The second major issue with the SPBaseCollection is that it did not specify and overridable Item property and left it to the implementation class to arbitrarily define the access to the item in the collection list. I have no idea why the SharePoint library designers did this. So instead of writing the following function that can be take any subclass of SPBaseCollection:


let toSeq (splist: #SPBaseCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

I'm now forced to write an adapter for each of the SPBaseCollection subclasses as shown in the following:

    let SPListToSeq (splist:SPListCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

let SPWebToSeq (splist:SPWebCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

In the implementation and testing process, I ran into problems and SharePoint showed some very unhelpful error messages. I found it invaluable to change SharePoint Web.config debug settings as outline in Jesse's SharePoint Blog. Combining that with a custom file logger, I managed to identify all my bugs and resolved the issues.

Here's a screenshot of the implemented RSS Viewer Web Part implemented in F# with the feed url pointed to F# Planet...

Here's a screenshot of the implemented Feed List Web Part that is connected to the RSS Viewer Web Part

In the F# implementation, probably the most notable change is implementation of AddLists member function in FeedListWebPart class as getSPLists in the example F# code. Instead of iterating through each SPList in the collection and using the if statement to determine whether we should add the SPList to the newly created collection, the F# version takes the entire list and pipleline it through a series of filter function to get the file list. F# helped me to think of operations at the granularity of the list level instead of at the items level. Here's the implementation in F#:


#light
namespace DemoWebParts

open System
open System.Collections.Generic
open System.ComponentModel
open System.Data
open System.IO
open System.Net
open System.Reflection
open System.Web
open System.Web.UI
open System.Web.UI.WebControls
open System.Web.UI.WebControls.WebParts
open System.Xml
open System.Xml.Xsl
open Microsoft.SharePoint.WebControls
open Microsoft.SharePoint
open Microsoft.SharePoint.Utilities

// This is a utility debugging tool that I've used to dump deugging info to a file.
// I can simple call it as Log.dump "Error messages"
module Log =

let dump (msg:string) =
using (File.AppendText(@"c:\logs\sharepoint.log"))
(fun writer -> writer.WriteLine(msg))

module SPCollectionUtility =
// This is what I would like to do but could not due to
// the design of SPBaseCollection
(*
let toSeq (splist: #SPBaseCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}
*)

let SPListToSeq (splist:SPListCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

let SPWebToSeq (splist:SPWebCollection) =
seq { for i in 0 .. (splist.Count-1) -> splist.get_Item(i)}

module WebPartResources =
let GetNamedResource (reference:obj) (filename:string) =
use stream = filename |> Assembly.GetExecutingAssembly().GetManifestResourceStream
use reader = new StreamReader(stream)
reader.ReadToEnd()

let GetNamedResourceStream (reference:obj) (filename:string) =
filename
|> Assembly.GetExecutingAssembly().GetManifestResourceStream

type RenderMode =
| Full
| Titles

module RenderModeUtility =

// Helper function for RenderMode
let label mode =
match mode with
| Full -> "Full"
| Titles -> "Titles"

let setmode label =
match label with
| "Full" -> Full
| "Titles" -> Titles
| _ -> failwith "value must be Full or Titles to be RenderMode"


type RssViewEditorPart() = class
inherit EditorPart()

let mutable (txtXmlUrl:TextBox) = null

let mutable (lstHeadlineMode:RadioButtonList) = null


do base.Title <- "RSS View Custom Editor"

override this.CreateChildControls() =
txtXmlUrl <- new TextBox(Width=new Unit("100%"),
TextMode=TextBoxMode.MultiLine,
Rows = 3)

// Add controls to the radio button list
lstHeadlineMode <- new RadioButtonList()
(RenderModeUtility.label RenderMode.Full) |> lstHeadlineMode.Items.Add
(RenderModeUtility.label RenderMode.Titles) |> lstHeadlineMode.Items.Add

new LiteralControl("Feed Url:<br/>") |> this.Controls.Add

txtXmlUrl |> this.Controls.Add
match this.WebPartManager.Personalization.Scope with
| PersonalizationScope.User -> txtXmlUrl |> this.Controls.Add
| _ -> ()

new LiteralControl("Headline Mode:<br/>") |> this.Controls.Add
lstHeadlineMode |> this.Controls.Add


override this.SyncChanges() =
this.EnsureChildControls()
let targetPart = this.WebPartToEdit :?> RssViewWebPart
let SelectedMode = targetPart.HeadlineMode
let item = lstHeadlineMode.Items.FindByText(SelectedMode)
item.Selected <- true
txtXmlUrl.Text <- targetPart.XmlUrl

override this.ApplyChanges() =
this.EnsureChildControls()
let targetPart = this.WebPartToEdit :?> RssViewWebPart
targetPart.XmlUrl <- txtXmlUrl.Text
targetPart.HeadlineMode <- lstHeadlineMode.SelectedValue
true

end
and RssViewWebPart() = class
inherit WebPart()

let mutable (xmlUrl:string) = null
let mutable headlineMode = RenderMode.Full
let mutable (exceptionDetail:string) = null
let mutable (xmlstream:Stream) = null

(*
// Did not need to implement this...
interface IWebEditable with
member this.WebBrowsableObject
with get() = box this
override this.CreateEditorParts () =
let parts = new List<EditorPart>(1);
parts.Add(new RssViewEditorPart(ID=(this.ID+"_rssViewEditor")))
new EditorPartCollection(base.CreateEditorParts(),parts)
*)


override this.CreateEditorParts () =
let parts = new List<EditorPart>(1);
let part =new RssViewEditorPart(ID=(this.ID+"_rssViewEditor"))
parts.Add(part)
new EditorPartCollection(base.CreateEditorParts(),parts)

member this.Redirect () =
this.Context.Response.Redirect(this.XmlUrl)

[<Personalizable(PersonalizationScope.Shared);WebBrowsable(false)>]
member this.XmlUrl
with get() = xmlUrl
and set value = xmlUrl <- value

[<Personalizable(PersonalizationScope.User);WebBrowsable(false)>]
member this.HeadlineMode
with get() = RenderModeUtility.label headlineMode
and set value = headlineMode <- (RenderModeUtility.setmode value)

override this.Verbs
with get() =
let verbs = new List<WebPartVerb>()
verbs.Add(new WebPartVerb(this.ID + "_ClientSideRssOpenerVerb",
sprintf "window.open('%s','RSSXML')" this.XmlUrl,
Text = "Open RSS Feed"))
verbs.Add(
let handler = new WebPartEventHandler(fun _ _ ->
match String.IsNullOrEmpty(this.XmlUrl) with
| false -> this.Redirect()
| true -> ())

new WebPartVerb(this.ID + "_ServerSideRssOpenerVerb",
handler,
Text = "View RSS Source Feed 3.0"))


new WebPartVerbCollection(base.Verbs, verbs )


override this.OnInit (e:EventArgs) =
base.OnInit(e)

this.HelpUrl <-
(this.GetType(), "help.html")
|> this.Page.ClientScript.GetWebResourceUrl

this.HelpMode <- WebPartHelpMode.Modeless

override this.OnPreRender (e:EventArgs) =
base.OnPreRender(e)

if (String.IsNullOrEmpty(this.XmlUrl)) then ()
elif this.WebPartManager.DisplayMode.AllowPageDesign then
new LiteralControl("No display while in design mode.")
|> this.Controls.Add
else
try
let req = new Uri(this.XmlUrl) |> WebRequest.CreateDefault
req.Credentials <- CredentialCache.DefaultCredentials
req.Timeout <- 10000 // 10 seconds

let beginHandler = new BeginEventHandler(fun _ _ callback state ->
req.BeginGetResponse(callback,state))

let successHandler = new EndEventHandler(fun result ->
try
xmlstream <- req.EndGetResponse(result).GetResponseStream()
with wex ->
exceptionDetail <- wex.Message)

let errorHandler = new EndEventHandler(fun _ ->
let errmsg = sprintf "The request timed out while waiting for %s" this.XmlUrl
new Label(Text=errmsg) |> this.Controls.Add)

new PageAsyncTask(beginHandler,successHandler,errorHandler,null,true)
|> this.Page.RegisterAsyncTask

with :? System.Security.SecurityException ->
let errmsg = "Permission denied - please set trust level to WSS_Medium."
new LiteralControl(errmsg)
|> this.Controls.Add


override this.RenderContents (writer:HtmlTextWriter) =
base.RenderContents(writer)

if exceptionDetail <> null then
writer.Write(exceptionDetail)
elif (String.IsNullOrEmpty(this.XmlUrl) || xmlstream = null) then ()
else
let transformer = new XslCompiledTransform()
let xslt = match headlineMode with
| Full -> "RSS.xslt"
| Titles -> "RssTitles.xslt"
use res = WebPartResources.GetNamedResourceStream this xslt
new XmlTextReader(res) |> transformer.Load

try
use input = new XmlTextReader(xmlstream)
use output = new XmlTextWriter(writer.InnerWriter)
(input,output) |> transformer.Transform
with e ->
writer.Write(e.Message)
if xmlstream <> null then
xmlstream.Close()
xmlstream.Dispose()


[<ConnectionConsumer("Xml URL Consumer",AllowsMultipleConnections=false)>]
member this.SetConnectionInterface (provider:IWebPartField) =
provider.GetFieldValue(new FieldCallback(fun providedUrl ->

if providedUrl = null then ()
else
let urls = (providedUrl :?> String).Split([|','|])
this.XmlUrl <- urls |> Array.to_list |> List.hd))

end


type FeedListWebPart() = class
inherit WebPart()

let mutable xmlurl = ""

let spfilters = [SPListTemplateType.Categories;
SPListTemplateType.MasterPageCatalog;
SPListTemplateType.WebPageLibrary;
SPListTemplateType.WebPartCatalog;
SPListTemplateType.WebTemplateCatalog;
SPListTemplateType.UserInformation;
SPListTemplateType.ListTemplateCatalog;]


let rec getSPLists (web:SPWeb) =
Seq.append
// e.g. foreach (SPList list in web.Lists)
//(new SPListCollectionAdapter(web.Lists)
(SPCollectionUtility.SPListToSeq web.Lists
|> Seq.filter (fun x -> x.AllowRssFeeds)
|> Seq.filter (fun x -> x.EnableSyndication)
|> Seq.filter (fun x -> List.map ((<>) x.BaseTemplate) spfilters
|> List.fold_left (&&) true)
|> Seq.filter (fun x ->
x.DoesUserHavePermissions(SPBasePermissions.ViewListItems)))


// e.g. foreach (SPWeb subweb in web.Webs)
//(new SPWebCollectionAdapter(web.Webs)
(SPCollectionUtility.SPWebToSeq web.Webs
|> Seq.filter (fun w ->
w.DoesUserHavePermissions(SPBasePermissions.ViewListItems))
|> Seq.map getSPLists |> Seq.concat)


override this.CreateChildControls() =
base.CreateChildControls()

let list = SPContext.Current.Web |> getSPLists

let view = new SPGridView(AutoGenerateColumns=false)
this.Controls.Add(
["Title";"ItemCount"]
|> List.iter (fun x ->
new BoundField(DataField=x,HeaderText=x)
|> view.Columns.Add)

view.Columns.Add(
let button = new CommandField(HeaderText="Action",
SelectText="Show RSS",
ShowSelectButton=true)
button.ControlStyle.Width <- new Unit(75.0)
button)

view.SelectedIndexChanged.Add(fun x ->
xmlurl <- view.SelectedValue.ToString())
view
)

if this.Page.IsPostBack = false then
let table = new DataTable()
["Title";"ItemCount";"XmlUrl";"ID"]
|> List.iter (fun x -> table.Columns.Add(x) |> ignore)

// Need to build DataRows & DataTable...
let buildrow (list:SPList) =
let row = table.NewRow()
row.["Title"] <- list.Title
row.["ItemCount"] <- list.ItemCount.ToString()
row.["ID"] <- list.ID
let url = sprintf "%s/_layouts/listfeed.aspx?List=%s" list.ParentWebUrl (list.ID.ToString())
row.["XmlUrl"] <-
this.Page.Request.Url.GetLeftPart(UriPartial.Authority) +
SPUtility.MapWebURLToVirtualServerURL(list.ParentWeb,url)
table.Rows.Add(row)

Seq.iter buildrow list
view.DataKeyNames <- [|"XmlUrl"|]
view.DataSource <- table
view.DataBind()


[<WebBrowsable(true);
Category("Configuration");
Personalizable(PersonalizationScope.User);
DefaultValue("");
WebDisplayName("Xml Url");
WebDescription("F# RSS Feed XML URL")>]
member this.XmlUrl
with get() = xmlurl
and set value =
if String.IsNullOrEmpty(xmlurl) then
let uri = new Uri(value)
xmlurl <- uri.AbsolutePath
else
xmlurl <- null

interface IWebPartField with
member this.Schema
with get() =
TypeDescriptor.GetProperties(this).Find("XmlUrl",false)

member this.GetFieldValue (callback:FieldCallback) =
(this :> IWebPartField).Schema.GetValue(this)
|> callback.Invoke


[<ConnectionProvider("XmlUrl Provider")>]
member this.GetConnectionInterface() = this :> IWebPartField

end

[<Assembly: System.Reflection.AssemblyVersion("1.0.0.0")>]
[<Assembly: System.Security.AllowPartiallyTrustedCallersAttribute>]
do()