1 #Region "Microsoft.VisualBasic::5a7f6e6c12029e7e628810bd183163fe, Microsoft.VisualBasic.Core\ApplicationServices\Utils.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 Utils
35     
36     '         FunctionFormatTicks, TaskRun, (+2 Overloads) Time
37     
38     '         SubTryRun
39     '         Delegate Function
40     
41     '             Function: CLIPath, CLIToken, FileMimeType, GetMIMEDescrib
42     
43     '             Sub: (+2 Overloads) Wait
44     
45     
46     
47     ' /********************************************************************************/
48
49 #End Region
50
51 Imports System.Runtime.CompilerServices
52 Imports System.Threading
53 Imports Microsoft.VisualBasic.CommandLine.Reflection
54 Imports Microsoft.VisualBasic.Net.Protocols.ContentTypes
55 Imports Microsoft.VisualBasic.Parallel.Tasks
56
57 Namespace ApplicationServices
58
59     ''' <summary>
60     ''' App utils
61     ''' </summary>
62     Public Module Utils
63
64         ''' <summary>
65         ''' Call target <see cref="Action"/> delegate, if exception occurs in the action, 
66         ''' then this function will logs the exception and exit without thorw an exception. 
67         ''' </summary>
68         ''' <param name="task"></param>
69         ''' <param name="stack$"></param>
70         <Extension>
71         Public Sub TryRun(task As Action, <CallerMemberName> Optional stack$ = Nothing)
72             Try
73                 Call task()
74             Catch ex As Exception
75                 Call $"[{stack}] {task.Method.ToString} failure!".Warning
76                 Call App.LogException(ex)
77             End Try
78         End Sub
79
80         ''' <summary>
81         ''' Run background task, if the <see cref="AsyncHandle(Of Exception).GetValue()"/> returns nothing, 
82         ''' then means the task run no errors.
83         ''' </summary>
84         ''' <param name="task"></param>
85         ''' <param name="stack">进行调用堆栈的上一层的栈名称</param>
86         ''' <returns></returns>
87         <Extension> Public Function TaskRun(task As Action, <CallerMemberName> Optional stack$ = NothingAs AsyncHandle(Of Exception)
88             Dim handle = Function() As Exception
89                              Try
90                                  Call task()
91                              Catch ex As Exception
92                                  Return New Exception(stack, ex)
93                              End Try
94
95                              Return Nothing
96                          End Function
97             Return New AsyncHandle(Of Exception)(handle).Run
98         End Function
99
100         ''' <summary>
101         ''' Returns the total executation time of the target <paramref name="work"/>.
102         ''' (性能测试工具,函数之中会自动输出整个任务所经历的处理时长)
103         ''' </summary>
104         ''' <param name="work">
105         ''' Function pointer of the task work that needs to be tested.(需要测试性能的工作对象)
106         ''' </param>
107         ''' <returns>Returns the total executation time of the target <paramref name="work"/>. ms</returns>
108         Public Function Time(work As Action) As Long
109             Dim startTick As Long = App.NanoTime
110
111             ' -------- start worker ---------
112             Call work()
113             ' --------- end worker ---------
114
115             Dim endTick As Long = App.NanoTime
116             Dim t& = (endTick - startTick) / TimeSpan.TicksPerMillisecond
117             Return t
118         End Function
119
120         Public Function Time(Of T)(work As Func(Of T), Optional ByRef ms& = 0, Optional tick As Boolean = TrueOptional trace$ = NothingAs T
121             Dim tickTask As AsyncHandle(Of Exception)
122
123             If tick Then
124                 tickTask = Utils.TaskRun(
125                     Sub()
126                         Do While tick
127                             Call Console.Write(".")
128                             Call Thread.Sleep(1000)
129                         Loop
130                     End Sub)
131             End If
132
133             Dim value As T
134             Dim task As Action = Sub() value = work()
135
136             task.BENCHMARK(trace)
137             tick = False  ' 需要使用这个变量的变化来控制 tickTask 里面的过程
138
139             Return value
140         End Function
141
142         ''' <summary>
143         ''' Format ``ms`` for content print.
144         ''' </summary>
145         ''' <param name="ms"></param>
146         ''' <returns></returns>
147         <Extension> Public Function FormatTicks(ms&) As String
148             If ms > 1000 Then
149                 Dim s = ms / 1000
150
151                 If s < 1000 Then
152                     Return s & "s"
153                 Else
154                     Dim min = s \ 60
155                     Return $"{min}min{s Mod 60}s"
156                 End If
157             Else
158                 Return ms & "ms"
159             End If
160         End Function
161
162         Public Delegate Function WaitHandle() As Boolean
163
164         ''' <summary>
165         ''' 假若条件判断<paramref name="handle"/>不为真的话,函数会一直阻塞线程,直到条件判断<paramref name="handle"/>为真
166         ''' </summary>
167         ''' <param name="handle"></param>
168         <Extension> Public Sub Wait(handle As Func(Of Boolean))
169             If handle Is Nothing Then
170                 Return
171             End If
172
173             Do While handle() = False
174                 Call Thread.Sleep(10)
175                 Call Application.DoEvents()
176             Loop
177         End Sub
178
179         ''' <summary>
180         ''' 假若条件判断<paramref name="handle"/>不为真的话,函数会一直阻塞线程,直到条件判断<paramref name="handle"/>为真
181         ''' </summary>
182         ''' <param name="handle"></param>
183         <Extension> Public Sub Wait(handle As WaitHandle)
184             If handle Is Nothing Then
185                 Return
186             End If
187
188             Do While handle() = False
189                 Call Thread.Sleep(10)
190                 Call Application.DoEvents()
191             Loop
192         End Sub
193
194         ''' <summary>
195         ''' If the path string value is already wrappered by quot, then this function will returns the original string (DO_NOTHING).
196         ''' (假若命令行之中的文件名参数之中含有空格的话,则可能会造成错误,需要添加一个双引号来消除歧义)
197         ''' </summary>
198         ''' <param name="path"></param>
199         ''' <returns></returns>
200         '''
201         <ExportAPI("CLI_PATH")>
202         <Extension> Public Function CLIPath(path As StringAs String
203             If String.IsNullOrEmpty(path) Then
204                 Return ""
205             Else
206                 path = path.Replace("\""/")  '这个是R、Java、Perl等程序对路径的要求所导致的
207                 Return path.CLIToken
208             End If
209         End Function
210
211         ''' <summary>
212         ''' <see cref="CLIPath(String)"/>函数为了保持对Linux系统的兼容性会自动替换\为/符号,这个函数则不会执行这个替换
213         ''' </summary>
214         ''' <param name="token"></param>
215         ''' <returns></returns>
216         <Extension> Public Function CLIToken(token As StringAs String
217             If String.IsNullOrEmpty(token) OrElse Not Len(token) > 2 Then
218                 Return token
219             End If
220
221             If token.First = """"AndAlso token.Last = """"Then
222                 Return token
223             End If
224             If token.Contains(" "c) Then
225                 token = $"""{token}"""
226             End If
227
228             Return token
229         End Function
230
231         ''' <summary>
232         ''' ``*.txt -> text``,这个函数是作用于文件的拓展名之上的
233         ''' </summary>
234         ''' <param name="ext$"></param>
235         ''' <returns></returns>
236         <Extension> Public Function GetMIMEDescrib(ext$) As ContentType
237             Dim key$ = LCase(ext).Trim("*"c)
238
239             If MIME.SuffixTable.ContainsKey(key) Then
240                 Return MIME.SuffixTable(key)
241             Else
242                 Return MIME.UnknownType
243             End If
244         End Function
245
246         ''' <summary>
247         ''' 与<see cref="GetMIMEDescrib(String)"/>所不同的是,这个函数是直接作用于文件路径之上的。
248         ''' </summary>
249         ''' <param name="path"></param>
250         ''' <returns></returns>
251         <MethodImpl(MethodImplOptions.AggressiveInlining)>
252         <Extension>
253         Public Function FileMimeType(path As StringAs ContentType
254             Return ("*." & path.ExtensionSuffix).GetMIMEDescrib
255         End Function
256     End Module
257 End Namespace