1 #Region "Microsoft.VisualBasic::b1f8d9c11e83f2ea2824381d90ec2e60, Microsoft.VisualBasic.Core\Extensions\Doc\XmlExtensions.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     Module XmlExtensions
35     
36     '     Function: CodePage, CreateObjectFromXml, CreateObjectFromXmlFragment, (+2 OverloadsGetXml, GetXmlAttrValue
37     '               LoadFromXml, (+2 Overloads) LoadXml, SafeLoadXml, SaveAsXml, SetXmlEncoding
38     '               SetXmlStandalone
39     
40     '     Sub: WriteXML
41     
42     ' /********************************************************************************/
43
44 #End Region
45
46 Imports System.IO
47 Imports System.Reflection
48 Imports System.Runtime.CompilerServices
49 Imports System.Text
50 Imports System.Text.RegularExpressions
51 Imports System.Xml
52 Imports System.Xml.Serialization
53 Imports Microsoft.VisualBasic.CommandLine.Reflection
54 Imports Microsoft.VisualBasic.Language
55 Imports Microsoft.VisualBasic.Scripting.MetaData
56 Imports Microsoft.VisualBasic.Text
57 Imports Microsoft.VisualBasic.Text.Xml
58
59 <Package("Doc.Xml", Description:="Tools for read and write sbml, KEGG document, etc, xml based documents...")>
60 Public Module XmlExtensions
61
62     ''' <summary>
63     ''' 这个函数主要是用作于Linq里面的Select语句拓展的,这个函数永远也不会报错,只会返回空值
64     ''' </summary>
65     ''' <typeparam name="T"></typeparam>
66     ''' <returns></returns>
67     Public Function SafeLoadXml(Of T)(xml As String,
68                                       Optional encoding As Encodings = Encodings.Default,
69                                       Optional preProcess As Func(Of StringString) = NothingAs T
70         Return xml.LoadXml(Of T)(encoding.CodePage, False, preProcess)
71     End Function
72
73     ''' <summary>
74     ''' Load class object from the exists Xml document.(从文件之中加载XML之中的数据至一个对象类型之中)
75     ''' </summary>
76     ''' <typeparam name="T"></typeparam>
77     ''' <param name="XmlFile">The path of the xml document.(XML文件的文件路径)</param>
78     ''' <param name="throwEx">
79     ''' If the deserialization operation have throw a exception, then this function should process this error automatically or just throw it?
80     ''' (当反序列化出错的时候是否抛出错误?假若不抛出错误,则会返回空值)
81     ''' </param>
82     ''' <param name="preprocess">
83     ''' The preprocessing on the xml document text, you can doing the text replacement or some trim operation from here.(Xml文件的预处理操作)
84     ''' </param>
85     ''' <param name="encoding">Default is <see cref="UTF8"/> text encoding.</param>
86     ''' <returns></returns>
87     ''' <remarks></remarks>
88     <Extension> Public Function LoadXml(Of T)(XmlFile As String,
89                                               Optional encoding As Encoding = Nothing,
90                                               Optional throwEx As Boolean = True,
91                                               Optional preprocess As Func(Of StringString) = Nothing,
92                                               Optional stripInvalidsCharacter As Boolean = FalseAs T
93         Dim type As Type = GetType(T)
94         Dim obj As Object = XmlFile.LoadXml(
95             type, encoding, throwEx,
96             preprocess,
97             stripInvalidsCharacter:=stripInvalidsCharacter)
98
99         If obj Is Nothing Then
100             Return Nothing  ' 由于在底层函数之中已经将错误给处理掉了,所以这里直接返回
101         Else
102             Return DirectCast(obj, T)
103         End If
104     End Function
105
106
107     ''' <summary>
108     ''' 从文件之中加载XML之中的数据至一个对象类型之中
109     ''' </summary>
110     ''' <param name="XmlFile">XML文件的文件路径</param>
111     ''' <param name="ThrowEx">当反序列化出错的时候是否抛出错误?假若不抛出错误,则会返回空值</param>
112     ''' <param name="preprocess">Xml文件的预处理操作</param>
113     ''' <returns></returns>
114     ''' <remarks></remarks>
115     ''' <param name="encoding">Default is <see cref="UTF8"/> text encoding.</param>
116     <ExportAPI("LoadXml")>
117     <Extension> Public Function LoadXml(XmlFile As String, type As Type,
118                                         Optional encoding As Encoding = Nothing,
119                                         Optional ThrowEx As Boolean = True,
120                                         Optional preprocess As Func(Of StringString) = Nothing,
121                                         Optional stripInvalidsCharacter As Boolean = FalseAs Object
122
123         If Not XmlFile.FileExists(ZERO_Nonexists:=True) Then
124             Dim exMsg$ = $"{XmlFile.ToFileURL} is not exists on your file system or it is ZERO length content!"
125
126             With New Exception(exMsg)
127                 Call App.LogException(.ByRef)
128
129                 If ThrowEx Then
130                     Throw .ByRef
131                 Else
132                     Return Nothing
133                 End If
134             End With
135         End If
136
137         Dim XmlDoc$ = File.ReadAllText(XmlFile, encoding Or UTF8)
138
139         If Not preprocess Is Nothing Then
140             XmlDoc = preprocess(XmlDoc)
141         End If
142         If stripInvalidsCharacter Then
143             XmlDoc = XmlDoc.StripInvalidCharacters
144         End If
145
146         Using stream As New StringReader(s:=XmlDoc)
147             Try
148                 Dim obj = New XmlSerializer(type).Deserialize(stream)
149                 Return obj
150             Catch ex As Exception
151                 ex = New Exception(type.FullName, ex)
152                 ex = New Exception(XmlFile.ToFileURL, ex)
153
154                 Call App.LogException(ex, MethodBase.GetCurrentMethod.GetFullName)
155 #If DEBUG Then
156                 Call ex.PrintException
157 #End If
158                 If ThrowEx Then
159                     Throw ex
160                 Else
161                     Return Nothing
162                 End If
163             End Try
164         End Using
165     End Function
166
167     ''' <summary>
168     ''' Serialization the target object type into a XML document.(将一个类对象序列化为XML文档)
169     ''' </summary>
170     ''' <typeparam name="T">
171     ''' The type of the target object data should be a class object.(目标对象类型必须为一个Class)
172     ''' </typeparam>
173     ''' <param name="obj"></param>
174     ''' <returns></returns>
175     ''' <remarks></remarks>
176     ''' 
177     <MethodImpl(MethodImplOptions.AggressiveInlining)>
178     <Extension> Public Function GetXml(Of T)(
179                                     obj As T,
180                        Optional ThrowEx As Boolean = True,
181                        Optional xmlEncoding As XmlEncodings = XmlEncodings.UTF16) As String
182
183         Return GetXml(obj, GetType(T), ThrowEx, xmlEncoding)
184     End Function
185
186     Public Function GetXml(
187                         obj As Object,
188                        type As Type,
189            Optional throwEx As Boolean = True,
190            Optional xmlEncoding As XmlEncodings = XmlEncodings.UTF16) As String
191
192         Try
193
194             If xmlEncoding = XmlEncodings.UTF8 Then
195                 ' create a MemoryStream here, we are just working
196                 ' exclusively in memory
197                 Dim stream As New MemoryStream()
198
199                 Call WriteXML(obj, type, stream, xmlEncoding)
200
201                 ' read back the contents of the stream And supply the encoding
202                 Dim result As String = Encoding.UTF8.GetString(stream.ToArray())
203                 Return result
204             Else
205                 Dim sBuilder As New StringBuilder(1024)
206                 Using StreamWriter As New StringWriter(sb:=sBuilder)
207                     Call (New XmlSerializer(type)).Serialize(StreamWriter, obj)
208                     Return sBuilder.ToString
209                 End Using
210             End If
211
212         Catch ex As Exception
213             ex = New Exception(type.ToString, ex)
214             Call App.LogException(ex)
215
216 #If DEBUG Then
217             Call ex.PrintException
218 #End If
219
220             If throwEx Then
221                 Throw ex
222             Else
223                 Return Nothing
224             End If
225         End Try
226     End Function
227
228     <MethodImpl(MethodImplOptions.AggressiveInlining)>
229     <Extension> Public Function CodePage(XmlEncoding As XmlEncodings) As Encoding
230         Select Case XmlEncoding
231             Case XmlEncodings.GB2312
232                 Return Encodings.GB2312.CodePage
233             Case XmlEncodings.UTF8
234                 Return UTF8WithoutBOM
235             Case Else
236                 Return Encodings.UTF16.CodePage
237         End Select
238     End Function
239
240     ''' <summary>
241     ''' 写入的文本文件的编码格式和XML的编码格式应该是一致的
242     ''' </summary>
243     ''' <param name="obj"></param>
244     ''' <param name="type"></param>
245     ''' <param name="out"></param>
246     ''' <param name="encoding"></param>
247     Public Sub WriteXML(obj As Object, type As Type, ByRef out As Stream, encoding As XmlEncodings)
248         Dim serializer As New XmlSerializer(type)
249         ' The XmlTextWriter takes a stream And encoding
250         ' as one of its constructors
251         Dim xtWriter As New XmlTextWriter(out, encoding.CodePage)
252
253         Call serializer.Serialize(xtWriter, obj)
254         Call xtWriter.Flush()
255     End Sub
256
257     ''' <summary>
258     ''' Save the object as the XML document.
259     ''' </summary>
260     ''' <typeparam name="T"></typeparam>
261     ''' <param name="obj"></param>
262     ''' <param name="saveXml"></param>
263     ''' <param name="throwEx"></param>
264     ''' <param name="encoding">VB.NET的XML文件的默认编码格式为``utf-16``</param>
265     ''' <returns></returns>
266     <Extension> Public Function SaveAsXml(Of T As Class)(
267                                     obj As T,
268                                 saveXml As String,
269                        Optional throwEx As Boolean = True,
270                        Optional encoding As Encodings = Encodings.UTF16,
271     <CallerMemberName> Optional caller As String = ""As Boolean
272         Try
273             Return obj _
274                 .GetXml(ThrowEx:=throwEx, xmlEncoding:=encoding) _
275                 .SaveTo(saveXml, encoding.CodePage, throwEx:=throwEx)
276         Catch ex As Exception
277             ex = New Exception(caller, ex)
278
279             If throwEx Then
280                 Throw ex
281             Else
282                 Call App.LogException(ex)
283                 Call ex.PrintException
284                 Return False
285             End If
286         End Try
287     End Function
288
289     <ExportAPI("Xml.GetAttribute")>
290     <Extension> Public Function GetXmlAttrValue(str As String, Name As StringAs String
291         Dim m As Match = Regex.Match(str, Name & "=(("".+?"")|[^ ]*)")
292
293         If Not m.Success Then
294             Return ""
295         Else
296             str = m.Value.Replace(Name & "=""")
297         End If
298
299         If str.First = """"AndAlso str.Last = """"Then
300             str = Mid(str, 2, Len(str) - 2)
301         End If
302
303         Return str
304     End Function
305
306     ''' <summary>
307     ''' Generate a specific type object from a xml document stream.(使用一个XML文本内容创建一个XML映射对象)
308     ''' </summary>
309     ''' <typeparam name="T"></typeparam>
310     ''' <param name="Xml">This parameter value is the document text of the xml file, not the file path of the xml file.(是Xml文件的文件内容而非文件路径)</param>
311     ''' <param name="throwEx">Should this program throw the exception when the xml deserialization error happens?
312     ''' if False then this function will returns a null value instead of throw exception.
313     ''' (在进行Xml反序列化的时候是否抛出错误,默认抛出错误,否则返回一个空对象)</param>
314     ''' <returns></returns>
315     ''' <remarks></remarks>
316     <Extension> Public Function LoadFromXml(Of T)(Xml As StringOptional throwEx As Boolean = TrueAs T
317         Using Stream As New StringReader(s:=Xml)
318             Try
319                 Dim type As Type = GetType(T)
320                 Dim o As Object = New XmlSerializer(type).Deserialize(Stream)
321                 Return DirectCast(o, T)
322             Catch ex As Exception
323                 Dim curMethod As String = MethodBase.GetCurrentMethod.GetFullName
324
325                 If Len(Xml) <= 4096 * 100 Then
326                     ex = New Exception(Xml, ex)
327                 End If
328
329                 App.LogException(ex, curMethod)
330
331                 If throwEx Then
332                     Throw ex
333                 Else
334                     Return Nothing
335                 End If
336             End Try
337         End Using
338     End Function
339
340     <ExportAPI("Xml.CreateObject")>
341     <Extension> Public Function CreateObjectFromXml(Xml As StringBuilder, typeInfo As Type) As Object
342         Dim doc As String = Xml.ToString
343
344         Using Stream As New StringReader(doc)
345             Try
346                 Dim obj As Object = New XmlSerializer(typeInfo).Deserialize(Stream)
347                 Return obj
348             Catch ex As Exception
349                 ex = New Exception(doc, ex)
350                 ex = New Exception(typeInfo.FullName, ex)
351
352                 Call App.LogException(ex)
353
354                 Throw ex
355             End Try
356         End Using
357     End Function
358
359     ''' <summary>
360     ''' 使用一个XML文本内容的一个片段创建一个XML映射对象
361     ''' </summary>
362     ''' <typeparam name="T"></typeparam>
363     ''' <param name="Xml">是Xml文件的文件内容而非文件路径</param>
364     ''' <returns></returns>
365     ''' <remarks></remarks>
366     ''' 
367     <MethodImpl(MethodImplOptions.AggressiveInlining)>
368     <Extension> Public Function CreateObjectFromXmlFragment(Of T)(Xml$, Optional preprocess As Func(Of StringString) = NothingAs T
369         Dim xmlDoc$ =
370             "<?xml version=""1.0"" encoding=""UTF-8""?>" &
371             ASCII.LF &
372             Xml
373
374         If Not preprocess Is Nothing Then
375             xmlDoc = preprocess(xmlDoc)
376         End If
377
378         Try
379             Using s As New StringReader(s:=xmlDoc)
380                 Return DirectCast(New XmlSerializer(GetType(T)).Deserialize(s), T)
381             End Using
382         Catch ex As Exception
383             Dim root$ = Xml.GetBetween("<"">").Split.First
384             Dim file$ = App.LogErrDIR & "/" & $"{root}-{Path.GetTempFileName.BaseName}.Xml"
385
386             Call xmlDoc.SaveTo(file)
387
388             Throw New Exception("Details at file dump: " & file, ex)
389         End Try
390     End Function
391
392     <Extension>
393     Public Function SetXmlEncoding(xml As String, encoding As XmlEncodings) As String
394         Dim xmlEncoding As String = Text.Xml.XmlDeclaration.XmlEncodingString(encoding)
395         Dim head As String = Regex.Match(xml, XmlDoc.XmlDeclares, RegexICSng).Value
396         Dim enc As String = Regex.Match(head, "encoding=""\S+""", RegexICSng).Value
397
398         If String.IsNullOrEmpty(enc) Then
399             enc = head.Replace("?>", $" encoding=""{xmlEncoding}""?>")
400         Else
401             enc = head.Replace(enc, $"encoding=""{xmlEncoding}""")
402         End If
403
404         xml = xml.Replace(head, enc)
405
406         Return xml
407     End Function
408
409     <Extension>
410     Public Function SetXmlStandalone(xml As String, standalone As BooleanAs String
411         Dim opt As String = Text.Xml.XmlDeclaration.XmlStandaloneString(standalone)
412         Dim head As String = Regex.Match(xml, XmlDoc.XmlDeclares, RegexICSng).Value
413         Dim enc As String = Regex.Match(head, "standalone=""\S+""", RegexICSng).Value
414
415         If String.IsNullOrEmpty(enc) Then
416             enc = head.Replace("?>", $" standalone=""{opt}""?>")
417         Else
418             enc = head.Replace(enc, $"standalone=""{opt}""")
419         End If
420
421         xml = xml.Replace(head, enc)
422
423         Return xml
424     End Function
425 End Module