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