diff --git a/APLSource/APLTreeUtils-8f.script b/APLSource/APLTreeUtils-8f.script new file mode 100644 index 0000000..ea9e3a5 --- /dev/null +++ b/APLSource/APLTreeUtils-8f.script @@ -0,0 +1,434 @@ +:Namespace APLTreeUtils +⍝ *** Version 4.1.0 ⋄ 2017-05-10 *** +⍝ +⍝ ## Overview +⍝ Version 4.0.0 is a major change in two respects: +⍝ +⍝ ### Clean-up +⍝ Several functions that turned out to be very rarely used have been removed from `APLTreeUtils`. For a +⍝ full list see further down. Use `Fire` to change any calls to those functions. +⍝ +⍝ ### Use the new ⎕N\*-functions introduced in 15.0 +⍝ This was a necessary step in order to ensure platform compatability which was the main goal of +⍝ version 15.0 of Dyalog. It means that version 4.0.0 of APLTreeUtils is **not backwards-compatible**, +⍝ something that is normally avoided, but platform compatability is so important that we had to bite the bullet. +⍝ +⍝ ## Updating +⍝ Of course this means that you cannot just update, this time you have to check carefully to take action, +⍝ even if you use already 15.0.\\ +⍝ However, you can be sure that all members of the APLTree project themselves are ready for this.\\ +⍝ Note that `APLTreeUtils` does not work with the Classic edition - it requires Unicode. +⍝ +⍝ ## List of removed functions +⍝ Several functions have been removed from APLTreeUtils: +⍝ * `CreateUUID` +⍝ * `DropEmptyZerosAndBlanks` +⍝ * `Enlist` +⍝ * `First` +⍝ * `Mix` +⍝ * `ReadBytesAs8BitSignedIntegersFromFile` +⍝ * `WriteBytesAs8BitSignedIntegersToFile` +⍝ +⍝ ## Version History +⍝ * 4.1.0 +⍝ * Now managed by acre 3. +⍝ * 4.0.2 +⍝ * Documentation improved. +⍝ * 4.0.1 +⍝ * Bug fix: call to `GetOperatingSystem` was incorrectly addressing `APLTreeUtils` relatively. +⍝ * 4.0.0 +⍝ * Tidied up: several functions got removed +⍝ * This version uses 15.0-features. **It's not backwards-compatible!** +⍝ +⍝ Kai Jaeger - APL Team Ltd.\\ +⍝ Homepage: + + ∇ array←Uppercase array + ⍝ Fast uppercasing that excepts scalars, vectors and matrices as well as vectors and + ⍝ matrices of text vectors.\\ + ⍝ Note that `Uppercase` converts lower case chars well beyond the ANSII character set. + array←1(819⌶)array + ∇ + + ∇ array←Lowercase array + ⍝ Fast lowercasing that excepts scalars, vectors and matrices as well as vectors and + ⍝ matrices of text vectors.\\ + ⍝ Note that `Lowercase` converts upper case chars well beyond the ANSII character set. + array←0(819⌶)array + ∇ + + IsChar←{0 2∊⍨10|⎕dr ⍵} + + ∇ r←IsDevelopment;⎕IO;⎕ML + ⍝ Returns 1 in case the function is running under a Dyalog development (EXE or DLL). + ⎕ML←⎕IO←1 + r←'Development'≡4⊃'#'⎕WG'APLVersion' + r∨←'DLL'≡4⊃'#'⎕WG'APLVersion' ⍝ May be DLLRT instead! + ∇ + + ∇ r←IsUnicode + ⍝ Returns a 1 if running under Dyalog Unicode. + r←80=⎕DR' ' + ∇ + + SplitPath←{ + ⍝ `'C:\Buffer\' 'my.txt' ←→ SplitPath 'C:\Buffer\my.txt'` + ⍝ `(,¨'1.2.3.4.') (,'5') ←→ '.' SplitPath '1.2.3.4.5'` + ⎕ML←⎕IO←1 + ⍺←'/\' + l←1+-⌊/⍺⍳⍨⌽⍵ + (l↓⍵)(l↑⍵) + } + + Split←{ + ⍝ `'First' 'Second' ←→ Split 'First',(⎕UCS 13 10),'Second'` + ⍝ `(,¨'1' '2' '3') ←→ '.' Split '1.2.3'` + ⎕ML←⎕IO←1 + ⍺←⎕UCS 13 10 ⍝ Default is CR+LF + b←(1↑⍨⍴⍺),⍺⍷⍵ ⍝ This is more efficient in terms of memory then doing it one one line + (⍴,⍺)↓¨b⊂⍺,⍵ + } + + Nest←{ + ⍝ `0 1 1 2 3 ←→ ≡¨ '1' (,'1') (1 2)((1 2)(3 4))(1(2 3(4 5)))` + ⍝ `0 1 1 2 3 ←→ ≡¨ Nest '1' (,'1') (1 2)((1 2)(3 4))(1(2 3(4 5)))` + ⎕ML←⎕IO←1 + (⊂∘,⍣(0 1∊⍨≡⍵))⍵ + } + + Where←{⎕IO←(⎕IO⊃⎕RSI).⎕IO ⋄ ⍵/⍳⍴,⍵} ⍝ Return indices for Boolean ⍵; depends on ⎕IO in caller's space + + Last←{ + ⍝ `(,¨'3') ←→ Last '1.2.3'` + ⎕ML←⎕IO←1 + ⍺←'.' + (⍴,⍵)=where←¯1+⌊/⍺⍳⍨⌽,⍵:0⍴⍵ + 0 1∊⍨≡r←(-where)↑⍵:r + ''⍴r + } + + dmb←{ + ⍝ Delete leading, trailing and multiple blanks. Accepts scalar, vector and matrix as argument. + ⍺←' ' + ⎕ML←⎕IO←1 + ~0 1∊⍨≡⍵:∇¨⍵ + 2=⍴⍴⍵:↑∇¨↓⍵ + (,⍺)≡,⍵:'' + w←1↓¯1↓⍺{⍵/⍨~(2⍴⍺)⍷⍵}⍺,⍵,⍺ + (0=⍴⍴⍵)∧1=⍴w:⍬⍴⍵ + w + } + + dlb←{ + ⍝ Delete leading blanks. Accepts scalar, vector and matrix as argument. + ⎕IO←1 ⋄ ⎕ML←1 + (2=|≡⍵):∇¨⍵ + (1=⍴⍴⍵):(+/∧\' '=⍵)↓⍵ ⍝ Vectors (main application) + (2=⍴⍴⍵):(+/∧\' '=⍵)⌽⍵ ⍝ Matrix + (0=⍴⍴⍵):(⎕IO+' '≡⍵)⊃⍵'' ⍝ Scalar + 'Invalid argument'⎕SIGNAL 11 + } + + dtb←{ + ⍝ Delete trailing blanks. Accepts scalar, vector and matrix as argument. + ⎕IO←1 ⋄ ⎕ML←1 + (2=|≡⍵):∇¨⍵ + (1=⍴⍴⍵):⌽{(+/∧\' '=⍵)↓⍵}⌽⍵ ⍝ Vectors (main application) + (2=⍴⍴⍵):(-+/∧⌿∧\' '=⌽⍵)↓[2]⍵ ⍝ Matrix + (0=⍴⍴⍵):(⎕IO+' '≡⍵)⊃⍵'' ⍝ Scalar + 'Invalid argument'⎕SIGNAL 11 + } + + ∇ r←{flat}ReadUtf8File fileIdentifier;filename;fno;noOfBytes;bytes;⎕IO;⎕ML;b;typeFlag + ⍝ By default `ReadUtf8File` returns one of: + ⍝ * A nested vector with each item carrying a record (line) in case any of the common + ⍝ "newline" definitions (⎕UCS 10 or ⎕UCS 13 ⎕UCS 13 10 depending on the platform) is + ⍝ found in the file. + ⍝ + ⍝ Note that the function first tries to find (⎕UCS 13 10) and when it can't ⎕UCS 10 + ⍝ and then, finally, ⎕UCS 13. + ⍝ * A simple character vector otherwise. + ⍝ If you want to get a simple stream in any case then specify 'flat' as left argument.\\ + ⍝ `fileIdentifier` can be one of: + ⍝ * A filename. Then the file is tied, read and untied. + ⍝ * A file tie number. In this case the file is just read, it remains tied. Use this + ⍝ to tie a file with certain rights **before** calling `ReadUtf8File`, for example 34 + ⍝ which requests read+write but grants just read to others. + ⎕IO←⎕ML←1 + r←'' + flat←{900⌶⍬:0 ⋄ 'flat'≡⍎⍵}'flat' + :If typeFlag←' '=1↑0⍴fileIdentifier + filename←fileIdentifier + (('\'=filename)/filename)←'/' + :Trap 19 22 + fno←(filename~'"')⎕NTIE 0 + :Else + ('Could not read file: ',filename)⎕SIGNAL ⎕EN + :EndTrap + :Else + fno←fileIdentifier + :EndIf + noOfBytes←⎕NSIZE fno + bytes←⎕NREAD fno 83,noOfBytes,0 + :If typeFlag + ⎕NUNTIE fno + :EndIf + bytes+←256×bytes<0 ⍝ Make sure it is unsigned + bytes↓⍨←3×239 187 191≡3⍴bytes ⍝ drop a potential UTF-8 marker + r←'UTF-8'⎕UCS bytes + :If ~flat + :If ∨/(⎕UCS 13 10)⍷r + r←Split r + :ElseIf ∨/r=⎕UCS 10 + r←(⎕UCS 10)Split r + :ElseIf ∨/r=⎕UCS 13 + r←(⎕UCS 13)Split r + :EndIf + :EndIf + ∇ + + ∇ {r}←{append}WriteUtf8File(fileIdentifier data);filename;fno;fullname;flag;⎕ML;⎕IO;i;max;size;simpleFlag;wasOpenFlag;newline + ⍝ Note that Dyalog 15.0 comes with the newly introduced system functions `⎕NPUT` + ⍝ and `⎕NGET`. They offer a powerful, flexible and platform-independent interface + ⍝ for reading and writing files.\\ + ⍝ However, `ReadUtf8File` and `WriteUtf8File` remain available in `APLTreeUtils` + ⍝ for two reasons: + ⍝ * Compatability + ⍝ * Dealing with slippery networks. `WriteUtf8File` does not give up easily! + ⍝ * `WriteUtf8File` allows you to append data **to the last record** rather than + ⍝ appending records if you wish so. + ⍝ + ⍝ This is not POSIC compatible yet most software packages (~70%) offer this + ⍝ feature, and there are applications for this. + ⍝ + ⍝ Writes UTF-8 "data" to "fileIdentifier" (**without** a BOM - UTF8 files do + ⍝ not have a BOM according to the spec!).\\ + ⍝ If the left argument equals the string "append" then "data" is appended to an + ⍝ already existing file. If there is no such file yet it is created no matter + ⍝ what the left argument is.\\ + ⍝ "fileIdentifer" can be one of: + ⍝ * A filename. In this case `WriteUtf8File` ties the file, writes + ⍝ it and then unties it. + ⍝ * A tie number. In this case the data is just written to the file. + ⍝ + ⍝ Use this to tie a file with certain rights like 34: request read + ⍝ & write but grant just read. + ⍝ + ⍝ When the tie fails the function tries a couple of times with an + ⍝ increasing delay before giving up. + ⍝ + ⍝ Under Windows `newline` gets `⎕UCS 13 10` and `⎕UCS 10` otherwise. + ⍝ When a nested vector is passed as data then "newline" is appended to every single + ⍝ record **but** the last one.\\ + ⍝ That means that there will be **no** "newline" at the end of the file. That + ⍝ violates the POSIX recommendations but is in line with the majority of Windows + ⍝ software. For example, MS Word adds "newline" but Wordpad does not.\\ + ⍝ When "append" is specified, "newline" is also added as a prefix to + ⍝ the data in case the file does already exist and was not empty yet.\\ + ⍝ That leads to the desired result when you add stuff to a file you have + ⍝ created with `WriteUTF8File` but not necessarily in other cases - watch out!\\ + ⍝ If a simple string is passed it is written as it is: nothing is + ⍝ added at all. And yes, this **is** correct! It can only be argued + ⍝ whether it should be used this way. There are applications for + ⍝ this in any case.\\ + ⍝ It means **you** are in charge for inserting the correct "newline" characters + ⍝ (if any) depending on the platform. + ⎕IO←1 ⋄ ⎕ML←1 + r←'' + 'Invalid data: must not be a matrix'⎕SIGNAL 11/⍨2=⍴⍴data + append←{900⌶⍬:'' ⋄ ⍎⍵}'append' + 'Invalid right argument'⎕SIGNAL 11/⍨~(⊂append)∊'append' 1 0 ''⍬ + append←(⊂append)∊'append' 1 + simpleFlag←0 1∊⍨≡data + newline←(1+'Win'≡GetOperatingSystem ⍬)⊃(⎕UCS 10)(⎕UCS 13 10) + data{⍵:(-⍴,newline)↓⊃,/⍺,¨⊂newline ⋄ ⍺}←~simpleFlag + max←5 + fno←0⍴i←size←flag←0 + :Repeat + ⎕DL 1×i>0 + :If wasOpenFlag←0=1↑0⍴fileIdentifier + fno←fileIdentifier + size←⎕NSIZE fno + flag←1 + :Else + filename←fileIdentifier + (('\'=filename)/filename)←'/' + :Trap 19 22 + fno←(filename~'"')⎕NTIE 0 17 ⍝ Open exclusively + size←⎕NSIZE fno + flag←1 + :Case 22 + fno←(filename~'"')⎕NCREATE 0 + flag←1 + :Else + ('Could not open file ',filename)⎕SIGNAL ⎕EN + :EndTrap + :EndIf + :Until flag∨max' '' + html,←⊂'' + html,←'' '' + Url(3500⌶)∊html + :EndIf + :Else + browser←{2<⎕NC ⍵:⍎⍵ ⋄ ''}'browser' + :Select GetOperatingSystem ⍬ + :Case 'Win' + :If 0∊⍴browser + 'wsh'⎕WC'OLEClient' 'WScript.Shell' + {}wsh.Run Url + :Else + {}wsh.Run browser,' ',Url + :EndIf + :Case 'Lin' + :If 0∊⍴browser + {}⎕SH'xdg-open ',Url,' /dev/null 2>&1 &' + :Else + {}⎕SH browser,' ',Url,' /dev/null 2>&1 &' + :EndIf + :Case 'Mac' + . + :EndSelect + :EndIf + ∇ + + FindPathTo←{ + ⍝ `⍵` is the name of a script (namespace, interface or class).\\ + ⍝ Tries to find `⍵` in: + ⍝ 1. The same namespace `⎕THIS` is coming from. + ⍝ 2. The namespace where the class (if instanciated) comes from. + ⍝ 3. In `#`. + ⍝ 4. Where it was called from (**not** the same as either 1 or 2!). + ⍝ If it fails to find `⍵` an empty string is returned. + ⎕IO←1 ⋄ ⎕ML←1 + base←⎕THIS.## ⍝ were are we coming from? + base{11::0 ⋄ 9=⍺.⎕NC ⍵}⍵:base ⍝ Is it in that namespace? + base←{11::⍬ ⋄ (1⊃∊⎕CLASS ⍵).##}⍵ ⍝ Where stems the class from? + base{11::0 ⋄ 9=⍺.⎕NC{Last ⍵}⍕1⊃⊃⎕CLASS ⍵}⍵:base ⍝ Is it in that namespace? + 9={11::0 ⋄ #.⎕NC ⍵}⍵:# ⍝ Is it in root? + path←1⊃⎕RSI~⎕THIS ⍝ From where got we called? + 0,ZI2,<->,ZI2' + :CaseList 6 7 + formatstring←'ZI4,<->,ZI2,<->,ZI2,< >,ZI2,<:>,ZI2,<:>,ZI2' + :Else + 'Invalid left argument'⎕SIGNAL 11 + :EndSelect + bool←(ts2∨.≠' ')∧ts2∨.≠0 + r←bool⍀formatstring ⎕FMT(6⌊length)↑[2]bool⌿ts2 + :If 7=2⊃⍴ts2 + r←⊃(↓r),¨{0=⍵:'' ⋄ 0∊⍴⍵~' ':'' ⋄ '.',⍕⍵}¨ts2[;7] + :EndIf + :If 2≠⍴⍴ts + r←,r + :EndIf + ∇ + +:EndNamespace ⍝ APLTreeUtils diff --git a/APLSource/FilesAndDirs-121.class b/APLSource/FilesAndDirs-121.class new file mode 100644 index 0000000..e3b0feb --- /dev/null +++ b/APLSource/FilesAndDirs-121.class @@ -0,0 +1,1041 @@ +:Class FilesAndDirs +⍝ ## Overview +⍝ This class offers methods useful for dealing with files and directories. The class aims +⍝ to be platform-independent and work under Windows, Linux and Mac OS. +⍝ +⍝ With the release of 15.0 Dyalog introduced some new `⎕n`-system functions that are helpful +⍝ for making an application platform-independent when handling files and directories.\\ +⍝ However, those new functions do not fully cover the common needs of applications. Examples +⍝ include functionalities like "Move", "Copy", and recursive listings of directories. +⍝ The class attempts to fill this gap. +⍝ +⍝ Note that error codes as well as messages may differ between operating systems for the same +⍝ kind of problem. +⍝ +⍝ ## Characters to avoid in file names and paths +⍝ Windows file names cannot include any of these characters: `\/:*?"<>|`. +⍝ If you want platform-independent code now or in the future, +⍝ avoid using them even in Mac OS or Linux file names. +⍝ +⍝ ## Separators in filepaths +⍝ Dyalog tried to ease the pain by converting any `\` character under Windows to a `/`. +⍝ The notion of sticking always with the `/` as separator because it works anyway is +⍝ attractive but creates new poblems: when you call third-party software such as a .NET +⍝ assembly or an EXE such as 7zip.exe under Windows, then you **must** use `\` as a separator. +⍝ Even setting the `Directory` property of a `FileBox` object fails with `/` as a separator! +⍝ +⍝ For platform independence it is essential that filenames and directory names are _normalized_. +⍝ That means using the correct separator for the current operating system. +⍝ Otherwise you might create a directory or file with a backslash in its name, something that +⍝ turns easily catastrophic under Linux or Mac OS. +⍝ +⍝ The methods of `FilesAndDirs` protect you from this problem by normalizing their filepaths. +⍝ Use its cover functions, such as `MkDir`, `NNAMES` and `NCREATE` in preference to the +⍝ corresponding built-in system functions to overcome the problem. +⍝ +⍝ The `CurrentSep` method returns the correct separator for the current operating system. +⍝ +⍝ The `NormalizePath` method normalizes a filepath for the current operating system. +⍝ +⍝ If you have a particular reason for using `/` under Windows or `\` under Linux +⍝ or Mac OS then you can use the methods `EnforceBackslash` or `EnforceSlash`. +⍝ +⍝ ## Misc +⍝ This class supports Windows, Mac OS and Linux but neither the Raspberry Pi nor AIX.\\ +⍝ Kai Jaeger ⋄ APL Team Ltd\\ +⍝ Homepage: http://aplwiki.com/FilesAndDirs + + :Include APLTreeUtils + + ⎕IO←0 ⋄ ⎕ML←3 + + ∇ r←Version + :Access Public shared + r←(Last⍕⎕THIS)'1.6.0' '2017-05-18' + ∇ + + ∇ History + :Access Public shared + ⍝ * 1.6.0 + ⍝ * Now managed by acre 3. + ⍝ * 1.5.1 + ⍝ * Bug fix: "Windows only" for `NormalizePath` wasn't actually implemented. + ⍝ * 1.5.0 + ⍝ * `NormalizePath` now expands environment variables (Windows only). + ⍝ * 1.4.2 + ⍝ * `NormalizePath` now treats two leading `//` as a UNC path. This is a necessary step + ⍝ in order to overcome that `⎕NPARTS` returns two leading slashes in case the current + ⍝ directory **is** actually a UNC path. + ⍝ * 1.4.1 + ⍝ * `CopyTree` did not work as expected when the `source` parameters had a trailing + ⍝ separator. + ⍝ * 1.4.0 + ⍝ * `Dir` now supports both wildcards and recursive mode at the same time. + ⍝ * `RmDir` had a problem when, say, a console window was "looking" into the folder to + ⍝ be deleted, or one of its sub folders. It cannot delete such folders but should + ⍝ report the problem rather than crash. + ∇ + + ∇ r←{parms_}Dir path;buff;list;more;parms;rc;extension;filename;folder;subFolders + :Access Public Shared + ⍝ List contents of `path`.\\ + ⍝ `path` may be one of: + ⍝ * A file: `Dir` returns attributes for just that file + ⍝ * A directory without a trailing slash: `Dir` returns attributes for just that directory + ⍝ * A directory with a trailing slash: `Dir` returns attributes for all files and directories + ⍝ found in that directory. + ⍝ * An empty vector: this defaults to `PWD,'/'` + ⍝ + ⍝ Note that `*` and `?` are treated as wildcard characters. That means that `FilesAndDirs` + ⍝ cannot deal with files that contain a `*` or a `?` as part of any name, be it directory + ⍝ or filename; under Linux and Mac OS these are legal characters for filenames.\\ + ⍝ The result is a vector of the same length as `type` which defaults to 0: just file- and + ⍝ directory names. + ⍝ You may specify additional attributes via the `type` parameter either as key/value pairs or + ⍝ via a namespace populated with variables. If you do then the number of attributes specified + ⍝ defines the length of the result. + ⍝ Examples: + ⍝ ~~~ + ⍝ ('recursive' 1) FilesAndDirs.Dir '' ⍝ returns list with all folders and files + ⍝ ('recursive' 1) FilesAndDirs.Dir '*.md' ⍝ returns list with all files with extension "md" + ⍝ ~~~ + ⍝ + ⍝ ~~~ + ⍝ parms←⎕ns'' + ⍝ parms.recursive←1 + ⍝ parms.type←3 4 5 1 0 + ⍝ parms FilesAndDirs.Dir '' + ⍝ ~~~ + ⍝ If `path` is empty then the current directory is subject of `Dir`.\\ + ⍝ Note that the names of parameters are case sensitive.\\ + ⍝ |Parameter |Default|Meaning| + ⍝ |-----------|-------|-------| + ⍝ | follow | 0 | Shall symbolic links be followed | + ⍝ | recursive | 0 | Shall `Dir` scan `path` recursively | + ⍝ | type | 0 | Use this to select the information to be returned<
>by `Dir`. 0 means names. For more information see<
>help on `⎕NINFO`. | + r←⍬ + path←NormalizePath path + parms←⎕NS'' + parms.follow←1 + parms.recursive←0 + parms.type←0 + :If 0<⎕NC'parms_' + :If {2::0 ⋄ 1⊣⍵.⎕NL 2}parms_ + {}parms.{{⍎⍺,'←⍵'}/⍵}¨parms_.({⍵(⍎⍵)}¨↓⎕NL 2) + 'Invalid parameter'⎕SIGNAL 11/⍨∨/~(' '~¨⍨↓parms.⎕NL 2)∊'follow' 'recursive' 'type' + :Else + parms_←,⊂∘,⍣(2=≡parms_)⊣parms_ + 'Invalid parameter'⎕SIGNAL 11/⍨0∊(↑¨parms_)∊' '~¨⍨↓parms.⎕NL 2 + parms.{{⍎⍺,'←⍵'}/⍵}¨parms_ + :EndIf + :EndIf + :If 0∊⍴path + path←PWD,CurrentSep + :EndIf + path↓⍨←-(CurrentSep,'*')≡¯2↑path + :If CurrentSep=¯1↑{⍵↓⍨-'*'=¯1↑⍵}path + 'Directory does not exist'⎕SIGNAL 6/⍨0=⎕NEXISTS path + :Trap 19 22 + 'Not a directory'⎕SIGNAL 11/⍨1≠1 ⎕NINFO path + :Else + :If 1 5 'Access is denied.'≢⎕DMX.OSError + ⎕DMX.DM ⎕SIGNAL ⎕EN + :Else + :Return + :EndIf + :EndTrap + r←(0 1,parms.type~0 1)⎕NINFO⍠('Follow'parms.follow)('Wildcard' 1)⊣path,CurrentSep,'*' + :If ~0∊0⊃r + (0⊃r)←NormalizePath¨0⊃r + :EndIf + :If parms.recursive + :AndIf ~0∊⍴r + :AndIf 1∊1⊃r + buff←parms∘Dir¨((1=1⊃r)/0⊃r),¨CurrentSep + :If ~0∊⍴buff←(0<↑¨⍴¨buff)/buff + r←r,¨↑,¨/buff + :EndIf + :If 1=+/∧\'Dir'∘≡¨⎕SI + r←(⊂⍋⊃0⊃r)∘⌷¨r + :EndIf + :EndIf + :If 1=+/∧\'Dir'∘≡¨⎕SI + r←r[,(0 1,parms.type~0 1)⍳parms.type] + :EndIf + :Else + :If ∨/'*?'∊path + (folder filename extension)←⎕NPARTS path + ('Wildcard characters are allowed only after the last "',CurrentSep,'"')⎕SIGNAL 11/⍨∨/'*?'∊folder + :If ~0∊⍴buff←↑⎕NPARTS ¯1↓↑⎕NPARTS folder + :AndIf 0=⎕NEXISTS buff + 'path does not exist'⎕SIGNAL 6 + :EndIf + :Else + 'path does not exist'⎕SIGNAL 6/⍨0=⎕NEXISTS path + folder←path + :EndIf + r←(0 1,parms.type~0 1)⎕NINFO⍠('Follow'parms.follow)('Wildcard' 1)⊣path + :If ~0∊0⊃r + (0⊃r)←NormalizePath¨0⊃r + :EndIf + r←r[,(0 1,parms.type~0 1)⍳parms.type] + :If parms.recursive + :AndIf IsDir folder + :AndIf ~0∊⍴subFolders←ListDirs folder + subFolders←subFolders,¨⊂CurrentSep,filename,extension + buff←parms Dir¨subFolders + :If ~0∊⍴buff←↑{⍺,¨⍵}/buff + :AndIf ~0∊⍴buff←(0<↑∘⍴¨buff)/buff + r←r,¨buff + :EndIf + :EndIf + :EndIf + ∇ + + ∇ {(rc more)}←source CopyTo target;buff;cmd;∆CopyFile;a + :Access Public Shared + ⍝ Copies `source` to `target`.\\ + ⍝ The left argument must be one of: + ⍝ * A filename (simple string). + ⍝ * A vector of text strings, each representing a filename. + ⍝ + ⍝ In case it is a single filename then the right argument must be either a + ⍝ directory (in which case the filename itself persists) or a filename.\\ + ⍝ In case the left argument is a vector of filenames the right argument + ⍝ must be either a single directory (all files are copied into that + ⍝ directory, and the filenames as such persist) or a vector of the same + ⍝ length as the left argument.\\ + ⍝ Note that wildcard characters are not supported.\\ + ⍝ `CopyTo` overwrites the target file if there is any.\\ + ⍝ Examples: + ⍝ ~~~ + ⍝ 'C:\readme.txt' FilesAndDirs.CopyTo 'D:\buffer\' + ⍝ 'C:\readme.txt' FilesAndDirs.CopyTo 'D:\buffer\newname.txt' + ⍝ 'C:\file1' 'C:\file2' FilesAndDirs.CopyTo 'D:\buffer\' + ⍝ 'C:\file1' 'C:\file2' FilesAndDirs.CopyTo 'D:\buffer\A' D:\buffer\B + ⍝ ~~~ + ⍝ The method always returns a (shy) two-item vector as result: + ⍝ 1. `rc` is either 0 for "okay" or an error code. + ⍝ 2. `more` is an empty text vector in case `rc` is 0. It might hold + ⍝ additional information in case `rc` is not 0. + ⍝ + ⍝ Note that in case `source` is a nested vector of text vectors than both `rc` and + ⍝ `more` are nested as well, and the length will match the length of `source`. + rc←0 ⋄ more←'' + :If 2=≡source + target←Nest target + :If ≢/⍴¨source target + :AndIf 1≠⍴,target + 'Length of left and right argument do do not fit'⎕SIGNAL 5 + :EndIf + (rc more)←↓⍉⊃source CopyTo¨target + :Else + (source target)←NormalizePath¨source target + :Select GetOperatingSystem ⍬ + :Case 'Win' + '∆CopyFile'⎕NA'I kernel32.C32|CopyFile* <0T <0T I2' + :If CurrentSep=¯1↑target + target,←↑,/1↓⎕NPARTS source + :EndIf + :If 0=∆CopyFile((source~'"')(target~'"')),0 + rc←GetLastError + more←GetMsgFromError rc + :EndIf + :CaseList 'Lin' 'Mac' + cmd←'cp -- "',source,'" "',target,'"' + (rc more buff)←##.OS.ShellExecute cmd + :Else + . ⍝Huuh?! + :EndSelect + :EndIf + ∇ + + ∇ {(rc more)}←source MoveTo target + :Access Public Shared + ⍝ Moves `source` to `target`.\\ + ⍝ The function returns a 0 for success and an error number otherwise. `more` is a textual message + ⍝ which is empty in case of success.\\ + ⍝ The left argument must be a either a text vector representing a filename + ⍝ or a vector of text vectors representing a vector of filenames.\\ + ⍝ The right argument might be a filename or a directory in case the left argument + ⍝ is a single filename. If the left argument is a vector of filenames then the right + ⍝ argument must be either a single directory name or a vector of te same length + ⍝ than the left argument with filenames and/or directory names.\\ + ⍝ If the right argument specifies a directory the filename part of `source` is used for + ⍝ the new file.\\ + ⍝ Notes: + ⍝ * Wildcard characters are not supported. + ⍝ * If you try to move a non-existing file you get a `¯1` as return code and + ⍝ an appropriate message on `more`. + ⍝ * If there is a name clash in `target` the already existing file will be overwritten. + ⍝ + ⍝ The function returns a two-item vector. The first item is one of: + ⍝ * ¯1 for internal errors (invalid argument(s) etc). + ⍝ * 0 for success. + ⍝ * OS error codes otherwise + ⍝ + ⍝ The second item is an empty vector in case of success but may be a text vector with + ⍝ additional information otherwise.\\ + ⍝ Both items will be vectors themselves in case `source` is a nested vector.\\ + ⍝ This function will move file(s) by first copying them over + ⍝ and then attempt to delete the source file. Note however that when the delete operation + ⍝ fails the copied file will be deleted. This is consistent with the behaviour of the + ⍝ Windows `MoveFileEx` function.\\ + ⍝ Examples: + ⍝ + ⍝ ~~~ + ⍝ 'C:\readme.txt' FilesAndDirs.MoveTo 'D:\buffer\' + ⍝ 'C:\readme.txt' FilesAndDirs.MoveTo 'D:\buffer\newname.txt' + ⍝ ~~~ + :If ∨/{0∊⍴⍵}¨source target + rc←¯1 + more←'Invalid left argument' + :EndIf + :If 2=≡source + target←Nest target + source←NormalizePath¨source + target←NormalizePath¨target + :If ≢/⍴¨source target + :AndIf 1≠⍴,target + 'Length of left and right argument do do not fit'⎕SIGNAL 5 + :EndIf + (rc more)←↓⍉⊃source MoveTo¨target + :Else + (source target)←{NormalizePath↑,/1 ⎕NPARTS ⍵}¨source target + :Select GetOperatingSystem ⍬ + :Case 'Win' + (rc more)←source Win_MoveTo target + :CaseList 'Lin' 'Mac' + (rc more)←source Unix_MoveTo target + :Else + . ⍝ Huuh?! + :EndSelect + :EndIf + ∇ + + ∇ (success more list)←source CopyTree target;tree;ind;buff + ⍝ ## Overview + ⍝ `source` must be an existing directory. `target` must be either a existing directory + ⍝ or a name valid as a directory.\\ + ⍝ All files and directories in `source` are copied over to `target`.\\ + ⍝ ## Result + ⍝ * `success` is Boolean with 1 indicating success. A 0 means failure, but the failure may + ⍝ not be total: in case, say, 100 files are to be copied and some of them failed + ⍝ because of a, say, an ACCESS DENIED error then `rc` will be 0 but `list` gives you the + ⍝ full story.\\ + ⍝ * `more` is empty if everything is okay. It may contain additional information if + ⍝ something goes wrong. An example is when the `target` directory cannot be created.\\ + ⍝ * `list` is a matrix with three columns: + ⍝ * [;0] is a list of names of all files and directories that were copied. + ⍝ * [;1] is the return code: either 0 for success or an error number. + ⍝ * [;2] is either an empty vector (in case of success) or additional information as + ⍝ a text vector. + ⍝ + ⍝ ## Notes + ⍝ * `CopyTree` does not rollback in case something goes wrong; instead it keeps trying. + ⍝ * `target` might already contain stuff; in case of name conflicts any already + ⍝ existing files will be overwritten. + :Access Public Shared + success←1 ⋄ more←'' ⋄ list←0 3⍴'' 0 0 + + 'Invalid left argument'⎕SIGNAL 11/⍨(~(≡source)∊0 1)∨80≠⎕DR source + 'Invalid right argument'⎕SIGNAL 11/⍨(~(≡target)∊0 1)∨80≠⎕DR target + 'Left argument is not a directory'⎕SIGNAL 11/⍨0=IsDir source + 'Right argument is a file'⎕SIGNAL 11/⍨IsFile target + 'Right argument has wildcard characters'⎕SIGNAL 11/⍨∨/'*?'∊target + (source target)←NormalizePath¨source target + source←(-+/∧\CurrentSep=⌽source)↓source + :If 0=⎕NEXISTS target + :Trap 19 22 + MkDir target + :Else + success←0 + more←'Could not create target directory' + :Return + :EndTrap + :EndIf + :Trap 11 + tree←((⍉⊃('recursive' 1)('type'(0 1))Dir source,CurrentSep),0),' ' + :Else + success←0 + more←'Could not get contents of source directory' + :Return + :EndTrap + list⍪←({⍵↓⍨-CurrentSep=¯1↑⍵}target)0 '' + :If ~0∊⍴tree + ⍝ We now create all directories + ind←Where 1=tree[;1] + tree[ind;2]←~'Create!'∘CheckPath¨target∘,¨(⍴source)↓¨tree[ind;0] + tree[ind;3]←⊂'' + ind←Where 2=tree[;1] + tree[ind;2 3]←⍉⊃tree[ind;0]CopyTo target∘,¨(⍴source)↓¨tree[ind;0] + buff←tree[;0 2 3] + buff[;0]←(⊂target),¨(⍴source)↓¨buff[;0] + list⍪←buff + :EndIf + ∇ + + ∇ r←CurrentSep + ⍝ Returns what is the "correct" filename separator under the current OS. + :Access Public Shared + r←('Win'≡GetOperatingSystem ⍬)⊃'/\' + ∇ + + ∇ (success more list)←source MoveTree target;success;directories;ind;delFlags;isLinkOrFile;isLinkOrDir + ⍝ ## Overview + ⍝ `source` must be an existing directory. `target` must be either a existing directory + ⍝ or a valid directory name.\\ + ⍝ All files and directories in `source` are copied over to `target`.\\ + ⍝ ## Result + ⍝ `success` is Boolean with 1 indicating success. A 0 means failure, but the failure may + ⍝ not be total: in case, say, 100 files are to be copied and just some of them failed + ⍝ because of a, say, an ACCESS DENIED error then `success` will be 0 but `list` gives you the + ⍝ full story.\\ + ⍝ `more` is empty if everything is okay. It may contain additional information if + ⍝ something goes wrong. An example is when the `target` directory cannot be created.\\ + ⍝ `list` is a matrix with four columns: + ⍝ * [;0] is a list of names of all files and directories that were copied. + ⍝ * [;1] is the copy-related return code: 0 for success or an error number. + ⍝ * [;2] is the delete-related return code: 0 for success or an error number. + ⍝ * [;3] is either an empty vector (in case of success) or additional information as + ⍝ a text vector. + ⍝ + ⍝ ## Misc + ⍝ Note that `MoveTree` does not rollback in case something goes wrong; + ⍝ instead it keeps trying. That means that a copy-operation might be successful + ⍝ but the associated delete-operation fails.\\ + ⍝ Note that `target` might already contain stuff; in case of name conflicts any already + ⍝ existing files will be overwritten. + :Access Public Shared + success←1 ⋄ more←'' ⋄ list←0 4⍴'' 0 0 '' + 'Invalid left argument'⎕SIGNAL 11/⍨(~(≡source)∊0 1)∨80≠⎕DR source + 'Invalid right argument'⎕SIGNAL 11/⍨(~(≡target)∊0 1)∨80≠⎕DR target + 'Left argument is not a directory'⎕SIGNAL 11/⍨0=IsDir source + 'Right argument is a file'⎕SIGNAL 11/⍨IsFile target + (source target)←NormalizePath¨source target + (success more list)←source CopyTree target + :If success + list←list[;0 1 1 2] + list[;0]←source∘,¨(⍴target)↓¨list[;0] + isLinkOrFile←({1 ⎕NINFO⍠('Follow' 0)⊣⍵}¨list[;0])∊2 4 + {}{0∊⍴⍵:⍬ ⋄ {19 22::⍬ ⋄ 1 ⎕NDELETE ⍵}¨⍵}isLinkOrFile/list[;0] ⍝ Links and files first + isLinkOrDir←({19 22::0 ⋄ 1 ⎕NINFO⍠('Follow' 0)⊣⍵}¨list[;0])∊1 4 + directories←(isLinkOrDir)/list[;0] + ind←⍒+/CurrentSep=⊃directories ⍝ Sub directories first! + {}{0∊⍴⍵:⍬ ⋄ {19 22::⍬ ⋄ 1 ⎕NDELETE ⍵}¨⍵}directories[ind] + list[;2]←⎕NEXISTS¨list[;0] + :EndIf + ∇ + + ∇ {(rc en more)}←{mustBeEmpty}RmDir path;list;bool + :Access Public Shared + ⍝ Tries to removes `path`.\\ + ⍝ The method attempts to remove `path` and, by default, **all its contents**.\\ + ⍝ If for some reason you want to make sure that `path` is only removed when empty you can + ⍝ specify a 1 as left argument. In that case the method will not do anything if `path` is + ⍝ not empty.\\ + ⍝ Note that this method may fail for reasons as trivial as somebody looking into `path` + ⍝ at the moment of execution. However, the method may still be partly successful because + ⍝ it might have deleted files in `path` before it actually fails to remove `path` itself.\\ + ⍝ The result is a three-element vector: + ⍝ 1. `rc`: return code with 0 for "okay" (=deleted) and 1 otherwise. + ⍝ 1. `en`: event number (`⎕EN`) in case of an error. + ⍝ 1. `more`: empty text vector in case `rc` is 0. + ⍝ + ⍝ Notes: + ⍝ * If `path` does not exist (0 0 'Directory does not exist') is returned. + ⍝ * Wildcard characters (`*` and `?`) are not allowed as part of `path`. + ⍝ If such characters are specified anyway then an error is signalled. + rc←1 ⋄ en←0 ⋄ more←'' + mustBeEmpty←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'mustBeEmpty' + 'Invalid left argument.'⎕SIGNAL 11/⍨~mustBeEmpty∊0 1 + 'Wildcard characters are not allowed'⎕SIGNAL 11/⍨∨/'*?'∊path + path←NormalizePath path + path↓⍨←-CurrentSep=¯1↑path + :Trap 19 22 + :If 1≠1 ⎕NINFO path + en←6 + more←'Not a directory' + :Return + :EndIf + :Else + :If Exists path + more←{(≡⍵)∊0 1:⍵ ⋄ ↑{⍺,'; ',⍵}/⍵/⍨' '=↑¨1↑¨0⍴¨⍵}⎕DMX.OSError + en←⎕EN + :Else + rc←0 + more←'Directory does not exist' + :EndIf + :Return + :EndTrap + :Trap 19 22 + rc←~0 ⎕NDELETE path + :Else + :If 0=mustBeEmpty + ⍝ First we delete all files + :If 0∊⍴list←⍉⊃('recursive' 1)('type'(0 1))Dir path,CurrentSep + ⍝ This can happen if for example somebody "look" into the folder + rc←1 + en←11 + more←'Could not delete all files/folders.' + :Return + :EndIf + :If 0<+/bool←1≠list[;1] + :Trap 0 + {}{1 ⎕NDELETE ⍵}¨bool/list[;0] ⍝ Return code might be 0 for links! + :Else + en←⎕EN + more←⎕DMX.EM + :Return + :EndTrap + :If 0∊{19 22::1 ⋄ 0⊣1 ⎕NINFO ⍵}¨bool/list[;0] + en←11 + more←'Could not delete all files.' + :Return + :EndIf + :EndIf + ⍝ Now we remove all sub-directories + :If ~0∊⍴list←(~bool)/list[;0] + list←list[⍒↑¨⍴¨list] + :Trap 0 + rc←~{1 ⎕NDELETE ⍵}¨list + :Else + en←⎕EN + more←⎕DMX.EM + :Return + :EndTrap + :If 0∊{19 22::1 ⋄ 0⊣1 ⎕NINFO ⍵}¨list + en←11 + more←'Could not delete all directories.' + :Return + :EndIf + rc←0 + :EndIf + :Trap 19 22 + rc∧←~0 ⎕NDELETE path ⍝ Now we try again + :Else + rc←1 + :EndTrap + :Else + en←⎕EN + more←{↑{⍺,'; ',⍵}/⍵/⍨' '=↑¨0⍴¨⍵}⎕DMX.OSError + :EndIf + :EndTrap + ∇ + + ∇ r←PWD + :Access Public Shared + ⍝ Print Work Directory; same as `Cd''`. + r←↑1 ⎕NPARTS'' + r↓⍨←-(¯1↑r)∊'/\' + r←NormalizePath r + ∇ + + ∇ path←{expandFlag}NormalizePath path;UNCflag;sep;ExpandEnvironmentStrings;isScalar + :Access Public Shared + ⍝ `path` might be either a simple text vector or scalar representing a single filename or a + ⍝ vector of text vectors with each item representing a text vector. + ⍝ Enforces either `\` or `/` as separator in `path` depending on the current operating system.\\ + ⍝ If you **must** enforce a particular separator then use either `EnforceBackslash` or + ⍝ `Enforceslash`.\\ + ⍝ Note that by default a relative path remains relative and any `../` (or `..\`) is not touched. + ⍝ You can change this by specifying "expand" as the (optional) left argument; then `path` is + ⍝ expanded to an absolute path. As a side effect any `../` is transformed appropriately as well.\\ + ⍝ Notes: + ⍝ * The left argument is not case sensitive. + ⍝ * Any pair of `//` or `\\` is reduced to a single one except the first two. + ⍝ * Environment variables are expanded. + isScalar←⍬≡⍴path + :If ~0∊⍴path + :If '%'∊path + :AndIf 'Win'≡GetOperatingSystem ⍬ + 'ExpandEnvironmentStrings'⎕NA'I4 KERNEL32.C32|ExpandEnvironmentStrings* <0T >0T I4' + path←1⊃ExpandEnvironmentStrings path 2048 2048 + :EndIf + expandFlag←'expand'≡{0<⎕NC ⍵:{0=1↑0 ⍵:⍵ ⋄ Lowercase ⍵}w←⍎⍵ ⋄ ''}'expandFlag' + :If 1<≡path + path←expandFlag NormalizePath¨path + :Else + UNCflag←(⊂2⍴path)∊'\\' '//' + :If expandFlag + path←↑,/1 ⎕NPARTS path + :EndIf + sep←('Win'≡GetOperatingSystem ⍬)⌽'\/' + ((path=0⊃sep)/path)←1⊃sep + path←(~(2⍴1⊃sep)⍷path)/path + :If UNCflag + path←'\\',1↓path + :EndIf + :If isScalar + :AndIf 1=⍴path + path←↑path + :EndIf + :EndIf + :EndIf + ∇ + + ∇ path←EnforceBackslash path + :Access Public Shared + ⍝ Use this if you must make sure that `path` contains `\` rather than `/`.\\ + ((path='/')/path)←'\' + ∇ + + ∇ path←EnforceSlash path + :Access Public Shared + ⍝ Use this if you must make sure that `path` contains `/` rather than `\`.\\ + ⍝ Preserves the first two characters if they are `\\`. + ((path='\')/path)←'/' + ∇ + + ∇ {r}←PolishCurrentDir;wsid + :Access Public Shared + ⍝ If `⎕WSID` is relative this function does nothing.\\ + ⍝ Otherwise the current directory is changed so that it becomes the path part of `⎕WSID`.\\ + ⍝ Returns either `''` or the old directory in case of a change. + r←'' + wsid←NormalizePath ⎕WSID + :If ('.',CurrentSep)≢2⍴⎕WSID,' ' + :AndIf CurrentSep∊wsid + r←NormalizePath Cd 0⊃SplitPath wsid + :EndIf + ∇ + + ∇ r←Cd path;Lin;r;rc;∆GetCurrentDirectory;∆SetCurrentDirectory;∆chdir + ⍝ Reports and/or changes the current directory. + ⍝ The method changes the current directory to what the right argument is ruling.\\ + ⍝ It returns the former current directory as a result.\\ + ⍝ Because an empty right argument has no effect, `Cd ''` effectively reports the + ⍝ current directory.\\ + ⍝ See also [`PWD`](#) (Print Work Directory). + :Access Public Shared + path←NormalizePath path + :Select GetOperatingSystem ⍬ + :Case 'Win' + '∆GetCurrentDirectory'⎕NA'I4 KERNEL32.C32|GetCurrentDirectory* I4 >T[]' + '∆SetCurrentDirectory'⎕NA'I4 KERNEL32.C32|SetCurrentDirectory* <0T' + :If 0=↑rc←∆GetCurrentDirectory 260 260 + r←GetLastError'GetCurrentDirectory error' '' + :Else + r←NormalizePath↑↑/rc + :EndIf + :If ~0∊⍴path←path~'"' + :AndIf ' '=1↑0⍴path + path,←(CurrentSep≠¯1↑path)/CurrentSep + :If ~∆SetCurrentDirectory⊂path + 11 ⎕SIGNAL⍨⊃{⍵,'; rc=',⍕⍺}/GetLastError'SetCurrentDirectory error' + :EndIf + :EndIf + :CaseList 'Lin' 'Mac' + path←NormalizePath path + :If 0∊⍴path + r←↑⎕SH'pwd' + :Else + '∆chdir'⎕NA'I ',##.OS.GetSharedLib,'| chdir <0T1[]' + r←∆chdir⊂path + :EndIf + :Else + . ⍝ Huuh?! + :EndSelect + ∇ + + ∇ path←GetTempPath;∆GetTempPath + ⍝ Returns the path to the temp directory on the current system. + :Access Public Shared + :Select GetOperatingSystem ⍬ + :Case 'Win' + '∆GetTempPath'⎕NA'I4 KERNEL32.C32|GetTempPath* I4 >T[]' + path←↑↑/∆GetTempPath 1024 1024 + :If 0∊⍴path + 11 ⎕SIGNAL⍨'Problem getting Windows temp path!; rc=',⍕GetLastError + :Else + path←NormalizePath path + :EndIf + :Case 'Lin' + path←'/tmp/' + :Case 'Mac' + path←'/private/tmp/' + :Else + .⍝ Huuh?! + :EndSelect + ∇ + + ∇ r←IsDir path + :Access Public Shared + ⍝ Returns 1 if `path` is a directory and 0 otherwise, even if `path` does exist as a file. + :If 2=≡path + r←IsDir¨path + :Else + path←NormalizePath path + :Trap 11 + :If r←⎕NEXISTS path + r←1=1 ⎕NINFO path + :EndIf + :Else + r←0 + :EndTrap + :EndIf + ∇ + + ∇ r←IsFile y + :Access Public Shared + ⍝ Returns 1 if `filename` is a regular file and a 0 otherwise, even if `y` does exist as a directory.\\ + ⍝ `y` must be either a text vector or a (negative!) tie number of a native file. + ⍝ If it is a number but not a tie number then an error is signalled. + :If 2=≡y + r←IsFile¨y + :Else + :If 0=1↑0⍴y + 'Not tied'⎕SIGNAL 18/⍨~y∊⎕NNUMS + r←2=1 ⎕NINFO y + :Else + y←NormalizePath y + :Trap 11 + :If r←⎕NEXISTS y + r←2=1 ⎕NINFO y + :Else + r←0 + :EndIf + :Else + r←0 + :EndTrap + :EndIf + :EndIf + ∇ + + ∇ r←IsSymbolicLink y + :Access Public Shared + ⍝ Returns a 1 if `y` is a symbolic link and a 0 otherwise, even if `y` does exist as a file or directory.\\ + ⍝ `y` must be a text vector. + :If 2=≡y + r←IsSymbolicLink¨y + :Else + 'Invalid right argument'⎕SIGNAL 11/⍨' '≠1↑0⍴y + y←NormalizePath y + :Trap 19 22 + r←4=1 ⎕NINFO⍠('Follow' 0)⊣y + :Else + r←0 + :EndTrap + :EndIf + ∇ + + ∇ {success}←{new}CheckPath path;newFlag + :Access Public Shared + ⍝ Returns a 1 if the `path` to be checked is fine, otherwise 0.\\ + ⍝ * If `path` exists but is not a directory a 0 is returned.\\ + ⍝ * If `path` does not exist a 0 is returned.\\ + ⍝ * If `path` does not exist but the left argument is "CREATE!" it will be created, + ⍝ including any sub directories.\\ + ⍝ The left argument is case insensitive. + path←NormalizePath path + :If 1=⎕NEXISTS path + success←IsDir path + :Else + success←0 + newFlag←'CREATE!' 1∊⍨⊂{6::0 ⋄ {(0=1↑0⍴⍵):⍵ ⋄ Uppercase ⍵}⍎⍵}'new' + :If newFlag + success←MkDir path + :EndIf + :EndIf + ∇ + + ∇ filename←{PrefixString}GetTempFilename path;rc;start;no;fno;flag + ⍝ Returns the name of an unused temporary filename. If `path` is empty the default temp + ⍝ path is taken; that's what `GetTempPath` would return. This means you can overwrite + ⍝ this by specifying a path.\\ + ⍝ `PrefixString`, if defined, is a leading string of the filename + ⍝ going to be generated. This is **not** the same as\\ + ⍝ `'pref',GetTempFileName ''`\\ + ⍝ because specified as left argument it is taken into account + ⍝ when the uniqueness of the created filename is tested.\\ + ⍝ This function does **not** use the Windows built-in function since + ⍝ it has proven to be unreliable under W7 (at least). + :Access Public Shared + PrefixString←{0<⎕NC ⍵:⍎⍵ ⋄ ''}'PrefixString' + path←NormalizePath path + path,←((~0∊⍴path)∧CurrentSep≠¯1↑path)/CurrentSep + :If 0∊⍴path + :Trap 0 + path←GetTempPath + :Else + 11 ⎕SIGNAL⍨'Cannot get a temp path; rc=',⍕⎕EN + :EndTrap + :EndIf + :If 0=rc←'Create!'CheckPath path + 11 ⎕SIGNAL⍨'Error during "Create <',path,'>"; rc=',⍕GetLastError + :Else + start←no←⍎{(,'ZI2,ZI2,ZI2'⎕FMT 3↑⍵),⍕3↓⍵}3↓⎕TS ⍝ Expensive but successful very soon + ⍝ no←100⊥3↓⎕TS ⍝ Not reliable: can take a large number of tries before successful + :Repeat + filename←path,PrefixString,(⎕AN,'_',⍕no),'.tmp' + fno←0 + :Trap 22 + ⎕NUNTIE fno←filename ⎕NCREATE 0 + flag←1 + :EndTrap + no+←10 + :Until (fno≠0)∨no>start+1000×10 ⍝ max 1000 tries + :EndIf + filename←NormalizePath filename + ∇ + + ∇ r←{recursive}ListDirs path;buff;recursiveFlag;part1;part2 + :Access Public Shared + ⍝ Lists all directories (but nothing else) in `path`.\\ + ⍝ `path` must of course be a directory.\\ + ⍝ Specify the string "recursive" (not case sensitive) as left argument to make the + ⍝ function work recursively.\\ + ⍝ `path` might contain wildcard characters (`*` and `?`) but only in the last part + ⍝ of the path and only if "recursive" is **not** specified as left argument.\\ + ⍝ Returns a vector of text vectors in case anything was found and `''` otherwise. + path←NormalizePath path + (part1 part2)←SplitPath path + 'Wildcard characters are allowed only in the last part of a path'⎕SIGNAL 11/⍨∨/'?*'∊part1 + 'Right argument is not a directory'⎕SIGNAL 11/⍨0=IsDir{(a b)←SplitPath ⍵ ⋄ ~∨/'*?'∊b:⍵ ⋄ a}path + path↓⍨←-CurrentSep=¯1↑path + recursiveFlag←'recursive'≡Lowercase{0<⎕NC ⍵:⍎⍵ ⋄ ''}'recursive' + :If recursiveFlag + :AndIf ∨/'*?'∊path + '"path" must not carry wildcard chars in case "Recursive" is specified'⎕SIGNAL 11 + :EndIf + path,←(~∨/'?*'∊path)/CurrentSep + buff←('recursive'recursiveFlag)('type'(0 1))Dir path + r←(1=1⊃buff)/0⊃buff + r←NormalizePath¨r + ∇ + + ∇ r←{recursive}ListFiles path;buff;recursiveFlag;part1;part2 + :Access Public Shared + ⍝ Lists all files (but nothing else) in `path`.\\ + ⍝ `path` must of course be a directory. + ⍝ Specify the string "recursive" (not case sensitive) as left argument to make the + ⍝ function work recursively.\\ + ⍝ `path` might contain wildcard characters (`*` and `?`) but only in the last part + ⍝ of the path and only if "recursive" is **not** specified as left argument.\\ + ⍝ Returns a vector of text vectors in case anything was found and `''` otherwise. + path←NormalizePath path + (part1 part2)←SplitPath path + 'Wildcard characters are allowed only in the last part of a path'⎕SIGNAL 11/⍨∨/'?*'∊part1 + 'Right argument is not a directory'⎕SIGNAL 11/⍨0=IsDir part1 + path↓⍨←-CurrentSep=¯1↑path + recursiveFlag←'recursive'≡Lowercase{0<⎕NC ⍵:⍎⍵ ⋄ ''}'recursive' + :If recursiveFlag + :AndIf ∨/'*?'∊path + '"path" must not carry wildcard chars in case "Recursive" is specified'⎕SIGNAL 11 + :EndIf + path,←(~∨/'?*'∊path)/CurrentSep + buff←('recursive'recursiveFlag)('type'(0 1))Dir path + r←(2=1⊃buff)/0⊃buff + r←NormalizePath¨r + ∇ + + ∇ {success}←DeleteFile filenames + :Access Public Shared + ⍝ Attempts to delete a file. Returns 1 in case of succes and 0 otherwise for each + ⍝ file in `filenames`.\\ + ⍝ This function does not care whether the file exists or not, although naturally + ⍝ `sucess` will be 0 for any non-existing files.\\ + ⍝ `filenames` can be one of: + ⍝ * Text string representing a single filename. + ⍝ * Vector of text vectors, each representing a single file. + ⍝ + ⍝ `filenames` are normalized, meaning that any `\` is replaced by `/`.\\ + ⍝ In case `filenames` is empty a 0 is returned. + :If 0∊⍴filenames + success←0 + :Else + filenames←Nest filenames + filenames←NormalizePath¨filenames + success←{19 22::0 ⋄ 0∊⍴⍵:0 ⋄ 1 ⎕NDELETE ⍵}¨filenames + :EndIf + ∇ + + ∇ {success}←MkDir path;counter;flag + :Access Public Shared + ⍝ Make directory. If the directory already exists no action is taken and a 1 returned.\\ + ⍝ Any part of `path` which does not already exist will be created in preparation + ⍝ of creating `path` itself.\\ + ⍝ In comparison with `⎕MKDIR` there some differences: + ⍝ * This method normalizes `path`, meaning that any `\` is changed into `/`. + ⍝ * Errors 19 & 22 are trapped. + ⍝ * The function overcomes a strange problem: on some systems the function refuses to create + ⍝ the directory repeatedly unless the code is traced. + ⍝ + ⍝ `success` is 1 in case the directory was created successfully or already existed, otherwise 0. + path←NormalizePath path + success←0 + :If IsDir path + success←1 + :Else + :Trap 19 22 + counter←flag←0 + :Repeat + ⍝ This loop tries to overcome the problem that on some machines ⎕MKDIR does not work + ⍝ as expected. This cannot (!) be solved by a simple delay. Tracing as well as the + ⍝ loop however work. + :Trap 19 22 + success←3 ⎕MKDIR path + :Else + :Leave ⍝ Something went wrong + :EndTrap + flag←⎕NEXISTS path + ⎕DL flag×0.05×counter+1 + :Until flag∨10T[] I4 I4' + :If 0>mid←↑mid + :AndIf ¯16777216≤mid + mid←-mid + :EndIf + multiByte←80=⎕DR' ' ⍝ Flag: is Unicode + size←1024×1+multiByte ⍝ Dynamic buffer size + r←⊃↑/FormatMsg(FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_IGNORE_INSERTS)0 mid LangID size size 0 + :If 0∊⍴r + 'LoadLibrary'⎕NA'I KERNEL32|LoadLibrary* <0T' + ⎕NA'I KERNEL32|FreeLibrary I' + :For this :In 'ADVAPI32' 'NETMSG' 'WININET' 'WSOCK32' + :If 0≠hModule←LoadLibrary(⊂this) + :If this≡'WSOCK32' + ind←10013 10014 10024 10035 10036 10037 10038 10039 10040 10041 10042 10043 10044 10046 10047 10048 10049 10050 10051 10052 10053 10054 10055 10056 10057 10058 10059 10060 10061 10063 10064 10065 10066 10067 10068 10069 10070 10071 10091 10092 10093 10112 11001 11002 11003 11004 + mid←(10060 10013 10023 10010 10011 10012 10026 10014 10015 10044 10036 10031 10030 10016 10029 10028 10122 10039 10046 10040 10038 10037 10127 10034 10035 10003 10047 10033 10135 10000 10042 10043 10017 10018 10019 10020 10021 10025 10001 10002 10148 10041 10005 10006 10007 10114,mid)[ind⍳mid] + :EndIf + r←⊃↑/FormatMsg(FORMAT_MESSAGE_FROM_HMODULE+FORMAT_MESSAGE_IGNORE_INSERTS)hModule mid LangID size size 0 + {}FreeLibrary hModule + :If ×↑⍴r + :Leave + :EndIf + :EndIf + :EndFor + :EndIf + r←¯2↓r + ∇ + +:EndClass diff --git a/APLSource/Logger-1.class b/APLSource/Logger-1.class new file mode 100644 index 0000000..5ad375c --- /dev/null +++ b/APLSource/Logger-1.class @@ -0,0 +1,973 @@ +:Class Logger +⍝ ## Overview +⍝ This class is designed to write log files. It does not need any parameters +⍝ when instantiated but you may specify the following parameters: +⍝ |`path` | Where the log file should be created; default is the current directory. +⍝ |`encoding` | Is either UTF8 or ANSI. +⍝ |`filenameType` | Determines the file name. Defaults to yyyymmdd.log +⍝ |`debug` | By default (0) all internal errors are trapped. +⍝ |`timestamp` | Practically never used accept for test cases. +⍝ +⍝ ## Syntax +⍝ ~~~ +⍝ ⎕NEW Logger ([path encoding filenameType debug timestamp refToUtils]) +⍝ ⎕NEW Logger +⍝ ⎕NEW Logger (,⊂ParameterSpace) +⍝ ⎕NEW Logger +⍝ ~~~ +⍝ Only by creating a parameter space can one set **all** possible parameters.\\ +⍝ Example: +⍝ ~~~ +⍝ myParms←#.Logger.CreateParms +⍝ myParms.filenamePrefix←'MYAPP' +⍝ ⍝ .... +⍝ ⍝ Note that the namespace returned by `CreateParms` offers a method +⍝ `List` which list both, the names and their current values. +⍝ ⎕NEW Logger (,⊂myParms) +⍝ ~~~ +⍝ +⍝ ## Misc +⍝ Needs: At least Dyalog Version 12, Unicode or Classic\\ +⍝ Author: Kai Jaeger ⋄ APL Team Ltd\\ +⍝ Homepage: + + :Include ##.APLTreeUtils + + ⎕IO←1 + ⎕ML←3 + CrLf←⎕UCS 13 10 + + ∇ r←Version + :Access Public shared + r←(Last⍕⎕THIS)'2.5.0' '2018-02-19' + ∇ + + ∇ History + :Access Public shared + ⍝ * 2.4.0 + ⍝ * Method `History` introduced. + ⍝ * `Logger` is now managed by acre 3. + ⍝ * 2.3.0 + ⍝ * New method `CreateParms` introduced which brings `Logger` in line with all other members + ⍝ of the APLTree project. `CreateProperySpace` is deprecated now but is still available. + ⍝ * The internal function in the namepsace created by `CreateParms` is now named `∆List` rather + ⍝ then `List` for the same reason. + ∇ + +⍝ --------------- Properties and Fields + + :Field Private ReadOnly constructorIsRunning←0 + + :Property encoding + ⍝ In a Unicode interpreter, this can be either "ANSI" or "UTF8".\\ + ⍝ "ASCII" is deprecated since version 2.1 but still allowed and internally + ⍝ switched to "ANSI". + :Access Public + ∇ r←get + r←_encoding + ∇ + :EndProperty + + :Property autoReOpen + ⍝ Boolean. Defaults to 1, meaning that an instance of `Logger` re-opens its log file + ⍝ itself when this is appropriate. For example, if `filenameType` is "year", the file + ⍝ re-opens with a new name as soon as a new year comes along.\\ + ⍝ Note that `Logger` throws an error when `autoReOpen` is 1 and `filename` is + ⍝ not empty. + :Access Public Instance + ∇ r←get + r←_autoReOpen + ∇ + ∇ set arg + 'Must be a Boolean'⎕SIGNAL 11/⍨~arg.NewValue∊0 1 + _autoReOpen←arg.NewValue + ∇ + :EndProperty + + :Property filenameType + ⍝ Might be one of: "DATE" (the default) or "YEAR" or "MONTH".\\ + ⍝ The name of the logfile then becomes accordingly "yyyymmdd" or "yyyy" of "yyyymm" + :Access Public Instance + ∇ r←get + r←_filenameType + ∇ + ∇ set arg;buffer + buffer←Uppercase arg.NewValue + 'Invalid filenameType'⎕SIGNAL 11/⍨~(⊂buffer)∊'DATE' 'YEAR' 'MONTH' '' + _filenameType←arg.NewValue + ∇ + :EndProperty + + :Property debug + ⍝ Since logging information to a file for analyzing purposes should never break an application, + ⍝ error trapping is used heavily within `Logger`. However, this is not appropriate for debugging + ⍝ `Logging`. Therefore, setting `debug` to 1 switches error trapping off completely. + :Access Public Instance + ∇ r←get + r←_debug + ∇ + ∇ set arg + 'Must be a Boolean'⎕SIGNAL 11/⍨~arg.NewValue∊0 1 + _debug←arg.NewValue + ∇ + :EndProperty + + :Property printToSession + ⍝ Setting this to 1 let an instance print every entry not only to the underlying file but also + ⍝ to the session. Appropriate when debugging an application. Is ignored if `debug` is 0! + ⍝ Defaults to 0. + :Access Public Instance + ∇ r←get + r←_printToSession + ∇ + ∇ set arg + 'Must be a Boolean'⎕SIGNAL 11/⍨~arg.NewValue∊0 1 + _printToSession←arg.NewValue + ∇ + :EndProperty + + :Property extension + ⍝ This defines the file extension of the log file to be created. Defaults to "log" + :Access Public Instance + ∇ r←get + r←_extension + ∇ + ∇ set arg + 'Must be simple'⎕SIGNAL 11/⍨~0 1∊⍨≡arg.NewValue + 'Must be a string'⎕SIGNAL 11/⍨~IsChar arg.NewValue + _extension←arg.NewValue + ∇ + :EndProperty + + :Property refToUtils + ⍝ The `Logger` class needs a couple of scripts: + ⍝ * `FilesAndDirs` + ⍝ * `APLTreeUtils` + ⍝ + ⍝ While `APLTreeUtils` **must** be situated in the same namespace as `Logger` because it's :Included, + ⍝ `Logger` looks for `FilesAndDirs` at several places: it will find it automatically if + ⍝ it is situated either in the same namespace as `Logger` itself or in `#` or where + ⍝ `Logger` got instanciated from. If this is not appropriate for you, you **must** + ⍝ set `refToUtils` to the namespace which keeps `FilesAndDirs`. + ⍝ However, you are discouraged for actully setting this property since the places where `Logger` + ⍝ tries to find it should be sufficient. The property remains available for compatibility reasons. + :Access Public Instance + ∇ r←get + r←_refToUtils + ∇ + ∇ set arg + _refToUtils←arg.NewValue + ∇ + :EndProperty + + :Property timestamp + ⍝ Use this for debugging purposes only: if `timestamp` is not empty it is used instead of + ⍝ `⎕TS`. Useful to test the "re-open" feature, for example.\\ + ⍝ `timestamp` must be a vector of integers with 6 items: y,m,d,h,m,s.\\ + ⍝ Note that this is **ignored** if `debug` is 0! + :Access Public Instance + ∇ r←get + r←_timestamp + ∇ + ∇ set arg + →(0∊⍴,arg.NewValue)/0 + 'Invalid time stamp'⎕SIGNAL 11/⍨~(⍴,arg.NewValue)∊3 6 + 'Invalid time stamp'⎕SIGNAL 11/⍨∨/~(⎕DR¨arg.NewValue)∊163 83 + _timestamp←6↑arg.NewValue + ∇ + :EndProperty + + :Property active + ⍝ Use this to switch logging effectively on and off. If it is zero, there is not even + ⍝ a log file opened. If later `active` is set to 1, the log file will be opened by then.\\ + ⍝ If an instance is created with `active←1` and is set later to 0 the then opened + ⍝ logfile will not be closed, however. In this case any operations are + ⍝ suppressed, but the log file will remain open.\\ + ⍝ See also `fileFlag`. + :Access Public Instance + ∇ r←get + r←_active + ∇ + ∇ set arg;msg + '"active" must be a Boolean'⎕SIGNAL 11/⍨~∨/arg.NewValue∊0 1 + _active←arg.NewValue + :If _active∧_fileFlag + :AndIf 0=constructorIsRunning ⍝ is set inside any constructor (locally!) to 1 + :AndIf ⍬≡_fileDescriptor ⍝ means that the log file haven't got opened so far + (_errorCounter msg)←Create ⍬ + msg ⎕SIGNAL 11/⍨_errorCounter + :EndIf + ∇ + :EndProperty + + :Property fileFlag + ⍝ Use this to suppress any file operations. In any other respect `Logger` behaves as + ⍝ usual, in particular the `Log` and the `LogError` methods return their explicit + ⍝ results. That is the difference to `active` which switches off everything meaning + ⍝ that the `Log` method as well as the `LogError` method return empty vectors.\\ + ⍝ Note this can be set as part of a parameter space. If it is zero there is not even a + ⍝ log file opened. If `fileFlag` is set later to 1 (and `active` is 1 by then), the + ⍝ log file will be opened then.\\ + ⍝ If an instance is created with `fileFlag←1` and it is set later to 0 the then + ⍝ opened logfile will not be closed, however. In this case any file operations are + ⍝ suppressed but the log file will remain open.\\ + ⍝ See also `active`. + :Access Public + ∇ r←get + r←_fileFlag + ∇ + ∇ set arg;msg + '"fileFlag" must be a Boolean'⎕SIGNAL 11/⍨~∨/arg.NewValue∊0 1 + _fileFlag←arg.NewValue + :If _fileFlag∧_active + :AndIf 0=constructorIsRunning ⍝ is set inside any constructor (localysed!) to 1 + :AndIf ⍬≡_fileDescriptor ⍝ means that the log file haven't got opened so far + (_errorCounter msg)←Create ⍬ + msg ⎕SIGNAL 11/⍨_errorCounter + :EndIf + ∇ + :EndProperty + + + :Property filenamePrefix + ⍝ Adds a prefix to the filename. For example, if the defaults for `filenameType` and + ⍝ `extension` are in effect, setting `filenamePrefix` to "foo" leads to + ⍝ foo_20080601.log on the first of June 2008.\\ + ⍝ Setting this after having already created an instance is too late for this instance, of + ⍝ course, although it will be taken into account when the log file is reopened. To specify + ⍝ it in time pass a parameter space to the constructor. + :Access Public Instance + ∇ r←get + r←_filenamePrefix + ∇ + ∇ set arg + '"filenamePrefix" must be a string'⎕SIGNAL 11/⍨~IsChar arg.NewValue + _filenamePrefix←arg.NewValue + ∇ + :EndProperty + + :Property filenamePostfix + ⍝ Adds a postfix to the filename. For example, if the defaults for `filenameType` and + ⍝ `extension` are in effect, setting "filenamePostfix" to "foo" leads to + ⍝ 20080601_foo.log on the first of June 2008.\\ + ⍝ Setting this after having already created an instance is too late for this instance, of + ⍝ course, although it will be taken into account when the log file is reopened. To specify + ⍝ it in time pass a parameter space to the constructor. + :Access Public Instance + ∇ r←get + r←_filenamePostfix + ∇ + ∇ set arg + '"filenamePostfix" must be a string'⎕SIGNAL 11/⍨~IsChar arg.NewValue + _filenamePostfix←arg.NewValue + ∇ + :EndProperty + + :Property errorPrefix + ⍝ Adds a prefix to an error message to be logged by calling `LogError`. Defaults to `*** ERROR`.\\ + ⍝ Setting this after having already created an instance might be too late for this instance, + ⍝ although it will be taken into account from then. To specify it in time pass a parameter + ⍝ space to the constructor. + :Access Public Instance + ∇ r←get + r←_errorPrefix + ∇ + ∇ set arg + '"errorPrefix" must be a string'⎕SIGNAL 11/⍨~IsChar arg.NewValue + _errorPrefix←arg.NewValue + ∇ + :EndProperty + + :Property path + ⍝ Return the log file's folder. Can only be specified when an instance is created. + :Access Public Instance + ∇ r←get + r←_path + ∇ + :EndProperty + + :Property filename + ⍝ Return the log's current filename which is fully qualified.\\ + ⍝ You can specify this property when calling `⎕NEW` but not later.\\ + ⍝ Note that `Logger` throws an error when `autoReOpen` is 1 and `filename` is + ⍝ not empty. + :ACcess Public Instance + ∇ r←get + r←_filename + ∇ + :EndProperty + + :Property fileDescriptor + ⍝ Return the log file's descriptor number. + :ACcess Public Instance + ∇ r←get + r←_fileDescriptor + ∇ + :EndProperty + + :Property errorCounter + ⍝ Integer that returns the number of errors that have occured in an instance + ⍝ so far - ideally this is 0.\\ + ⍝ This is maintained only if `debug` is zero. + :ACcess Public Instance + ∇ r←get + r←_errorCounter + ∇ + :EndProperty + +⍝ --------------- Constructors + + ∇ make0;constructorIsRunning;msg + ⍝ Defaults, defaults, defaults + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ make1(pathOrParameterSpace);bool;list;this;constructorIsRunning;msg + ⍝ `pathOrParameterSpace` can be either a path or a command space: + ⍝ | path | Directory the log file is going to. + ⍝ | Command space | Useful to set all possible parameters. + ⍝ Note that you can ask + ⍝ `Logger` to create a command space for you, see method `CreateParms`. + ⍝ Then simply set those where the defaults do not fit your needs. + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + :If 9.1=⎕NC⊂,'pathOrParameterSpace' + :AndIf 0=≡pathOrParameterSpace + ⍝ It is a command space + :If ∨/bool←2≠⎕NC⊃'_',¨list←pathOrParameterSpace.⎕NL-2 + 11 ⎕SIGNAL⍨'Invalid keyword(s): ',↑{⍺,',',⍵}/bool/list + :EndIf + 'Missing: "active"'⎕SIGNAL 1/⍨~(⊂'active')∊list + :If 9=pathOrParameterSpace.⎕NC'refToUtils' + _refToUtils←pathOrParameterSpace.refToUtils ⍝ we need this in some setters/getters + :EndIf + :If 0∊⍴⍕refToUtils + 'Missing: "refToUtils"'⎕SIGNAL 6 + :EndIf + :For this :In {⍵,'←',{' '=1↑0⍴⍵:'''',⍵,'''' ⋄ ⍵≡⍬:'⍬' ⋄ ⍕⍵}pathOrParameterSpace.⍎⍵}¨list~'filename' 'path' 'encoding' 'refToUtils' + ⍎this ⍝ not eached for easier debugging + :EndFor + :If (⊂'filename')∊list + _filename←pathOrParameterSpace.filename + :EndIf + :If (⊂'path')∊list + _path←ProcessPath pathOrParameterSpace.path + :EndIf + :If (⊂'encoding')∊list + :If 0∊⍴_encoding←ProcessEncoding pathOrParameterSpace.encoding + 'Invalid value: "encoding"'⎕SIGNAL 11 + :EndIf + :EndIf + :If 0∊⍴_filename,_filenamePostfix,_filenamePrefix,_filenameType + 'No "filenameType" specified but no "filename", "filenamePostfix", "filenamePrefix" either'⎕SIGNAL 11 + :EndIf + :ElseIf ' '≠1↑0⍴∊pathOrParameterSpace + 'Invalid parameters'⎕SIGNAL 11 + :Else + _path←ProcessPath pathOrParameterSpace + :EndIf + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ make2(path_ encoding_);constructorIsRunning;msg + ⍝ `encoding` is a flag defining the encoding. 0 (the default) is ANSI, 1=UTF-8. + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + :If 0∊⍴_encoding←ProcessEncoding encoding_ + 'Invalid: "encoding"'⎕SIGNAL 11 + :EndIf + _path←ProcessPath path_ + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ make3(path_ encoding_ filenameType_);constructorIsRunning;msg + ⍝ `filenameType_` (default: 'DATE') defines when a log files is reopened with a new name. + ⍝ The default means that every night at 23:59:59 a new file is opened. + ⍝ Can be "MONTH" or "YEAR" instead. + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + _path←ProcessPath path_ + _encoding←ProcessEncoding encoding_ + filenameType←filenameType_ + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ make4(path_ encoding_ filenameType_ debug_);constructorIsRunning;msg + ⍝ `debug` (default: 0) is a Boolean useful to switch error trapping off + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + _path←ProcessPath path_ + :If 0∊⍴_encoding←ProcessEncoding encoding_ + 'Invalid: "encoding"'⎕SIGNAL 11 + :EndIf + filenameType←filenameType_ + debug←debug_ + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ make5(path_ encoding_ filenameType_ debug_ timestamp_);constructorIsRunning;msg + ⍝ `timestamp` defaults to `6↑⎕TS`. For testing purposes, for example the + ⍝ re-open feature of the `Logging` class, you can specify a particular timestamp. + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + _path←ProcessPath path_ + :If 0∊⍴_encoding←ProcessEncoding encoding_ + 'Invalid: "encoding"'⎕SIGNAL 11 + :EndIf + filenameType←filenameType_ + debug←debug_ + timestamp←timestamp_ + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ make6(path_ encoding_ filenameType_ debug_ timestamp_ refToUtils_);constructorIsRunning;msg + ⍝ `refToUtils` must be a ref to the namespace which contains `FilesAndDirs`. + :Access Public Instance + :Implements Constructor + constructorIsRunning←1 + InitialyzeProperties + _refToUtils←refToUtils_ + _path←ProcessPath path_ + :If 0∊⍴_encoding←ProcessEncoding encoding_ + 'Invalid: "encoding"'⎕SIGNAL 11 + :EndIf + filenameType←filenameType_ + debug←debug_ + timestamp←timestamp_ + (_errorCounter msg)←Create ⍬ + SetDisplayFormat + msg ⎕SIGNAL 11/⍨_errorCounter + ∇ + + ∇ InitialyzeProperties + ⍝ Guess what: initialyzes the properties.\\ + ⍝ Called very early in the constructors but also by CreateParms + _active←1 + _fileFlag←1 + _debug←0 ⍝ Switch of error trapping + _encoding←'ANSI' ⍝ Either "ANSI" or "UTF". + _autoReOpen←1 ⍝ re-opens log file with a new name according to the "filenameType" + _filenameType←'DATE' ⍝ default filenameType is "yyyymmdd" which is re-opened daily + _printToSession←0 ⍝ If this is 1, every entry is printed to the session as well + _refToUtils←FindPathTo'FilesAndDirs' + _path←'' ⍝ Directory the log file will go into; empty=current dir + _filename←'' ⍝ the actual name + _timestamp←⍬ ⍝ To simulate []TS; ignored when debug=0 + _extension←'log' ⍝ File extension of the log file + _filenamePrefix←'' ⍝ Prefix added to "filename"; use this only when "filename" is empty + _filenamePostfix←'' ⍝ Postfix added to "filename"; use this only when "filename" is empty + _errorPrefix←'*** ERROR' ⍝ How to prefix error entries in the log file + _fileDescriptor←⍬ ⍝ May indicate that "active" was 0 from the start! + _tieNumber←⍬ ⍝ Tie number of the log file or ⍬ + ∇ + + ∇ {(r msg)}←Create dummy;rc;hint;newFilename;flag + ⍝ Is called by the "official" constructors but is private, strictly speaking. + r←0 + msg←'' + flag←9≠_refToUtils.⎕NC'FilesAndDirs' + :If ~0∊⍴_filename + :AndIf _autoReOpen + r←1 + msg←'"filename" MUST NOT be set with autoReOpen=1' + :Return + :EndIf + :If flag + msg←'Not found: script "FilesAndDirs"' + :If _debug + msg ⎕SIGNAL 6 + :Else flag + →0,r←1 + :EndIf + :EndIf + (r msg)←Open ⍬ + ⍝Done + ∇ + +⍝ --------------- Public Shared Methods + + +⍝ --------------- Public Instance Methods + + ∇ r←CreateParms + :Access Public Shared + ⍝ Use this to create a parameter space which can then be modified and finally + ⍝ passed to the constructor.\\ + ⍝ Note that the resulting namespace contains a method `List` which prints + ⍝ all names and their values to the session. + r←⎕NS'' + InitialyzeProperties + r.active←_active + r.encoding←_encoding + r.autoReOpen←_autoReOpen + r.debug←_debug + r.errorPrefix←_errorPrefix + r.extension←_extension + r.fileFlag←_fileFlag + r.filename←_filename + r.filenamePostfix←_filenamePostfix + r.filenamePrefix←_filenamePrefix + r.filenameType←_filenameType + r.path←_path + r.printToSession←_printToSession + r.refToUtils←_refToUtils + r.timestamp←_timestamp + r.⎕FX'r←∆List;⎕IO' '⍝ List all variables and possible references in this namespace' '⎕IO←0' 'r←{⍵,[0.5]⍎¨⍵}'' ''~¨⍨↓⎕NL 2 9' + ∇ + + ∇ r←CreatePropertySpace + :Access Public Shared + ⍝ This method is now deprecated and exists only for compatability reasons. + ⍝ Use `CreateParms` instead. + ⍝ This brings `Logger` in line with all the other members of the APLTree project. + r←CreateParms + ∇ + + ∇ {r}←Log msg;rc;newFilename;flag;buffer;thisTimestamp;⎕TRAP + :Access Public Instance + ⍝ Writes `msg` into the Log File.\\ + ⍝ `r` gets the message written to the log file together with the time stamp and thread no.\\ + ⍝ `msg` can be one of: + ⍝ * A vector + ⍝ * A matrix + ⍝ * A vector of vectors + ⎕TRAP←(999 'E' '({⍵↑⍨1⍳⍨''rc=''{⍺⍷⍵}⍵}⎕IO⊃⎕DM)⎕SIGNAL {⍎⍵↑⍨-''=''⍳⍨⌽⍵}⎕IO⊃⎕DM')((0 1000)'N') + r←'' + :If _active + :Trap SetTrap 0 + thisTimestamp←Timestamp 1 + msg←Nest{2=⍴⍴⍵:⊂[2]⍵ ⋄ ⍵}msg + msg←HandleEncoding msg + :If _fileFlag + r←WriteToLogfile msg thisTimestamp + :Else + ⎕←⊃PolishMsg msg + :EndIf + :Else + _errorCounter+←1 + :EndTrap + :EndIf + ∇ + + ∇ {r}←LogError y;rc;msg;more;⎕TRAP;timestamp + :Access Public Instance + ⍝ y is a two- or three-item vector with: + ⍝ | rc (Return code) | 0 means that `LogError` won't do anything at all. + ⍝ | msg | Either a simple char vector or a vector of char vectors. + ⍝ | more (optional) | Any array that has a depth of 2 or less and a rank of 2 or less. + ⍝ Returns an empty vector in case rc←0 otherwise what was printed to the log file. + r←'' + ⎕TRAP←(999 'E' '({⍵↑⍨1⍳⍨''rc=''{⍺⍷⍵}⍵}⎕IO⊃⎕DM)⎕SIGNAL {⍎⍵↑⍨-''=''⍳⍨⌽⍵}⎕IO⊃⎕DM')((0 1000)'N') + :If ~2 3∊⍨⍴,y + :If _debug + 'Length error - right argument'⎕SIGNAL 6 + :Else + →0,_errorCounter+←1 + :EndIf + :EndIf + (rc msg more)←3↑y,(⍴,y)↓0 '' '' + msg←{2=⍴⍴⍵:↓⍵ ⋄ ,Nest ⍵}msg + msg←HandleEncoding msg + more←⍕¨⊃,/{2=⍴⍴⍵:↓⍵ ⋄ ⊂,⍵}¨Nest⊃,/{2=⍴⍴⍵:↓⍵ ⋄ ⊂,⍵}more + :If 2<≡more + more←∊¨more + :EndIf + more←HandleEncoding more + :If _active∧0≠rc + msg←MassageErrorMessage msg + (msg more)←ApplyMakeUp rc msg more + →(0∊⍴msg,more)/0 + :Trap 0 + :If _fileFlag + timestamp←Timestamp 1 + r←WriteToLogfile msg timestamp + r,←WriteToLogfile more timestamp + :Else + ⎕←⊃PolishMsg msg + :EndIf + :EndTrap + :EndIf + ∇ + +⍝ --------------- Private stuff + + ∇ (rc more filename)←MakeNewFilename filename + ⍝ Compiles a new filename and takes any changes in the timestamp into account.\\ + ⍝ As a result, the compiled filename might differ from the one used so far. + ⍝ In that case, obviously the log file needs to be re-opened when `autoReOpen ←→ 1`. + rc←0 ⋄ more←'' + :Trap SetTrap 0 + :If _autoReOpen + filename←(8↑Timestamp 0)↑⍨('DATE' 'MONTH' 'YEAR'⍳⊂_filenameType)⊃8 6 4 0 + :ElseIf ~0∊⍴_filename + filename←_filename + :EndIf + filename←_filenamePostfix{0∊⍴⍺:⍵ ⋄ ⍵,'_',⍺}filename + filename←_filenamePrefix{0∊⍴⍺:⍵ ⋄ ⍺,'_',⍵}filename + 'No log filename specified and autoReOpen is 0'⎕SIGNAL 11/⍨0∊⍴filename + :Else + :If _debug + . ⍝ something is wrong here + :Else + rc←1 + more←⎕DM + :EndIf + :EndTrap + ∇ + + ∇ r←SetTrap events;Flag + ⍝ R gets 1 if error trapping is appropriate according to the _ + ⍝ global _debug variable + :Trap 0 + r←(~_debug)/events + :Else + r←events + :EndTrap + ∇ + + ∇ r←Timestamp decoratorFlag;ts +⍝ 1=decoratorFlag ←→ yyyy-mm-dd hh:mm:ss +⍝ 0=decoratorFlag ←→ yyyymmddhhmmss + :If ~0∊⍴_timestamp + :AndIf _debug + ts←6↑_timestamp + :Else + ts←6↑⎕TS + :EndIf + :If decoratorFlag + r←,'ZI4,<->,ZI2,<->,ZI2,< >,ZI2,<:>,ZI2,<:>,ZI2'⎕FMT,[0.5]ts + :ElseIf 0=decoratorFlag + r←,'ZI4,ZI2,ZI2,ZI2,ZI2,ZI2'⎕FMT,[0.5]3↑ts + :Else + 'Invalid right argument for "Timestamp" rc=11'⎕SIGNAL 999 + :EndIf + ∇ + + ∇ {(r msg)}←Open newFilename;rc;hint;fno;⎕RL + ⍝ Open the log file. Any directory requested but non-existent is created here as well. + r←0 + msg←'' + :If _active∧_fileFlag + :Trap SetTrap 0 + _filenameType←Uppercase _filenameType + :If 0∊⍴newFilename + (rc hint newFilename)←MakeNewFilename'' + :If 0≠rc + msg←'Could not create new filename from "filenameType" and "path"' + :If _debug + msg ⎕SIGNAL 11 + :Else + →0,r←1 + :EndIf + :EndIf + :EndIf + :If '.'≠↑¯4↑newFilename + newFilename,←'.',_extension + :EndIf + _filename←newFilename + :If ~0∊⍴_path + :If ~'CREATE!'_refToUtils.FilesAndDirs.CheckPath _path + msg←'Could not open the log file, check the path' + :If _debug + msg ⎕SIGNAL 11 + :Else + →0,r←1 + :EndIf + :EndIf + :EndIf + ⎕RL←+/⎕TS + fno←-?99999999 ⍝ See "Close" for details why we are doing this! + :Trap 0 + _fileDescriptor←FullFilename refToUtils.FilesAndDirs.NCREATE fno + :Case 22 + :Trap SetTrap 0 + _fileDescriptor←FullFilename ⎕NTIE fno ⍝ 66 ⍝ grant all to all! + :Else + msg←'Error during open of logfiles: ',1⊃⎕DM + :If _debug + msg ⎕SIGNAL ⎕EN + :Else + →0,r←1 + :EndIf + :EndTrap + :Else + ⎕SIGNAL 11 + :EndTrap + ((Timestamp 1),' ','*** Log File opened',CrLf)⎕NAPPEND _fileDescriptor 80 + :Else + r←1 + msg←'Error during open of logfiles' + :If _debug + msg ⎕SIGNAL ⎕EN + :EndIf + :EndTrap + :EndIf + ∇ + + ∇ (r newFilename)←CheckForReopen;rc;hint;string + ⍝ | `r←0` | if there is no need to re-open the log file. + ⍝ | `r←1` | if the log file needs to be re-opened. + ⍝ | r←¯1` | in case of an error. + newFilename←'' + :If r←~0∊⍴,_autoReOpen + (rc hint newFilename)←MakeNewFilename _filename + :If 0≠rc + :If _debug + hint ⎕SIGNAL rc + :Else + →0,r←¯1 + :EndIf + :EndIf + :If (0∊⍴,newFilename)∨~_autoReOpen + r←0 + :Else + string←(⍴_filenamePrefix)↓_filename + :Select _filenameType + :Case 'DATE' + r←string[7 8]≢((⍴_filenamePrefix)↓newFilename)[7 8] + :Case 'MONTH' + r←string[5 6]≢((⍴_filenamePrefix)↓newFilename)[5 6] + :Case 'YEAR' + r←string[1 2 3 4]≢((⍴_filenamePrefix)↓newFilename)[1 2 3 4] + :Case '' + r←newFilename≢1⊃'.'Split _filename + :EndSelect + :EndIf + :EndIf + ∇ + + ∇ {r}←Close;This;was + :Access Public + ⍝ Closes the log file + r←⍬ + :Trap 0 + Log'*** Log file closed' + :EndTrap + Close2 + ⎕DF'[Logger:]' + ∇ + + ∇ r←FullFilename + :Access Public Instance + ⍝ Returns the fully qualified file name of the log file: path+filename. + r←refToUtils.FilesAndDirs.NormalizePath _path,_filename + ∇ + +⍝ --------------- Private stuff + + ∇ r←QavPoints + ⍝ Returns the Unicode points of all chars in the standard ⎕AV: ⎕UCS ⎕AV + ⍝ Used to tell in the classic version "real" Unicode chars from any chars in ⎕AV + r←0 8 10 13 32 12 6 7 27 9 9014 619 37 39 9082 9077 95 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 + r,←114 115 116 117 118 119 120 121 122 1 2 175 46 9068 48 49 50 51 52 53 54 55 56 57 3 164 165 36 163 162 8710 65 66 67 + r,←68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 4 5 253 183 127 9049 193 194 195 199 200 202 203 + r,←204 205 206 207 208 210 211 212 213 217 218 219 221 254 227 236 240 242 245 123 8364 125 8867 9015 168 192 196 197 + r,←198 9064 201 209 214 216 220 223 224 225 226 228 229 230 231 232 233 234 235 237 238 239 241 91 47 9023 92 9024 60 8804 + r,←61 8805 62 8800 8744 8743 45 43 247 215 63 8714 9076 126 8593 8595 9075 9675 42 8968 8970 8711 8728 40 8834 8835 8745 + r,←8746 8869 8868 124 59 44 9073 9074 9042 9035 9033 9021 8854 9055 9017 33 9045 9038 9067 9066 8801 8802 243 244 246 248 + r,←34 35 30 38 8217 9496 9488 9484 9492 9532 9472 9500 9508 9524 9516 9474 64 249 250 251 94 252 8216 8739 182 58 9079 191 + r,←161 8900 8592 8594 9053 41 93 31 160 167 9109 9054 9059 + ∇ + + ProcessPath←{ + 0∊⍴⍵:'' + ⍵,(~'\/'∊⍨¯1↑⍵)/'/' ⍝ append / if appropriate + } + + ProcessEncoding←{ + 0=1↑0⍴∊⍵:'ANSI' + W←Uppercase ⍵ + ~(⊂W)∊'UTF8' 'ANSI' 'ASCII':'' + ('UTF8' 'ANSI' 'ASCII'⍳⊂W)⊃'UTF8' 'ANSI' 'ANSI' + } + + PolishMsg←{ + ⍝ Called before a message is printed to the session. + ⍝ Makes sure that ⎕PW is taken into account + ⍝ ⍵ is a vector of strings + max←⎕PW-3 + ∧/~bool←max<↑∘⍴¨r←⍵:r + (bool/r)←max{'..',⍨⍺↑⍵}¨bool/r + r + } + + ∇ txt←HandleEncoding txt;nestedFlag;ansi + nestedFlag←0 1∧.<≡txt + txt←Nest txt + :If _encoding≡'UTF8' + txt←⎕UCS¨'UTF-8'∘⎕UCS¨txt + :Else + :If _encoding≡'ANSI' + ansi←'1234567890qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM!"$%∧&*()-_=+]}[{#~''@;:/?.>,<\| ',⎕UCS 8 13 10 + txt←ansi∘{0=+/bool←~(w←⍵)∊⍺:w ⋄ (bool/w)←'?' ⋄ w}¨,¨txt + :Else + txt←{~(⎕DR ⍵)∊80 160:⍕⍵ ⋄ 0=+/bool←128<⎕UCS w←⍵:⍵ ⋄ (bool/w)←'¿' ⋄ w}¨,¨txt ⍝ replace non-ansi chars by "¿" + :EndIf + :EndIf + txt←∊⍣(↑~nestedFlag)⊣txt + ∇ + + ∇ {r}←WriteToLogfile(msg thisTimestamp);rc;newFilename;buffer;flag;⎕TRAP + ⎕TRAP←(⊂999 'N'),⎕TRAP + r←'' + msg←msg,¨⊂CrLf + :If 0∊⍴_fileDescriptor + :If _debug + 'Log file was already closed rc=11'⎕SIGNAL 999 + :Else + →0,_errorCounter+←1 + :EndIf + :EndIf + (rc newFilename)←CheckForReopen ⍝ Check re-open condition + :Select rc + :Case ¯1 + :If _debug + 'Re-Open check failed rc=11'⎕SIGNAL 999 + :Else + →0,_errorCounter+←1 + :EndIf + :Case 1 + buffer←thisTimestamp,' (',(⍕⎕TID),') *** Log File is going to be closed and then reopened with a new filename',CrLf + buffer ⎕NAPPEND _fileDescriptor 80 + ⎕NUNTIE _fileDescriptor + _fileDescriptor←⍬ + Open newFilename + thisTimestamp←Timestamp 1 + :Case 0 + ⍝ nothing to do, is still fine + :Case + . ⍝ must not happen! + :EndSelect + flag←0 + :Trap 0 + (∊((Timestamp 1),' (',(⍕⎕TID),') ')∘,¨msg)⎕NAPPEND _fileDescriptor 80 + r←msg + :Else + _errorCounter+←1 + flag←1 + :Trap 0 + ((Timestamp 1),' (',(⍕⎕TID),')')∘{(⍺,' ',∊⍵,CrLf)⎕NAPPEND _fileDescriptor 80}¨buffer←(⊂'Invalid msg passed via:'),1↓(⎕LC{⍵,' [',(⍕⍺),']'}¨⎕XSI) + :EndTrap + :EndTrap + :If _printToSession + :If flag + ⎕←⊃PolishMsg buffer + :Else + ⎕←⊃PolishMsg ¯2↓¨msg + :EndIf + :EndIf + ∇ + + ∇ msg←MassageErrorMessage msg + msg←{2=⍴⍴⍵:↓⍵ ⋄ ⍵}msg + :If ~0 1∊⍨≡msg + :If 2≠≡msg + :If _debug + 'Invalid "msg"'⎕SIGNAL 11 + :Else + _errorCounter+←1 + :Return + :EndIf + :EndIf + :EndIf + ∇ + + ∇ (msg2 more2)←ApplyMakeUp(rc msg more);prefix + msg2←more2←'' + :Trap 0 + :If 2=≡msg + prefix←_errorPrefix,' RC=',(⍕rc),'; ' + (↑msg)←prefix,↑msg + :If 1<⍴msg + (1↓msg)←(⍴prefix)∘AddTrailingBlanks¨1↓msg + :EndIf + :Else + msg←_errorPrefix,' RC=',(⍕rc),'; ',msg + :EndIf + :Else + :If _debug + →0,⍴r'Invalid "msg"' 11 + :Else + →0,_errorCounter+←1 + :EndIf + :EndTrap + :Trap 0 + :If 0∊⍴∊more + more←'' + :Else + more←(1+⍴,_errorPrefix)∘AddTrailingBlanks¨more + :EndIf + :Else + :If _debug + →0,r←'Invalid "more"' 11 + :Else + →0,_errorCounter+←1 + :EndIf + :EndTrap + (msg2 more2)←msg more + ∇ + + AddTrailingBlanks←{ + 0∊⍴⍵:⍵ + 0 1∊⍨≡⍵:(⍺⍴' '),,⎕FMT ⍵ + 2=⍴⍴⍵:↓⍵ + ⍺{(((1⊃⍴⍵),⍺-1)⍴' '),⍵}⎕FMT,[1.5]⍵ + } + +⍝ --------------- Destructor + + ∇ Cleanup;List + :Implements Destructor + Close2 + ∇ + + ∇ {r}←Close2 + ⍝ When the destructor (which calls "Close2"!) is finally executed _ + ⍝ the tie number originally used might well have be re-used by something _ + ⍝ else. That's the reason why we use a randomly generated tie number, _ + ⍝ and it also means that we need to check whether the file is still _ + ⍝ associated with the original (or any) file. Only then takes the + ⍝ destructor action. + r←⍬ + :If 0<⎕NC'_fileDescriptor' + :AndIf ⍬≢_fileDescriptor + :AndIf _fileDescriptor∊⎕NNUMS + :AndIf (refToUtils.FilesAndDirs.NormalizePath _path,_filename)≡(⎕NNUMS⍳_fileDescriptor)⊃refToUtils.FilesAndDirs.NNAMES + ⎕NUNTIE _fileDescriptor + _fileDescriptor←⍬ + _filename←'' + :EndIf + ∇ + + ∇ {r}←SetDisplayFormat + r←'' + ⎕DF'[Logger:',_path,_filename,'(',(⍕_fileDescriptor),')]' + ∇ + +:EndClass diff --git a/APLSource/OS-3.class b/APLSource/OS-3.class new file mode 100644 index 0000000..941eb0e --- /dev/null +++ b/APLSource/OS-3.class @@ -0,0 +1,274 @@ +:Class OS +⍝ This class offers methods that return the same result under Windows, Linux (without the PI) and Mac OS. +⍝ Examples are `GetPID` and `KillPID`.\\ +⍝ Exceptions are the functions `ShellExecute` (Linux/Mac only) and `WinExecute` (Windows only). They +⍝ perform very similar tasks but with very different parameters and results, so they were separated.\\ +⍝ Kai Jaeger - APL Team Ltd.\\ +⍝ Homepage: + + :Include APLTreeUtils + + ⎕IO←0 ⋄ ⎕ML←3 + + ∇ r←Version + :Access Public shared + r←(Last⍕⎕THIS)'1.3.0' '2017-05-14' + ∇ + + ∇ History + :Access Public shared + ⍝ * 1.3.0 + ⍝ * Bug fixed in `KillPID`: did not always return a result. + ⍝ * Method `History` introduced. + ⍝ * Managed by acre 3 now. + ⍝ * 1.2.1 + ⍝ * Fix in `ShellExecute`: when `rc` is not 0 then result should be empty and `more` shouldn't. + ⍝ * 1.2.0 + ⍝ * Documentation improved. + ⍝ * Bug fix in `ShellExecute` (Linux and Mac OS only). + ∇ + + ∇ (rc more result)←ShellExecute cmd;buff + :Access Shared Public + ⍝ Simple way to fire up an application under Linux/Mac OS.\\ + ⍝ cmd must be a command line ready to be executed. + ⍝ * `rc` is the exit code of the command executed. + ⍝ * `more` is currently always an empty text vector. + ⍝ * `result` is what's returned by the command executed. + result←more←'' + rc←0 + :Trap 11 + cmd←dtb cmd + :If '&'=¯1↑cmd + cmd←(¯1↓cmd),' /dev/null 2>/dev/null &' + {}⎕SH cmd + :Else + cmd,←' 2>&1; echo "CMDEXIT=$?"; exit 0' + buff←⎕SH cmd + rc←⍎(⍴'CMDEXIT=')↓↑¯1↑buff + :If 0=rc + result←¯1↓buff + :Else + more←¯1↓buff + :EndIf + :EndIf + :Else + rc←1 + more←⎕DMX.Message + :EndTrap + ∇ + + ∇ {(success rc more)}←{adminFlag}WinExecute x;ShellOpen;parms;flag + :Access Public Shared + ⍝ Simple way to fire up an application or a document.\\ + ⍝ Note that you **cannot** catch the standard output of any application executed with `WinExecute`. + ⍝ However, you might be able to execute it with `WinExecBatch` which can return the standard + ⍝ output returned by whatever you've executed - see there. + ⍝ + ⍝ `⍵` can be one of: + ⍝ * A namespace, typically created by calling [`CreateParms_WinExecute`](#). This is called a + ⍝ parameter space. + ⍝ * A text string typically specifying a document or an EXE, possibly with command line parameters. + ⍝ + ⍝ In case a text string is passed and the name of the file (first parameter: the EXE/document) contains + ⍝ a space then this filename **must** be enclosed within double quotes. + ⍝ + ⍝ Any other filename with spaces in the name must be enclosed by double-quotes as well. + ⍝ + ⍝ A parameter space is usually created by calling `CreateParms_WinExecute`. You can then make + ⍝ amendments to it and pass it as right argument. See there for details. + ⍝ + ⍝ If the defaults are fine for you and you want just start an EXE or, say, display an + ⍝ HTML file then you can just specify a path pointing either to the EXE or to the document. + ⍝ + ⍝ You can even specify command line parameters this way but you **must** then enclose `file` with + ⍝ double quotes (") even if the file does not contain any blanks. (The `ShellExecute` Windows function + ⍝ does not like double quotes but they will be removed before it is called). + ⍝ + ⍝ The optional left argument defaults to 0 which makes the verb default to "OPEN". By specifying + ⍝ a 1 here it's going to be "RUNAS" meaning that the application is executed in elevated mode + ⍝ (=with admin rights). Of course for this being an option the user must have admin rights. + ⍝ + ⍝ See the test cases for examples.\\ + ⍝ The function returns a three-element vector: + ⍝ 1. A Boolean flag, 1 indicating success. + ⍝ 2. The return code of the Windows API function `ShellOpen`. Is 42 in case of success. + ⍝ 3. An empty text string in case of success. In case of failure this may provide additional information. + 'Runs under Windows only'⎕SIGNAL 11/⍨'Win'≢GetOperatingSystem ⍬ + success←0 ⋄ more←'' ⋄ rc←0 + :If (⎕DR x)∊80 82 + :If 0≠2|'"'+.=x + more←'Odd nunmber of doubles quotes detected' + :Return + :EndIf + parms←CreateParms_WinExecute + :If '"'=1⍴x + parms.(file lpParms)←x{(⍵↑⍺)(⍵↓⍺)}1++/∧\2>+\'"'=x + :Else + parms.(file lpParms)←x{(⍵↑⍺)(⍵↓⍺)}⌊/x⍳' "' + :EndIf + :ElseIf 326=⎕DR x + :AndIf 9=⎕NC'x' + parms←x + parms.verb←Uppercase parms.verb + :If 0≠2|'"'+.=parms.lpParms + more←'Odd nunmber of doubles quotes in "lpParms" detected' + :Return + :EndIf + :Else + 'Invalid right argument'⎕SIGNAL 11 + :EndIf + 'Invalid verb'⎕SIGNAL 11/⍨~(⊂parms.verb)∊'EXPLORE' 'FIND' 'OPEN' 'PRINT' 'RUNAS' '' + 'ShellOpen'⎕NA'U Shell32.C32|ShellExecute* I <0T <0T <0T <0T I' + adminFlag←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'adminFlag' + :If adminFlag + parms.verb←'RUNAS' + :EndIf + parms.file~←'"' + :Trap 0 + rc←ShellOpen parms.(handle verb file lpParms lpDirectory show) + success←42=rc + :Else + rc←⎕EN + more←⎕DMX.Message + :Return + :EndTrap + ∇ + + ∇ parms←CreateParms_WinExecute + :Access Public Shared + ⍝ This method returns a parameter space populated with default values that can be fed to the [`WinExecute`](#) method. + ⍝ | **Parameter**| **Notes** | + ⍝ | `verb` | Must be one of: EDIT, EXPLORE, FIND, OPEN, PRINT, RUNAS, NULL (default). Note the "RUNAS" is "Open" but with admin rights. | + ⍝ | `file` | Name of the file `operation` is performed on. Usually this is an EXE but it can be a document as well. | + ⍝ | `handle` | Handle pointing to a window or 0 (default. | + ⍝ | `show` | 1 (default) allows the application involved to show its windows. 0 hides any windows. | + ⍝ | `lpParms` | Any parameters, for example command line parameters in case the verb is "OPEN". | + ⍝ | `lpDirectory`| The working direcotry for the application involved. | + ⍝ + ⍝ For more information see + parms←⎕NS'' + parms.verb←'' + parms.file←'' + parms.handle←0 + parms.show←1 ⍝ Allow the app to show its windows. Suppress with 0. + parms.lpParms←'' + parms.lpDirectory←'' + ∇ + + ∇ (success rc result)←{adminFlag}WinExecBatch cmd;batFilename;tempFilename;en;more + ⍝ This method executes a command and returns its standard output on `result`.\\ + ⍝ ** Don't** use this for programs that interact with a user! For example, don't use + ⍝ this to fire up an APL session, it cannot work because standard output is redirected.\\ + ⍝ Uses `WinExecute` for this which cannot capture standard output itself.\\ + ⍝ Performes the following actions: + ⍝ * Puts `cmd` into a batch file which is a temp file. + ⍝ * Execute that batch file with `WinExecute`. + ⍝ * Circumvent the standard output of the bat file into another temp file. + ⍝ * Waits until the temp file makes an appearance + ⍝ * Reads that temp file and returns the contents as `result`. + ⍝ \\ + ⍝ * `success` is a Boolean with 1 indicating success. + ⍝ * `rc` is a return code. 42 stands for "okay". + :Access Public Shared + 'Runs under Windows only'⎕SIGNAL 11/⍨'Win'≢GetOperatingSystem ⍬ + tempFilename←##.FilesAndDirs.GetTempFilename'' + batFilename←(¯3↓tempFilename),'BAT' + cmd,←' >',tempFilename + ##.FilesAndDirs.DeleteFile tempFilename + WriteUtf8File batFilename cmd + adminFlag←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'adminFlag' + (success rc more)←adminFlag WinExecute batFilename + :If success + result←{##.FilesAndDirs.IsFile ⍵:ReadUtf8File ⍵ ⋄ _←⎕DL 0.1 ⋄ ∇ ⍵}tempFilename + :Else + result←more + :EndIf + ##.FilesAndDirs.DeleteFile batFilename tempFilename + ∇ + + ∇ r←GetSharedLib + :Access Public Shared + :Select GetOperatingSystem ⍬ + :Case 'Lin' + r←GetLibcName ⍬ + :Case 'Mac' + r←'/usr/lib/libc.dylib' + :Else + . ⍝ Huuh?! + :EndSelect + ∇ + + ∇ r←GetPID;∆GetPID;∆GetCurrentProcessId + ⍝ Returns the process ID of the current process ID. + ⍝ In case of an error a 0 is returned.\\ + ⍝ See also [`KillPID`](#). + :Access Public Shared + :Select GetOperatingSystem ⍬ + :Case 'Win' + :Trap 11 + '∆GetCurrentProcessId'⎕NA'I KERNEL32|GetCurrentProcessId' + r←∆GetCurrentProcessId + :Else + r←0 + :EndTrap + :CaseList 'Mac' 'Lin' + '∆GetPID'⎕NA'I4 ',GetSharedLib,'| getpid' + :Trap 11 + r←∆GetPID + :Else + r←0 + :EndTrap + :Else + .⍝ Huuh?! + :EndSelect + ∇ + + ∇ r←KillPID pid;∆KillPID;PROCESS_TERMINATE;False;OpenProcess;TerminateProcess;h;∆OpenProcess;∆CloseHandle;∆TerminateProcess;thisPID + ⍝ Kill one or more processes identified by their process ID.\\ + ⍝ See also [`GetPID`](#). + :Access Public Shared + r←0 + :Select GetOperatingSystem ⍬ + :Case 'Win' + '∆OpenProcess'⎕NA'U4 KERNEL32.C32|OpenProcess I4 I2 I4' + PROCESS_TERMINATE←↑83 323 ⎕DR 1 + False←↑83 323 ⎕DR 0 + '∆CloseHandle'⎕NA'U KERNEL32.C32|CloseHandle I4' + :Repeat + thisPID←↑pid + 'Invalid PID: not an integer'⎕SIGNAL 11/⍨0≠1↑0⍴thisPID + :If 0≠h←∆OpenProcess PROCESS_TERMINATE False thisPID ⍝ Get handle to the process + '∆TerminateProcess'⎕NA'KERNEL32.C32|TerminateProcess P I4' + {}∆TerminateProcess h 0 ⍝ Kill it + r←1 + :End + {}∆CloseHandle h + :Until 0∊⍴pid←1↓pid + :CaseList 'Lin' 'Mac' + '∆KillPID'⎕NA'I4 ',GetSharedLib,'| kill I4 I4' + :Repeat + :Trap 11 + r←∆KillPID 2↑↑pid + :EndTrap + :Until 0∊⍴pid←1↓pid + :Else + . ⍝ Huuh?! + :EndSelect + ∇ + +⍝ Private stuff + + GetLibcName←{ ⍝ Linux: extract real name of libc that is actually used + pid←↑⎕SH'echo $PPID' + libs←⎕SH'ldd /proc/',pid,'/exe' + ↑('^[[:space:]]*libc\.so\b.*=>[[:space:]]*([^[:space:]]*)'⎕S'\1')libs + } + + GetAPL_Width←{z←⍵ ⋄ 2×⍬⍴⎕SIZE'z'} + + ∇ r←GetDyaLib + r←'dyalog',(⍕GetAPL_Width ⍬),'.dylib' + ∇ + +:EndClass diff --git a/APLSource/TestCases-11/Cleanup-1.function b/APLSource/TestCases-11/Cleanup-1.function new file mode 100644 index 0000000..2420ed9 --- /dev/null +++ b/APLSource/TestCases-11/Cleanup-1.function @@ -0,0 +1,10 @@ + Cleanup;path;rc;more;en + ⎕FUNTIE ⎕FNUMS + ⎕NUNTIE ⎕NNUMS + path←¯1↓GetFileRoot + (rc en more)←#.FilesAndDirs.RmDir path + :If 0≠rc + :AndIf (1≠rc)∨'not found or missing'{⍺≢(⍴⍺)↑⍵}more + ⎕←'Could not remove this: ',path + :EndIf +⍝Done diff --git a/APLSource/TestCases-11/E-1.function b/APLSource/TestCases-11/E-1.function new file mode 100644 index 0000000..8b019a3 --- /dev/null +++ b/APLSource/TestCases-11/E-1.function @@ -0,0 +1,10 @@ + {list}←E list +⍝ Get all functions into the editor starting their names with "Test_". + :If 0∊⍴list + list←'T'⎕NL 3 + :ElseIf 2=⍴⍴list + list←{⎕ML←3 ⋄ ⊃⍵}list[;⎕IO] + :Else + 'Invalid right argument'⎕SIGNAL 11 + :EndIf + {(0∊⍴⍵): ⋄ ⎕ML←3 ⋄ ⎕ED⊃⍵}&↓'Test_'{⍵⌿⍨⍺∧.=⍨(⍴,⍺)↑[1+⎕IO]⍵}list diff --git a/APLSource/TestCases-11/FailsIf-21.function b/APLSource/TestCases-11/FailsIf-21.function new file mode 100644 index 0000000..40cca6a --- /dev/null +++ b/APLSource/TestCases-11/FailsIf-21.function @@ -0,0 +1,5 @@ + FailsIf←{ +⍝ Usage : →FailsIf x, where x is a boolean scalar + ⎕TRAP←(999 'E' '(⎕IO⊃⎕DM)⎕SIGNAL 999')(0 'N') + PassesIf~⍵ ⍝ Just PassesIf on negation + } diff --git a/APLSource/TestCases-11/FindSpecialString-811.function b/APLSource/TestCases-11/FindSpecialString-811.function new file mode 100644 index 0000000..edace09 --- /dev/null +++ b/APLSource/TestCases-11/FindSpecialString-811.function @@ -0,0 +1,11 @@ + r←{startIn}FindSpecialString what;⎕IO;⎕ML +⍝ Use this to search for stuff like "CHECK" or "TODO" enclosed between `⍝` (⍵). +⍝ Without left argument the search starts in #. +⍝ However, at the time of writing the user command ]locate does not work on #. +⍝ Reported as bug <01355> to Dyalog on 2017-04-24. + ⎕IO←0 ⋄ ⎕ML←3 + startIn←{0<⎕NC ⍵:⍎⍵ ⋄ '#'}'startIn' + r←⍉1↓[1]⎕SE.UCMD'locate ',what,' -return=count -objects=',⍕startIn + :If 0<1↑⍴r←(0'#'+.=⍵:⍵ ⋄ {⌽⍵↑⍨1+⍵⍳'#'}⌽⍵}¨r[;0] ⍝ Circumvent bug <01356> + :EndIf diff --git a/APLSource/TestCases-11/G-1.function b/APLSource/TestCases-11/G-1.function new file mode 100644 index 0000000..77ffdd9 --- /dev/null +++ b/APLSource/TestCases-11/G-1.function @@ -0,0 +1,8 @@ + r←G;⎕IO +⍝ Prints all groups to the session. + ⎕IO←0 + r←↓'Test_'{⍵⌿⍨((⍴⍺)↑[1]⍵)∧.=⍺}'T'⎕NL 3 + :If ~0∊⍴r←(2='_'+.=⍉{⎕ML←1 ⋄ ↑⍵}r)⌿r + :AndIf ~0∊⍴r←{⎕ML←1 ⋄ ↑⍵}∪{⍵↑⍨⍵⍳'_'}¨{⍵↓⍨1+⍵⍳'_'}¨r + r←r[⍋#.APLTreeUtils.Lowercase r;] + :EndIf diff --git a/APLSource/TestCases-11/GetFileRoot-89.function b/APLSource/TestCases-11/GetFileRoot-89.function new file mode 100644 index 0000000..3fa26e9 --- /dev/null +++ b/APLSource/TestCases-11/GetFileRoot-89.function @@ -0,0 +1,2 @@ + r←GetFileRoot + r←#.FilesAndDirs.GetTempPath,'Logger_TestCases',#.FilesAndDirs.CurrentSep diff --git a/APLSource/TestCases-11/GoToTidyUp-115.function b/APLSource/TestCases-11/GoToTidyUp-115.function new file mode 100644 index 0000000..afc410d --- /dev/null +++ b/APLSource/TestCases-11/GoToTidyUp-115.function @@ -0,0 +1,10 @@ + r←{label}GoToTidyUp flag +⍝ Returns either an empty vector or "Label" which defaults to ∆TidyUp +⍝ but signals 999 when flag=1 and "stopFlag" exists and is 1. + :If 1=flag + :AndIf 0<⎕NC'stopFlag' + :AndIf stopFlag + ⎕SIGNAL 999 + :EndIf + label←{(0<⎕NC ⍵):⍎⍵ ⋄ r←⍎'∆TidyUp'}'label' + r←flag/label diff --git a/APLSource/TestCases-11/Initial-1.function b/APLSource/TestCases-11/Initial-1.function new file mode 100644 index 0000000..9b02a13 --- /dev/null +++ b/APLSource/TestCases-11/Initial-1.function @@ -0,0 +1,4 @@ + Initial dummy;list + Cleanup + #.FilesAndDirs.PolishCurrentDir + #.Tester.EstablishHelpersIn ⍬ diff --git a/APLSource/TestCases-11/L-1.function b/APLSource/TestCases-11/L-1.function new file mode 100644 index 0000000..98607c3 --- /dev/null +++ b/APLSource/TestCases-11/L-1.function @@ -0,0 +1,17 @@ + r←{numbers}L group +⍝ Prints a list with all test cases and the first comment line to the session. +⍝ If "group" is not empty then it will print only that group (case independent). +⍝ May or may not start with "Test_" +⍝ If "numbers" is defined only those number are printed. + numbers←{(0<⎕NC ⍵):⍎⍵ ⋄ ⍬}'numbers' + r←↓'Test_'{⍵⌿⍨((⍴⍺)↑[1+⎕IO]⍵)∧.=⍺}'T'⎕NL 3 + :If ~0∊⍴group + group←#.APLTreeUtils.Lowercase'test_'{((⍺≢(⍴⍺)↑⍵)/⍺),⍵}group + r←(({⎕ML←1 ⋄ ↑⍵}#.APLTreeUtils.Lowercase(⍴group)↑¨r)∧.=group)⌿r + :EndIf + :If ~0∊⍴r + :AndIf ~0∊⍴numbers + r←(({⍎⍵↑⍨-(-⎕IO)+'_'⍳⍨⌽⍵}¨r)∊numbers)⌿r + :EndIf + r←r,⍪{⎕ML←3 ⋄ {⍵↓⍨+/∧\' '=⍵}{⎕IO←1 ⋄ ⍵↓⍨⍵⍳'⍝'}∊1↑1↓⎕NR ⍵}¨r + r←r[⍋{⎕ML←1 ⋄ ↑⍵}##.APLTreeUtils.Lowercase r[;⎕IO];] diff --git a/APLSource/TestCases-11/ListHelpers-11.function b/APLSource/TestCases-11/ListHelpers-11.function new file mode 100644 index 0000000..dd44e24 --- /dev/null +++ b/APLSource/TestCases-11/ListHelpers-11.function @@ -0,0 +1,18 @@ + r←ListHelpers force;list;⎕IO;⎕ML;force +⍝ Lists all helpers available from the `Tester` class. +⍝ When called by a user pass a `0` as right argument to see all helpers that are actually available. +⍝ Specify a `1` in case you want to see all Helpers that **might** be available. +⍝ Helpers are usually established by calling the `EstablishHelpers' method. +⍝ The list includes helpers that won't be established in case the namespace hosting the test cases is scripted! + ⎕IO←1 ⋄ ⎕ML←1 + force←⎕THIS≡⊃(1↓⎕RSI),⊂'' + r←0 2⍴' ' + list←'Run' 'RunDebug' 'RunThese' 'RunBatchTests' 'RunBatchTestsInDebugMode' 'E' 'L' 'G' 'FailsIf' 'PassesIf' + list,←'GoToTidyUp' 'RenameTestFnsTo' 'ListHelpers' '∆OK' '∆Failed' '∆NoBatchTest' '∆Inactive' '∆NoAcreTests' + list,←'∆WindowsOnly' '∆LinuxOnly' '∆MacOnly' '∆LinuxOrMacOnly' '∆LinuxOrWindowsOnly' + list,←'∆MacOrWindowsOnly' 'FindSpecialString' + list←,¨list + :If 'Tester.Helpers'≢{⍵↑⍨-+/∧\2>+\⌽'.'=⍵}⍕⊃⎕RSI + list/⍨←force∨0<⊃∘⎕NC¨list ⍝ List only those that are around + :EndIf + r←↑{⍵(#.APLTreeUtils.dlb{⍺⍺{⍵↓⍨¯1+⍵⍳'⍝'}⍺⍺ ⍵}1⊃(1↓⎕NR ⍵),⊂'')}¨list diff --git a/APLSource/TestCases-11/PassesIf-41.function b/APLSource/TestCases-11/PassesIf-41.function new file mode 100644 index 0000000..25aaefd --- /dev/null +++ b/APLSource/TestCases-11/PassesIf-41.function @@ -0,0 +1,7 @@ + PassesIf←{ +⍝ Usage : →PassesIf x, where x is a boolean scalar + ⍵:⍬ ⍝ Passes test, so →PassesIf x just continues + 0=⎕NC'stopFlag':0 ⍝ Stop not defined, continue with test suite + ~stopFlag:0 ⍝ Do not stop, continue with test suite + ⎕SIGNAL 999 ⍝ Otherwise stop for investigation + } diff --git a/APLSource/TestCases-11/QuadVariables-11.script b/APLSource/TestCases-11/QuadVariables-11.script new file mode 100644 index 0000000..dc97ba8 --- /dev/null +++ b/APLSource/TestCases-11/QuadVariables-11.script @@ -0,0 +1,6 @@ +:Namespace QuadVariables + ##.⎕IO←0 + ##.⎕ML←3 + ##.⎕WX←3 +:EndNamespace + diff --git a/APLSource/TestCases-11/RenameTestFnsTo-2441.function b/APLSource/TestCases-11/RenameTestFnsTo-2441.function new file mode 100644 index 0000000..d2aa926 --- /dev/null +++ b/APLSource/TestCases-11/RenameTestFnsTo-2441.function @@ -0,0 +1,99 @@ + {r}←oldName RenameTestFnsTo newName;⎕IO;body;rc;⎕ML;header;comment;res;name;right;left;newParent;oldParent;delFilanme +⍝ Renames a test function and tells acre. +⍝ r ← ⍬ + ⎕IO←0 ⋄ ⎕ML←3 + r←⍬ + (oldName newName)←oldName newName~¨' ' + :If '.'∊oldName + (oldParent oldName)←¯1 0↓¨'.'#.APLTreeUtils.SplitPath oldName + oldParent←⍎oldParent + :Else + oldParent←↑⎕RSI + :EndIf + :If '.'∊newName + (newParent newName)←¯1 0↓¨'.'#.APLTreeUtils.SplitPath newName + newParent←⍎newParent + :Else + newParent←↑⎕RSI + :EndIf + ⎕SIGNAL 11/⍨oldParent≢newParent + 'Function to be renamed not found'⎕SIGNAL 11/⍨3≠oldParent.⎕NC oldName + 'New name is already used'⎕SIGNAL 11/⍨0.\\ +⍝ Note that with version 3.1 the restriction that the namespace that hosts +⍝ all the test cases must not be scripted was lifted. However, some helpers +⍝ are not available, and there are limits to what you can achieve with a +⍝ scripted namespace.\\ +⍝ These are the `Run*` functions you may call: +⍝ * `Run` +⍝ * `RunBatchTests` +⍝ * `RunBatchTestsInDebugMode` +⍝ * `RunDebug` +⍝ * `RunThese` +⍝ +⍝ All `Run*` functions return a two-element vector as result: +⍝ 1. Is a return code which has one of three values: +⍝ * 0 means all executed, all okay. +⍝ * 1 means that some test cases failed or crashed. +⍝ * 2 means that at least one test case has not been executed but those that were +⍝ executed passed. Reasons for not being executed can be, among others, that a +⍝ test case is inactive or cannot run on the current platform. +⍝ 2. A vector of text vectors. For every test function there is one item added to +⍝ this vector. In addition there is a summary at the end of the vector, reporting +⍝ how many test cases got executed, how many failed/broke or were not executed +⍝ and for what reason. +⍝ +⍝ ## Details +⍝ All methods take a right argument which is a ref pointing to a +⍝ namespace hosting the test functions. What is a test function and what is +⍝ not is determined by naming convention: they must start with the string +⍝ `Test_` (case sensitive!) followed by digits. Therefore these +⍝ are all valid names for test functions: +⍝ * `Test_1` +⍝ * `Test_001` +⍝ * `TEST_9999` +⍝ +⍝ In order to allow grouping when more complex test cases are needed +⍝ the following names are valid as well: +⍝ * `Test_GroupA_001` +⍝ * `Test_GroupB_002` +⍝ +⍝ Note that there must be a second `_` character (but no more!) to define +⍝ the group. **After** the second underscore only digits are allowed. +⍝ +⍝ ## Comments in line 1 +⍝ Line 1 of a test function must contain information that allow a user to identify +⍝ what this particular test is all about. The `L` (for "List") function (one +⍝ of the [Helpers](#) - see there) lists all test functions with their names +⍝ and this single comment line. Also, all `Run*` functions list this first line. +⍝ +⍝ ## The right argument +⍝ All test functions must accept a right argument of length two: +⍝ +⍝ ### [1] batchFlag +⍝ Use this to avoid running test cases that depend on a human beeing in front +⍝ of the monitor (sometimes needed to answer questions). +⍝ +⍝ ### [2] Stop flag +⍝ Setting this to 1 prevents errors from being trapped, so you can +⍝ investigate failing test cases straight away. +⍝ +⍝ ## Result of a test function +⍝ Test functions must return a result. This is expected to be a single integer. +⍝ However, you don't need to worry about those integers; instead use one of the +⍝ niladic functions established as [Helpers](#) in your test namespace.\\ +⍝ These are the names of those functions and their meaning: +⍝ +⍝ | `∆OK` | Passed +⍝ | `∆Failed` | Unexpected result +⍝ | `∆NoBatchTest` | Not executed because `batchFlag` was 1. +⍝ | `∆InActive` | Not executed because the test case is inactive (not ready, buggy, whatever) +⍝ | `∆WindowsOnly` | Not executed because runs under Windows only. +⍝ | `∆LinuxOnly` | Not executed because runs under Linux only. +⍝ | `∆MacOnly` | Not executed because runs under Mac OS only. +⍝ | `∆LinuxOrMacOnly` | Not executed because runs Linux/Mac OS only. +⍝ | `∆LinuxOrWindowsOnly`| Not executed because runs Linux/Windows only. +⍝ | `∆MacOrWindowsOnly` | Not executed because runs Mac OS/Windows only. +⍝ | `∆NoAcreTests` | No acre-related testsa are executed. +⍝ +⍝ Using the functions rather than numeric constants does not only improve readability +⍝ but makes searching easier as well. +⍝ +⍝ ## "Initial" function +⍝ If a function `Initial` exists in the namespace hosting the test cases +⍝ it is executed automatically before any test case is executed.\\ +⍝ Note that such a function must be either niladic or monadic. If it is +⍝ monadic a reference pointing to the parameter space will be passed as +⍝ right argument. That allows you to, say, check the parameters. +⍝ Use this to initialise an environment all your test cases need. +⍝ +⍝ The function may or may not return a result. If it does it must be a Boolean +⍝ indicating whether initializing was sucessful (1) or not (0). +⍝ +⍝ ## "Cleanup" function +⍝ If a function `Cleanup` exists in the namespace hosting the test cases +⍝ it is executed automatically after the test cases have been executed. +⍝ Use this to clean up any leftovers.\\ +⍝ It might be a good idea to call this in line 1 of `Initial`. +⍝ +⍝ ## INI files +⍝ When running any of the `Run*` methods they check for INI files in the current +⍝ directory: +⍝ * First they try to find "testcase\_{computername}.ini" +⍝ * If no such file exists they try to find "testcase.ini" +⍝ +⍝ If one of those files exists a namespace `Ini` is created within the +⍝ namespace where your test cases live. This means that your test functions can +⍝ access this since it is a true global variable. This namespace is populated with +⍝ the contents of the INI file found.\\ +⍝ After executing the test cases this namespace is deleted. +⍝ +⍝ ## Helpers +⍝ There are a several functions called helpers you might find useful when creating test +⍝ cases. The method `EstablishHelpersIn` takes a ref pointing to the namespace +⍝ hosting the test cases (defaults to `↑⎕RSI` when empty). It copies those helpers +⍝ into the hosting namespace. The explicit result is a list of all helpers.\\ +⍝ Note that some helpers are not available when the namespace hosting the test cases +⍝ is scripted: `E` and `RenameTestFnsTo`.\\ +⍝ One of the helpers lists all helpers; execute +⍝ ~~~ +⍝ #.TestCases.ListHelpers +⍝ Run Run all test cases +⍝ RunDebug Run all test cases with DEBUG flag on +⍝ RunThese Run just the specified tests. +⍝ RunBatchTests Run all batch tests +⍝ RunBatchTestsInDebugMode Run all batch tests in debug mode with stopFlag←1. +⍝ E Get all test functions into the editor. +⍝ L Prints list with all test fns & the first comment line to `⎕SE` +⍝ G Prints all groups to the session. +⍝ FailsIf Usage : →FailsIf x, where x is a boolean scalar +⍝ PassesIf Usage : →PassesIf x, where x is a boolean scalar +⍝ GetTestFnsTemplate Returns vector of text vectors with code of template test fns +⍝ GoToTidyUp Returns either '' or `Label` which defaults to ∆TidyUp +⍝ RenameTestFnsTo Renames a test function and tell acre. +⍝ ListHelpers Lists all helpers available from the `Tester` class. +⍝ ∆OK Constant; used as result of a test function +⍝ ∆Failed Constant; used as result of a test function +⍝ ∆NoBatchTest Constant; used as result of a test function +⍝ ∆Inactive Constant; used as result of a test function +⍝ ∆NoAcreTests Constant; used as result of a test function +⍝ ∆WindowsOnly Constant; used as result of a test function +⍝ ∆LinuxOnly Constant; used as result of a test function +⍝ ∆MacOnly Constant; used as result of a test function +⍝ ∆LinuxOrMacOnly Constant; used as result of a test function +⍝ ∆LinuxOrWindowsOnly Constant; used as result of a test function +⍝ ∆MacOrWindowsOnly Constant; used as result of a test function +⍝ ~~~ +⍝ for this.\\ +⍝ ## Misc +⍝ This class is part of the APLTree Open Source project.\\ +⍝ Home page: \\ +⍝ Kai Jaeger ⋄ APL Team Ltd + + ⎕IO←1 ⋄ ⎕ML←3 + + :Include APLTreeUtils + + ∇ r←Version + :Access Public shared + r←(Last⍕⎕THIS)'3.3.0' '2017-05-18' + ∇ + + ∇ History + :Access Public shared + ⍝ * 3.3.0 + ⍝ * `RunThese` had a problem with groups under certain circumstances. + ⍝ * acre 3.x is now supported (function `RenameTestFnsTo`). + ⍝ * Helper `FindSpecialString` introduced. + ⍝ * Helper `ListHelpers` now requires a right argument. + ⍝ * Method `History` introduced. + ⍝ * Bug fixes: + ⍝ * When `EstablishHelpersIn` was called from a namespace that was not a child of root it did not work. + ⍝ * Sorting of test function is now case insensitive. + ⍝ * Project is now managed by acre 3. + ⍝ * 3.2.1 + ⍝ * Bug fix: reporting information to the session was inconsistent. Same was true for `log`. + ⍝ * 3.2.0 + ⍝ * `Tester` is now reporting: + ⍝ * It's version and date + ⍝ * Whether it found (and instantiated) any INI file or not. + ⍝ * Whether it found (and executed) a function `Initial` or not. + ⍝ * Whether it found (and executed) a function `Cleanup` or not. + ∇ + + ∇ {(rc log)}←Run refToTestNamespace;flags + ⍝ Runs all test cases in `refToTestNamespace` with error trapping. Broken + ⍝ as well as failing tests are reported in the session as such but they + ⍝ don't stop the program from carrying on. + :Access Public Shared + flags←1 0 0 0 + (rc log)←refToTestNamespace Run__ flags,⊂⍬ + ∇ + + ∇ {(rc log)}←{trapAndDebugFlag}RunBatchTests refToTestNamespace;flags + ⍝ Runs all test cases in `refToTestNamespace` but tells the test functions + ⍝ that this is a batch run meaning that test cases in need for any human + ⍝ being for interaction should not execute the test case and return `∆NoBatchTest`.\\ + ⍝ Returns 0 for okay or a 1 in case one or more test cases are broken or failed.\\ + ⍝ This method can run in a runtime as well as in an automated test environment.\\ + ⍝ The left argument defaults to 0 but can be set to 1. It sets both, `stopFlag`\\ + ⍝ and `trapFlag` when specified. It can be a scalar or a two-item vector. + :Access Public Shared + trapAndDebugFlag←{(0<⎕NC ⍵):⍎⍵ ⋄ 1 0}'trapAndDebugFlag' + flags←(1↑trapAndDebugFlag),(¯1↑trapAndDebugFlag),1 0 + (rc log)←refToTestNamespace Run__ flags,⊂⍬ + ∇ + + ∇ {log}←{x}RunDebug refToTestNamespace;flags;rc;stopAt;stop + ⍝ Runs all test cases in `refToTestNamespace` **without** error trapping. + ⍝ If a test case encounters an invalid result it stops. Use this function + ⍝ to investigate the details after `Run` detected a problem.\\ + ⍝ This will work only if you use a particualar strategy when checking results + ⍝ in a test case; see for details. + :Access Public Shared + stop←0 ⋄ stopAt←⊂⍬ + :If 0<⎕NC'x' + :If 0>x + stopAt←|x + stop←1 + :Else + stop←x + :EndIf + :EndIf + flags←0 1 0,stop,stopAt + (rc log)←refToTestNamespace Run__ flags + ∇ + + ∇ {log}←testCaseNos RunTheseIn refToTestNamespace;flags;rc + ⍝ Same as `RunDebug` but it runs just `testCaseNos` in `refToTestNamespace`.\\ + ⍝ Example that executes `Test_special_02` and `Test_999`:\\ + ⍝ ~~~ + ⍝ 'Special_02' 999 RunTheseIn ⎕THIS + ⍝ ~~~ + ⍝ + ⍝ Example that executes test cases 2 & 3 of group "Special": + ⍝ ~~~ + ⍝ 'Special' (2 3) RunTheseIn ⎕THIS + ⍝ ~~~ + :Access Public Shared + flags←0 1 0 0 + (rc log)←refToTestNamespace Run__ flags,⊂testCaseNos + ∇ + + ∇ EditAll refToTestNamespace;list + :Access Public Shared + ⍝ Opens all test functions in the editor + :If IsScripted refToTestNamespace + ⎕ED⍕refToTestNamespace + :Else + {⎕ED ⍵}&¨GetAllTestFns refToTestNamespace + :EndIf + ∇ + + ∇ r←GetAllTestFns refToTestNamespace;buff + :Access Public Shared + ⍝ Returns the names of all test functions found in namespace `refToTestNamespace` + r←'' + :If ~0∊⍴buff←'T'refToTestNamespace.⎕NL 3 + r←' '~¨⍨↓({∧/(↑¯1↑'_'Split ⍵~' ')∊⎕D}¨↓buff)⌿buff + r←r[⍋Lowercase⊃Lowercase r] + :EndIf + ∇ + + ∇ r←{searchString}ListTestCases y;refToTestNamespace;list;b;full + :Access Public Shared + ⍝ `y` is either `refToTestNamespace` or (`refToTestNamespace` `sarchString`). + ⍝ Returns the comment expected in line 1 of all test cases found in `refToTestNamespace`.\\ + ⍝ You can specify a string as optional second parameter of the right argument: + ⍝ then only test cases that do contain that string in either their names or in + ⍝ line 1 will be reported.\\ + ⍝ The optional left argument defaults to 1 which stands for "full", meaning that + ⍝ the name and the comment in line 1 are returned. If it is 0 insetad, + ⍝ only the names of the functions are returned.\\ + ⍝ Note that the search will be case insensitive in any case. + r←'' + (refToTestNamespace full)←2↑y,(⍴,y)↓'' 1 + searchString←##.APLTreeUtils.Lowercase{0<⎕NC ⍵:⍎⍵ ⋄ ''}'searchString' + :If ~0∊⍴list←'Test_'{⍵⌿⍨⍺∧.=⍨⍵↑[2]⍨⍴⍺}'T'refToTestNamespace.⎕NL 3 + :AndIf ~0∊⍴list←' '~¨⍨↓('Test_'{∧/((⍴⍺)↓[2]⍵)∊' ',⎕D,⎕A,'_',##.APLTreeUtils.Lowercase ⎕A}list)⌿list + r←2⊃¨refToTestNamespace.⎕NR¨list + r←{⍵↓⍨+/∧\⍵∊' ⍝'}¨{⍵↓⍨⍵⍳'⍝'}¨r + :If ~0∊⍴searchString + b←∨/searchString⍷##.APLTreeUtils.Lowercase⊃r ⍝ Either in comment... + b∨←∨/searchString⍷⊃##.APLTreeUtils.Lowercase list ⍝ ... or in the name. + r←b⌿r + list←b⌿list + :EndIf + :If full + r←list,[1.5]r + :Else + r←,[1.5]list + :EndIf + :EndIf + ∇ + + ∇ {r}←{forceTestTemplate}EstablishHelpersIn refToTestNamespace;∆;list;fnsName;code;buff;isScripted + ⍝ Takes a ref to a namespace hosting test cases and establishes some functions, + ⍝ among them `ListHelpers` which lists all those functions with their leading + ⍝ comment line.\\ + ⍝ ## If the hosting namespace is scripted + ⍝ * The left argument is ignored. + ⍝ * The template test function is not established. + ⍝ * the two helpers `E` and `RenameTestFnsTo` are **not available**. + ⍝ + ⍝ ## If the hosted namespace is not scripted: + ⍝ * `forceTestTemplate` defaults to 0. If it is a 1 then `Test_0000` is established + ⍝ no matter whether it -or any other test case- already exists or not. + :Access Public Shared + r←⍬ + forceTestTemplate←{(0=⎕NC ⍵):0 ⋄ ⍎⍵}'forceTestTemplate' + 'Invalid right argument'⎕SIGNAL 11/⍨~{((,1)≡,⍵)∨((,0)≡,⍵)}forceTestTemplate + refToTestNamespace←⎕RSI{(0∊⍴⍵):⎕IO⊃⍺ ⋄ ⍵}refToTestNamespace + 'Invalid right argument'⎕SIGNAL 11/⍨#≡refToTestNamespace + list←Helpers.GetListHelpers + isScripted←⍬≢code←{16::⍬ ⋄ ⎕SRC ⍵}refToTestNamespace + :If isScripted + list~←,¨'E' 'RenameTestFnsTo' + :EndIf + :For fnsName :In list + refToTestNamespace.⎕FX Helpers.GetCode fnsName + :EndFor + :If 0=isScripted + :If forceTestTemplate + :OrIf 0∊⍴refToTestNamespace.L'' ⍝ Not if there are already any test functions + refToTestNamespace.⎕FX Helpers.GetCode'Test_000' + :EndIf + :EndIf + ∇ + + ∇ r←GetTestFnsTemplate + :Access Public Shared + ⍝ Returns the code the test template function as a vector of text vectors. + r←Helpers.GetCode'Test_000' + ∇ + +⍝⍝⍝ Private stuff + + :Field Private Shared ReadOnly ∆OK←0 + :Field Private Shared ReadOnly ∆Failed←1 + :Field Private Shared ReadOnly ∆NoBatchTest←¯1 + :Field Private Shared ReadOnly ∆Inactive←¯2 + :Field Private Shared ReadOnly ∆WindowsOnly←¯10 + :Field Private Shared ReadOnly ∆LinuxOnly←¯11 + :Field Private Shared ReadOnly ∆MacOnly←¯12 + :Field Private Shared ReadOnly ∆LinuxOrMacOnly←¯20 + :Field Private Shared ReadOnly ∆LinuxOrWindowsOnly←¯21 + :Field Private Shared ReadOnly ∆MacOrWindowsOnly←¯22 + :Field Private Shared ReadOnly ∆NoAcreTests←¯30 + + ∇ {(rc log)}←ref Run__(trapFlag debugFlag batchFlag stopAt testCaseNos);ps + ⍝ Run all test cases to be found in "ref" + ⍝ The right argument: + ⍝ [1] trapFlag; controls error trapping: + ⍝ 1 = failing test cases are reported, then the next one is executed. + ⍝ 0 = program halts in case of an error - use this for investigation. + ⍝ [2] "debugFlag". If it is 1 failing tests stop for investigation (stop on error) + ⍝ [3] batchFlag; a 1 would mean that the test should quit itself iffor example it + ⍝ needs a human being in front of the monitor. Such test + ⍝ cases are supposed to do nothing but return a ¯1 when this flag is on. + ⍝ [4] Integer. Is treated as "stop just before the test case number "stopAt" is _ + ⍝ going to be executed. + ⍝ The explicit result (shy): + ⍝ r ←→ 0 when all tests got executed succesfully + ⍝ r ←→ 1 when at least one test failed of none where executed because `Initial` prevented that. + ⍝ r ←→ ¯1 when at least one test wasn't exeuted because it's not appropriate _ + ⍝ for batch execution, although none of the tests executed did fail. + ps←⎕NS'' + ref.Stop←debugFlag ⍝ "Stop" is honored by "FailsIf" & "PassesIf" + ref.⎕EX'INI' ⍝ Get rid of any leftovers + ps.(log trapFlag debugFlag batchFlag stopAt testCaseNos errCounter failedCounter)←''trapFlag debugFlag batchFlag stopAt testCaseNos 0 0 + ps.log,←⊂(⎕PW-1)↑'--- Test framework "Tester" version ',(2⊃Version),' from ',(3⊃Version),' ',⎕PW⍴'-' + ¯1 ShowLog ps.log + ref←ProcessIniFiles ref ps + :If 0=ExecuteInitial ref ps + →∆GetOutOfHere,rc←1 + :EndIf + :If 0∊⍴ps.list←GetAllTestFns ref + →∆GetOutOfHere,rc←0 + :EndIf + ProcessGroupAndTestCaseNumbers(ref ps) + ps.returnCodes←⍬ + →(0∊⍴ps.list)/∆GetOutOfHere + ps.log,←⊂(⎕PW-1)↑(,'--- Tests started at ',FormatDateTime ⎕TS),' on ',(⍕ref),' ',(⎕PW-1)⍴'-' + ¯1 ShowLog ps.log + ps.stopAt∨←¯1∊×ps.testCaseNos + ProcessTestCases ref ps + ∆GetOutOfHere: + :If 9=ref.⎕NC'INI' + ref.⎕EX'INI' ⍝ Get rid of any leftovers + ps.log,←⊂'Inifile instance "INI" deleted' + ¯1 ShowLog ps.log + :EndIf + :If 0rc + ps.returnCodes,←rc + :EndIf + msg←{⍵↓⍨+/∧\' '=⍵}{⍵↓⍨⍵⍳'⍝'}2⊃ref.⎕NR this + ps.log,←⊂('* '[1+rc∊0 ¯1]),' ',this,' (',(⍕i),' of ',(⍕noOf),') : ',msg + :If 0>rc + :If 0 to Dyalog on 2017-04-24. + ⎕IO←0 ⋄ ⎕ML←3 + startIn←{0<⎕NC ⍵:⍎⍵ ⋄ '#'}'startIn' + r←⍉1↓[1]⎕SE.UCMD'locate ',what,' -return=count -objects=',⍕startIn + :If 0<1↑⍴r←(0'#'+.=⍵:⍵ ⋄ {⌽⍵↑⍨1+⍵⍳'#'}⌽⍵}¨r[;0] ⍝ Circumvent bug <01356> + :EndIf + ∇ + + ∇ {r}←oldName RenameTestFnsTo newName;⎕IO;body;rc;⎕ML;header;comment;res;name;right;left;newParent;oldParent;delFilanme +⍝ Renames a test function and tells acre. +⍝ r ← ⍬ + ⎕IO←0 ⋄ ⎕ML←3 + r←⍬ + (oldName newName)←oldName newName~¨' ' + :If '.'∊oldName + (oldParent oldName)←¯1 0↓¨'.'#.APLTreeUtils.SplitPath oldName + oldParent←⍎oldParent + :Else + oldParent←↑⎕RSI + :EndIf + :If '.'∊newName + (newParent newName)←¯1 0↓¨'.'#.APLTreeUtils.SplitPath newName + newParent←⍎newParent + :Else + newParent←↑⎕RSI + :EndIf + ⎕SIGNAL 11/⍨oldParent≢newParent + 'Function to be renamed not found'⎕SIGNAL 11/⍨3≠oldParent.⎕NC oldName + 'New name is already used'⎕SIGNAL 11/⍨0+\⌽'.'=⍵}⍕⊃⎕RSI + list/⍨←force∨0<⊃∘⎕NC¨list ⍝ List only those that are around + :EndIf + r←↑{⍵(#.APLTreeUtils.dlb{⍺⍺{⍵↓⍨¯1+⍵⍳'⍝'}⍺⍺ ⍵}1⊃(1↓⎕NR ⍵),⊂'')}¨list + ∇ + + ∇ r←GetCode name + :Access Public Shared +⍝ Useful to get the code of any private function of the `Helpers` sub class. + r←⎕NR name + ∇ + + ∇ r←GetListHelpers + :Access Public Shared +⍝ Returns a list of **all** helper functions. +⍝ These are defined as all private functions of the sub class `Helpers`. + +⍝ ↓↓↓↓ Circumvention of Dyalog bug <01154> (⎕nl 3 does NOT list the private functions of `Helpers`!) + r←(ListHelpers 1)[;1] + ∇ + + ∇ R←Test_000(stopFlag batchFlag);⎕TRAP +⍝ Model for a test function. + ⎕TRAP←(999 'C' '. ⍝ Deliberate error')(0 'N') + R←∆Failed + +⍝ Preconditions... +⍝ ... + + →PassesIf 1≡1 + →FailsIf 1≢1 + →GoToTidyUp 1≢1 + R←∆OK + + ∆TidyUp: ⍝ Clean up after this label + ⍝ ... + + ∇ + + ∇ r←∆OK + ⍝ Constant; used as result of a test function + r←0 + ∇ + + ∇ r←∆Failed + ⍝ Constant; used as result of a test function + r←1 + ∇ + + ∇ r←∆NoBatchTest + ⍝ Constant; used as result of a test function + r←¯1 + ∇ + + ∇ r←∆Inactive + ⍝ Constant; used as result of a test function + r←¯2 + ∇ + + ∇ r←∆WindowsOnly + ⍝ Constant; used as result of a test function + r←¯10 + ∇ + + ∇ r←∆LinuxOnly + ⍝ Constant; used as result of a test function + r←¯11 + ∇ + + ∇ r←∆MacOnly + ⍝ Constant; used as result of a test function + r←¯12 + ∇ + + ∇ r←∆LinuxOrMacOnly + ⍝ Constant; used as result of a test function + r←¯20 + ∇ + + ∇ r←∆LinuxOrWindowsOnly + ⍝ Constant; used as result of a test function + r←¯21 + ∇ + + ∇ r←∆MacOrWindowsOnly + ⍝ Constant; used as result of a test function + r←¯22 + ∇ + + ∇ r←∆NoAcreTests + ⍝ Constant; used as result of a test function + r←¯30 + ∇ + + :EndClass + +:EndClass diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..bbb529f --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2018 APL Team Ltd + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +The software is provided "as is", without warranty of any kind, express or +implied, including but not limited to the warranties of merchantability, +fitness for a particular purpose and non-infringement. In no event shall the +authors or copyright holders be liable for any claim, damages or other +liability, whether in an action of contract, tort or otherwise, arising from, +out of or in connection with the software or the use or other dealings in the +software. \ No newline at end of file diff --git a/Make/Make.DWS b/Make/Make.DWS new file mode 100644 index 0000000..e1592db Binary files /dev/null and b/Make/Make.DWS differ diff --git a/Make/Make.bat b/Make/Make.bat new file mode 100644 index 0000000..d77a09b --- /dev/null +++ b/Make/Make.bat @@ -0,0 +1,2 @@ +"C:\Program Files\Dyalog\Dyalog APL-64 15.0 Unicode\dyalog.exe" %1 maxw=64000 %2 %3 %4 +IF %ERRORLEVEL% NEQ 0 echo ERROR \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..65391b5 --- /dev/null +++ b/README.md @@ -0,0 +1,188 @@ +# Logger + +A class that makes writing to a log file from an application written in Dyalog APL easy. + +## Overview + +This class is designed to write log files as ANSI (default) or UTF-8 files. + +You can create an instance without specifying any parameters at all but you might specify up to 6 parameters. +Some but not all of these parameters can be changed later on as well. + +By default an instance of the class creates a log file with the name "yyyymmdd.log". When a new day puts in an appearance this file is closed and a new one is opened automatically. + +Instead of accepting the defaults you can also let the class create "yyyymm.log" files or even "yyyy.log". + +Note that the main method, `Log`, does not do any kind of fancy formatting. It just accepts vectors of any kind as well as text matrices; performance is considered to be paramount. However, the method `LogError` is different and does some formatting. + +Note that by default the class makes intense use of error trapping to make sure that neither `Log` nor `LogError` will ever effect the hosting application. + +## Encoding + +Note that for ANSI files with the Unicode version of Dyalog all non-ANSI characters are replaced by "?". + +Generally the encoding it determined by the interpreter. You can make sure that only ANSI chars are written to the log file by specifying "ANSI". "ANSI" might save you a bit space but normally not much since most characters in a log file are ANSI anyway. + +"ASCII" was an option in earlier version of `Logger`, when the Classic version of Dyalog was still supported. However, now it deprecated. You may still specify it, but it will be converted to "ANSI" internally anyway. + + +## The methods + +### The Log method + +``` + {r}←Log msg +``` + +Writes `msg` to the Log File. Note that `msg` must be either a character scalar or a simple character vector, otherwise it is ignored. Note that `LogError` gives your more freedom in this respect - see there. + +`r` gets the message written to the log file together with the time stamp and thread no. + +`msg` can be one of: + * A vector + * A matrix + * A vector of vectors + +For best performance this function does not do any formatting. If you need a special formatting consider writing a cover function for `Log` or your own class deriving from `Logger`. + +### The LogError method + +This method is useful to log an error. This is a cover function of `Log`. + +You can specify 2-3 parameters: + 1. The return code. Single integer. 0 means that `LogError` should not do anything at all. + 1. The message (msg). This can be any array containig text or numeric data as long as the depth and rank are both lower than 3. + 1. More information (more); this is optional. This can be any kind of array. + +In case `rc ←→ 0`, `LogError` is doing nothing at all. Otherwise it writes `msg` into the log file and marks it up as an error. `msg` can be simple, a matrix or a nested vector although simple is recommended. `more` can be any array. + +If all is fine `r` is empty, otherwise it returns the message written to the log file. + +That allows you to do something like this: + +``` + MyLoggerInstance.LogError 1 'The error message' ⎕DM +``` + +or even: + +``` + MyLoggerInstance.LogError rc 'FATAL ERROR' ('hello word' (1 2 3)) +``` + +While the `Log` method is fairly restrictive in order to avoid any performance penalties the method `LogError` offers more freedom because this is hardly causing any harm: you won't have thousands of errors per second, and even if you have them performance is the least of your worries then. + +## Notes + +### Important defaults +By default a file "{yyyymmdd}.log" is created within "path" or opened if it already exists. When a new day comes along that file is closed and a new one is created. + +This default behaviour can be switched off by setting `autoReOpen` to 0. + +### Error Trapping +By default all possible errors - accept invalid calls - are trapped withing the `Log` method: a logging mechanism cannot be allowed to break an application which it should support. + +One exception: when creating an instance of ""Logger"" fails that causes a crash but that means it was called with invalid parameters. + +However, by setting `debug` and/or `printToSession` and/or `timestamp` the `Logger` class can be debugged. + +### Preconditions + +`Logger` needs the scripts `APLTreeUtils` and `WinFile`. While `APLTreeUtils` **must** be situated on the same level as `Logger` (because it is `:Included`), `WinFile` is expected to be found either on the same level as the `Logger`script or in `#` or in the namespace `Logger` got instantiated from. + +If neither of this is appropriate one can specify a reference `refToUtils` pointing to the correct namespace. + +## Sample session + +This code: + +``` + myLogger←⎕NEW #.Logger +⍝ Exercise the "Log" method" + myLogger.Log'this is my first entry!' + myLogger.Log'Even' 'more' 'entries' + myLogger.Log⊃'A' 'text' 'matrix' + myLogger.Log 1 2 3 + myLogger.Log('String')(⍳6)('Another string') + myLogger.Log(1 2)(2 3⍴⍳6) ⍝ causes an error (trapped!) + {myLogger.Log'Log entry written in a thread'}&⍬ +⍝ Exercise the "LogError" method + msg←'An error has occured' + rc←0 + myLogger.LogError rc msg ⍝ This has no effect: rc is 0 + rc←2 + myLogger.LogError rc msg + more←'A fatal error has occured'(20 1009)((1 2)'FATAL'(2 3⍴⍳6)) + myLogger.LogError rc msg more ⍝ "more" can be any array +``` + +results in this log file: + +``` +2011-05-29 07:29:36 *** Log File opened +2011-05-29 07:29:36 this is my first entry! +2011-05-29 07:29:36 Even +2011-05-29 07:29:36 more +2011-05-29 07:29:36 entries +2011-05-29 07:29:36 A +2011-05-29 07:29:36 text +2011-05-29 07:29:36 matrix +2011-05-29 07:29:36 1 2 3 +2011-05-29 07:29:36 String +2011-05-29 07:29:36 1 2 3 4 5 6 +2011-05-29 07:29:36 Another string +2011-05-29 07:29:36 (2) Log entry written in a thread +2011-05-29 07:29:36 *** ERROR RC=2; An error has occured +2011-05-29 07:29:36 *** ERROR RC=2; An error has occured +2011-05-29 07:29:36 A fatal error has occured +2011-05-29 07:29:36 20 1009 +2011-05-29 07:29:36 1 2 FATAL 1 2 3 +2011-05-29 07:29:36 4 5 6 +``` + +Note that for the log entry written from its own thread the thread number is reported in the log file. + +## Constructors, fields, properties and methods + +``` + ]ADOC.List Logger +*** Logger (Class) *** + +Constructors: + make0 + make1(pathOrCommandSpace) + make2(path_ encoding_) + make3(path_ encoding_ filenameType_) + make4(path_ encoding_ filenameType_ debug_) + make5(path_ encoding_ filenameType_ debug_ timestamp_) + make6(path_ encoding_ filenameType_ debug_ timestamp_ refToUtils_) +Instance Properties: + active + autoReOpen + debug + encoding (ReadOnly) + errorCounter (ReadOnly) + errorPrefix + extension + fileFlag + filenameDescriptor (ReadOnly) + filenamePostfix + filenamePrefix + filenameType + filename (ReadOnly) + path (ReadOnly) + printToSession + refToUtils + timestamp +Instance Methods: + Close + r ← FullFilename + {r} ← LogError y + {r} ← Log Msg +Shared Methods: + r ← Copyright + r ← CreateParms + r ← History + r ← Version + +``` diff --git a/acreconfig.txt b/acreconfig.txt new file mode 100644 index 0000000..ad273cd --- /dev/null +++ b/acreconfig.txt @@ -0,0 +1,7 @@ +:Namespace + CaseCode←'On' + Load←'' + Open←'' + ProjectSpace←'#._Logger' + StartUp←'' +:EndNamespace diff --git a/publish.config b/publish.config new file mode 100644 index 0000000..fa57da9 --- /dev/null +++ b/publish.config @@ -0,0 +1,17 @@ + + 2.5.0 + 2018-02-19 + #._Logger + + + + + + + + + 1 + + Development + 1 + \ No newline at end of file