1 #Region "Microsoft.VisualBasic::3baee56c270480ef562d622d3cba3b96, Microsoft.VisualBasic.Core\ComponentModel\Settings\SimpleConfig.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     '     Class SimpleConfig
35     
36     '         Properties: Name, TypeInfo
37     
38     '         Constructor: (+1 OverloadsSub New
39     '         Function: GenerateConfigurations, ToString, TryParse
40     
41     
42     ' /********************************************************************************/
43
44 #End Region
45
46 Imports System.Reflection
47 Imports System.Runtime.CompilerServices
48 Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel.DataFramework
49 Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel.SchemaMaps
50 Imports Microsoft.VisualBasic.Language
51 Imports typeSchema = System.Reflection.TypeInfo
52
53 Namespace ComponentModel.Settings
54
55 #If NET_40 = 0 Then
56
57     <AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=True)>
58     Public Class SimpleConfig : Inherits Attribute
59         Dim _ToLower As Boolean
60
61         Public Shared ReadOnly Property TypeInfo As Type = GetType(SimpleConfig)
62         Public ReadOnly Property Name As String
63
64         <MethodImpl(MethodImplOptions.AggressiveInlining)>
65         Sub New(Optional Name As String = ""Optional toLower As Boolean = True)
66             Me._Name = Name
67             Me._ToLower = toLower
68         End Sub
69
70         ''' <summary>
71         ''' Display <see cref="Name"/>
72         ''' </summary>
73         ''' <returns></returns>
74         Public Overrides Function ToString() As String
75             Return Name
76         End Function
77
78         ''' <summary>
79         '''
80         ''' </summary>
81         ''' <typeparam name="T"></typeparam>
82         ''' <typeparam name="TConfig"></typeparam>
83         ''' <param name="canRead">向文件之中写数据的时候,需要设置为真</param>
84         ''' <param name="canWrite">从文件之中读取数据的时候,需要设置为真</param>
85         ''' <returns></returns>
86         ''' <remarks></remarks>
87         Public Shared Function TryParse(Of T As Class,
88                                            TConfig As SimpleConfig)(
89                                            canRead As Boolean,
90                                            canWrite As BooleanAs BindProperty(Of TConfig)()
91
92             Dim type As typeSchema = GetType(T), configType As Type = GetType(TConfig)
93             Dim properties = type.GetProperties(BindingFlags.Instance Or BindingFlags.Public)
94             Dim LQuery = LinqAPI.Exec(Of BindProperty(Of TConfig)) _
95  _
96                 () <= From [property] As PropertyInfo
97                       In properties
98                       Let attrs As Object() = [property].GetCustomAttributes(
99                           attributeType:=configType,
100                           inherit:=True)
101                       Let info As Type = [property].PropertyType
102                       Where Not attrs.IsNullOrEmpty AndAlso StringParsers.ContainsKey(info)
103                       Let attr = DirectCast(attrs.First, TConfig)
104                       Select New BindProperty(Of TConfig)(attr, [property])
105
106             If LQuery.IsNullOrEmpty Then
107                 Return Nothing
108             End If
109
110             Dim Schema As New List(Of BindProperty(Of TConfig))
111
112             For Each line As BindProperty(Of TConfig) In LQuery
113                 Dim [property] As PropertyInfo = DirectCast(line.member, PropertyInfo)
114
115                 If [property].CanRead AndAlso [property].CanWrite Then  '同时满足可读和可写的属性直接添加
116                     GoTo INSERT
117                 End If
118
119                 '从这里开始的属性都是只读属性或者只写属性
120                 If canRead = True Then
121                     If [property].CanRead = False Then
122                         Continue For
123                     End If
124                 End If
125                 If canWrite = True Then
126                     If [property].CanWrite = False Then
127                         Continue For
128                     End If
129                 End If
130 INSERT:
131                 If String.IsNullOrEmpty(line.field._Name) Then
132                     line.field._Name =
133                         If(line.field._ToLower,
134                         line.Identity.ToLower,
135                         line.Identity)
136                 End If
137
138                 ' 这里为什么会出现重复的键名???
139                 Schema += New BindProperty(Of TConfig)(line.field, [property])
140             Next
141
142             Return Schema.ToArray
143         End Function
144
145         ''' <summary>
146         ''' 从类型实体生成配置文件数据
147         ''' </summary>
148         ''' <typeparam name="T"></typeparam>
149         ''' <param name="target"></param>
150         ''' <returns></returns>
151         ''' <remarks>类型实体之中的简单属性,只要具备可读属性即可被解析出来</remarks>
152         Public Shared Function GenerateConfigurations(Of T As Class)(target As T) As String()
153             Dim type As Type = GetType(T)
154             Dim Schema = TryParse(Of T, SimpleConfig)(canRead:=True, canWrite:=False)
155             Dim mlen As Integer = (From cfg As SimpleConfig In Schema.Select(Function(x) x.field) Select Len(cfg._Name)).Max
156             Dim bufs As New List(Of String)
157
158             For Each [property] As BindProperty(Of SimpleConfig) In Schema
159                 Dim blank As New String(" ", mlen - Len([property].field._Name) + 2)
160                 Dim Name As String = [property].field._Name & blank
161                 Dim value As String = Scripting.ToString([property].GetValue(target))
162
163                 bufs += $"{Name}= {value}"
164             Next
165
166             Return bufs.ToArray
167         End Function
168     End Class
169
170 #End If
171
172 End Namespace